eggangles.F90

Go to the documentation of this file.

MODULE eggangles

! Version 2009.0317 by JD GRIL

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DOC !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  All these functions make a package tool for angle.
!  In functions where appears DOM and UNIT indicate the domain of validity :
!         DOM     UNIT           Longitudes           Latitudes
!         "-+"    "D"          [-180.0,180.0[       [-90.0,90.0]
!         "0+"    "D"             [0.0,360.0[       [-90.0,90.0]
!         "-+"    "R"             [-pi,pi[        [-pi/2.0,pi/2.0] 
!         "0+"    "R"              [0,pi[         [-pi/2.0,pi/2.0]
!  (defaults values are DOM = "-+" and UNIT = "D").

!  All functions work for scalar or one dimensional array in input.

!  -1- ANGLE_DOMAIN function

!->function ANGLE_DOMAIN(ALPHA,PI,DOM,UNIT)

!     Converts longitudes in UNIT values under choisen DOMain.
!     The input (ALPHA) is a longitude (REAL) or a LOLA type structure ( or
!     array of them). The output has the same type than the input.       

!  -2- VAL_ functions

!->integer function VAL_LAT(LAT,NUM_ERR,PI,UNIT)

!     Test validity of LAT [-90.0,90.0] 
!     Return -1 or NUM_ERR if it's present in error case, 1 if it's ok.

!->integer function VAL_LON(LON,NUM_ERR,PI,DOM,UNIT)

!     Test validity of LON [-180.0,180.0[ or [0.0,360.0[ 
!     Return -1 or NUM_ERR if it's present in error case, 1 if it's ok.

!->integer function VAL_COORD(PT_COORD,NUM_ERR,PI,DOM,UNIT) 

!     Test validity of LAT [-90.0,90.0] and LON [-180.0,180.0[ or [0.0,360.0[
!     (depends the value of DOM) of a PT_COORD structure of type LOLA (in UNIT).
!     Return -1 or NUM_ERR if it's present in error case, 1 if it's ok.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Author : Jean-Daniel GRIL , CNRM/GMAP/COOPE , Februry 08 2000

! Modified:
! In April 2001 by M. Janousek (A few modifs to port the deck to the model code)
! In November 2004 by JD Gril : more routines to manage angles
!                             : debug VAL_COORD_x
! 2005 by JD Gril : more functions for Mercator RT
! In June 2006 by JD Gril     : line too long (L607 > 132 col.)
! July 2008 by JD Gril        : add 2 new functions to compute distance or size
!                             : on longitude : DIST_2REF and SIZE_W2E
! March 2009 by JD Gril       : add Vector routines
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! ******************* Definition of parameters **********************************

! Include Kinds
! -------------

!* kindef: define default KIND macros
! --------------------------------------
USE parkind1  ,ONLY : jpim,    jprd
USE yomhook   ,ONLY : lhook,   dr_hook
! --------------------------------------

IMPLICIT NONE

! ******************* Definition of type ****************************************

TYPE lola
  sequence
  REAL(KIND=JPRD) :: lon, lat
END TYPE lola

! ******************* Definition of Interface ***********************************

INTERFACE angle_domain
  MODULE PROCEDURE angle_domain_rs, angle_domain_lolas, angle_domain_rv, angle_domain_lolav
END INTERFACE
INTERFACE val_lat
  MODULE PROCEDURE val_lat_s, val_lat_v
END INTERFACE
INTERFACE val_lon
  MODULE PROCEDURE val_lon_s, val_lon_v
END INTERFACE
INTERFACE val_coord
  MODULE PROCEDURE val_coord_s, val_coord_v
END INTERFACE
INTERFACE lolad
  MODULE PROCEDURE lolad_s, lolad_v
END INTERFACE
INTERFACE lolar
  MODULE PROCEDURE lolar_s, lolar_v
END INTERFACE
INTERFACE minimax
  MODULE PROCEDURE  minimax_s, minimax_v
END INTERFACE
INTERFACE cosin_to_angle
  MODULE PROCEDURE cosin_to_angle_s, cosin_to_angle_v
END INTERFACE
INTERFACE p_asin
  MODULE PROCEDURE p_asin_s, p_asin_v
END INTERFACE
INTERFACE p_acos
  MODULE PROCEDURE p_acos_s, p_acos_v
END INTERFACE
INTERFACE dist_2ref
  MODULE PROCEDURE dist_2ref_s, dist_2ref_v, dist_2ref_l
END INTERFACE
INTERFACE size_w2e
  MODULE PROCEDURE size_w2e_s, size_w2e_l
END INTERFACE
CONTAINS

! =================== FUNCTIONS =================================================

! ******************* Independants functions ************************************

! -------------------------------------------------------------------------------
REAL(KIND=JPRD) FUNCTION angle_domain_rs(ALPHA,PI,DOM,UNIT) RESULT (BETA)
REAL(KIND=JPRD), INTENT(IN)                           :: ALPHA
CHARACTER (LEN=2), INTENT(IN), OPTIONAL               :: DOM
CHARACTER (LEN=1), INTENT(IN), OPTIONAL               :: UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                 :: PI


REAL(KIND=JPRD)   :: CVT, TPI, M
CHARACTER (LEN=2) :: TDOM
CHARACTER (LEN=1) :: TUNIT
REAL(KIND=JPRD)   :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:ANGLE_DOMAIN_RS',0,zhook_handle)
IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(dom)) THEN
  IF ((dom=='0+').OR.(dom=='-+')) THEN
    tdom = dom
  ELSE
    tdom = "-+"
  ENDIF
ELSE
  tdom = "-+"
ENDIF
IF (PRESENT(unit)) THEN
  IF ((unit=='R').OR.(unit=='D')) THEN
    tunit = unit
  ELSE
    tunit = "D"
  ENDIF
ELSE
  tunit = "D"
ENDIF

IF (tunit=='R') THEN
  cvt = tpi
ELSE
  cvt = 180.0_jprd
ENDIF

IF (tdom=='-+') THEN
  m = mod(alpha,cvt)
  beta = (m-cvt*mod(REAL(INT(ALPHA/CVT),KIND=JPRD),2.0_JPRD))*sign(1.0_jprd,alpha)*sign(1.0_jprd,m)
ELSE
  m = mod(alpha,2.0_jprd*cvt)
  beta = m-2.0_jprd*cvt*(sign(0.5_jprd,alpha)-0.5_jprd)
ENDIF
IF (lhook) CALL dr_hook('EGGANGLES:ANGLE_DOMAIN_RS',1,zhook_handle)
END FUNCTION angle_domain_rs
! -------------------------------------------------------------------------------
type(lola) FUNCTION angle_domain_lolas(ALPHA,PI,DOM,UNIT) RESULT (BETA)
type(lola), INTENT(IN)                                :: alpha
CHARACTER (LEN=2), INTENT(IN), OPTIONAL                :: DOM
CHARACTER (LEN=1), INTENT(IN), OPTIONAL                :: UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                  :: PI

REAL(KIND=JPRD)   :: TPI
CHARACTER (LEN=2) :: TDOM
CHARACTER (LEN=1) :: TUNIT
REAL(KIND=JPRD)   :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:ANGLE_DOMAIN_LOLAS',0,zhook_handle)
IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(dom)) THEN
  IF ((dom=='0+').OR.(dom=='-+')) THEN
    tdom = dom
  ELSE
    tdom = "-+"
  ENDIF
ELSE
  tdom = "-+"
ENDIF
IF (PRESENT(unit)) THEN
  IF ((unit=='R').OR.(unit=='D')) THEN
    tunit = unit
  ELSE
    tunit = "D"
  ENDIF
ELSE
  tunit = "D"
ENDIF

beta%LON = angle_domain(alpha%LON,tpi,tdom,tunit)
beta%LAT = alpha%LAT
IF (lhook) CALL dr_hook('EGGANGLES:ANGLE_DOMAIN_LOLAS',1,zhook_handle)
END FUNCTION angle_domain_lolas
! -------------------------------------------------------------------------------
FUNCTION angle_domain_rv(ALPHA,PI,DOM,UNIT) RESULT (BETA)
REAL(KIND=JPRD), DIMENSION(:), INTENT(IN)             :: ALPHA
CHARACTER (LEN=2), INTENT(IN), OPTIONAL               :: DOM
CHARACTER (LEN=1), INTENT(IN), OPTIONAL               :: UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                 :: PI
REAL(KIND=JPRD), DIMENSION(SIZE(ALPHA)) :: BETA

REAL(KIND=JPRD)                         :: CVT, TPI
REAL(KIND=JPRD), DIMENSION(SIZE(ALPHA)) :: Z_M
CHARACTER (LEN=2)                       :: TDOM
CHARACTER (LEN=1)                       :: TUNIT
REAL(KIND=JPRD)                         :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:ANGLE_DOMAIN_RV',0,zhook_handle)
IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(dom)) THEN
  IF ((dom=='0+').OR.(dom=='-+')) THEN
    tdom = dom
  ELSE
    tdom = "-+"
  ENDIF
ELSE
  tdom = "-+"
ENDIF
IF (PRESENT(unit)) THEN
  IF ((unit=='R').OR.(unit=='D')) THEN
    tunit = unit
  ELSE
    tunit = "D"
  ENDIF
ELSE
  tunit = "D"
ENDIF

IF (tunit=='R') THEN
  cvt = tpi
ELSE
  cvt = 180.0_jprd
ENDIF

IF (tdom=='-+') THEN
  z_m(:) = mod(alpha(:),cvt)
  beta = (z_m(:)-cvt*mod(REAL(INT(ALPHA(:)/CVT),KIND=JPRD),2.0_JPRD))*sign(1.0_jprd,alpha(:))*sign(1.0_jprd,z_m(:))
ELSE
  z_m(:) = mod(alpha(:),2.0_jprd*cvt)
  beta = z_m(:)-2.0_jprd*cvt*(sign(0.5_jprd,alpha(:))-0.5_jprd)
ENDIF
IF (lhook) CALL dr_hook('EGGANGLES:ANGLE_DOMAIN_RV',1,zhook_handle)
END FUNCTION angle_domain_rv
! -------------------------------------------------------------------------------
FUNCTION angle_domain_lolav(YL_ALPHA,PI,DOM,UNIT) RESULT (YD_BETA)
type(lola), DIMENSION(:), INTENT(IN)               :: yl_alpha
CHARACTER (LEN=2), INTENT(IN), OPTIONAL             :: DOM
CHARACTER (LEN=1), INTENT(IN), OPTIONAL             :: UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL               :: PI
type(lola), DIMENSION(SIZE(YL_ALPHA)) :: yd_beta

REAL(KIND=JPRD)   :: TPI
CHARACTER (LEN=2) :: TDOM
CHARACTER (LEN=1) :: TUNIT
REAL(KIND=JPRD)   :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:ANGLE_DOMAIN_LOLAV',0,zhook_handle)
IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(dom)) THEN
  IF ((dom=='0+').OR.(dom=='-+')) THEN
    tdom = dom
  ELSE
    tdom = "-+"
  ENDIF
ELSE
  tdom = "-+"
ENDIF
IF (PRESENT(unit)) THEN
  IF ((unit=='R').OR.(unit=='D')) THEN
    tunit = unit
  ELSE
    tunit = "D"
  ENDIF
ELSE
  tunit = "D"
ENDIF

yd_beta(:)%LON = angle_domain(yl_alpha(:)%LON,tpi,tdom,tunit)
yd_beta(:)%LAT = yl_alpha(:)%LAT
IF (lhook) CALL dr_hook('EGGANGLES:ANGLE_DOMAIN_LOLAV',1,zhook_handle)
END FUNCTION angle_domain_lolav
! -------------------------------------------------------------------------------
INTEGER(KIND=JPIM) FUNCTION val_lat_s(LAT,NUM_ERR,PI,UNIT) RESULT(ETAT)
REAL(KIND=JPRD), INTENT(IN)                          :: LAT
CHARACTER (LEN=1), INTENT(IN), OPTIONAL              :: UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                :: PI
INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL             :: NUM_ERR

INTEGER(KIND=JPIM) :: TNE
REAL(KIND=JPRD)    :: TPI, LATMXABS
CHARACTER (LEN=1)  :: TUNIT
REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:VAL_LAT_S',0,zhook_handle)
IF (PRESENT(num_err))THEN
  tne = num_err
ELSE
  tne = -1_jpim
ENDIF
IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(unit)) THEN
  IF ((unit=='R').OR.(unit=='D')) THEN
    tunit = unit
  ELSE
    tunit = "D"
  ENDIF
ELSE
  tunit = "D"
ENDIF

IF (tunit=='R') THEN
  latmxabs = tpi/2.0_jprd
ELSE
  latmxabs = 90.0_jprd
ENDIF

IF (abs(lat) > latmxabs) THEN
  etat = tne
ELSE
  etat = 1_jpim
ENDIF
IF (lhook) CALL dr_hook('EGGANGLES:VAL_LAT_S',1,zhook_handle)
END FUNCTION val_lat_s
! -------------------------------------------------------------------------------
INTEGER(KIND=JPIM) FUNCTION val_lat_v(P_LAT,NUM_ERR,PI,UNIT) RESULT(ETAT)
REAL(KIND=JPRD), DIMENSION(:), INTENT(IN)                 :: P_LAT
CHARACTER (LEN=1), INTENT(IN), OPTIONAL                   :: UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                     :: PI
INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL                  :: NUM_ERR

INTEGER(KIND=JPIM) :: TNE
REAL(KIND=JPRD)    :: TPI, Z_LATMXABS
CHARACTER (LEN=1)  :: TUNIT
REAL(KIND=JPRD)    :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:VAL_LAT_V',0,zhook_handle)
IF (PRESENT(num_err))THEN
  tne = num_err
ELSE
  tne = -1_jpim
ENDIF
IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(unit)) THEN
  IF ((unit=='R').OR.(unit=='D')) THEN
    tunit = unit
  ELSE
    tunit = "D"
  ENDIF
ELSE
  tunit = "D"
ENDIF

IF (tunit=='R') THEN
  z_latmxabs = tpi/2.0_jprd
ELSE
  z_latmxabs = 90.0_jprd
ENDIF

IF (any(abs(p_lat(:)) > z_latmxabs)) THEN
  etat = tne
ELSE
  etat = 1_jpim
ENDIF
IF (lhook) CALL dr_hook('EGGANGLES:VAL_LAT_V',1,zhook_handle)
END FUNCTION val_lat_v
! -------------------------------------------------------------------------------
INTEGER(KIND=JPIM) FUNCTION val_lon_s(LON,NUM_ERR,PI,DOM,UNIT) RESULT(ETAT)
REAL(KIND=JPRD), INTENT(IN)                                :: LON
CHARACTER (LEN=2), INTENT(IN), OPTIONAL                    :: DOM
CHARACTER (LEN=1), INTENT(IN), OPTIONAL                    :: UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                      :: PI
INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL                   :: NUM_ERR

INTEGER(KIND=JPIM) :: TNE
REAL(KIND=JPRD)    :: TPI, CVT, S, LONMIN, LONMAX
CHARACTER (LEN=2)  :: TDOM
CHARACTER (LEN=1)  :: TUNIT
REAL(KIND=JPRD)    :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:VAL_LON_S',0,zhook_handle)
IF (PRESENT(num_err))THEN
  tne = num_err
ELSE
  tne = -1_jpim
ENDIF
IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(dom)) THEN
  IF ((dom=='0+').OR.(dom=='-+')) THEN
    tdom = dom
  ELSE
    tdom = "-+"
  ENDIF
ELSE
  tdom = "-+"
ENDIF
IF (PRESENT(unit)) THEN
  IF ((unit=='R').OR.(unit=='D')) THEN
    tunit = unit
  ELSE
    tunit = "D"
  ENDIF
ELSE
  tunit = "D"
ENDIF

IF (tunit=='R') THEN
  cvt = tpi
ELSE
  cvt = 180.0_jprd
ENDIF
IF (tdom=='-+') THEN
  s = -1.0_jprd
ELSE
  s = 0.0_jprd
ENDIF
lonmin = s*cvt
lonmax =(2.0_jprd +s)*cvt

IF ((lon < lonmin).OR.(lon >= lonmax)) THEN
  etat = tne
ELSE
  etat = 1_jpim
ENDIF
IF (lhook) CALL dr_hook('EGGANGLES:VAL_LON_S',1,zhook_handle)
END FUNCTION val_lon_s
! -------------------------------------------------------------------------------
INTEGER(KIND=JPIM) FUNCTION val_lon_v(LON,NUM_ERR,PI,DOM,UNIT) RESULT(ETAT)
REAL(KIND=JPRD), DIMENSION(:), INTENT(IN)                       :: LON
CHARACTER (LEN=2), INTENT(IN), OPTIONAL                         :: DOM
CHARACTER (LEN=1), INTENT(IN), OPTIONAL                         :: UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                           :: PI
INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL                        :: NUM_ERR

INTEGER(KIND=JPIM) :: TNE
REAL(KIND=JPRD)    :: TPI, Z_CVT, Z_S, Z_LONMIN, Z_LONMAX
CHARACTER (LEN=2)  :: TDOM
CHARACTER (LEN=1)  :: TUNIT
REAL(KIND=JPRD)    :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:VAL_LON_V',0,zhook_handle)
IF (PRESENT(num_err))THEN
  tne = num_err
ELSE
  tne = -1_jpim
ENDIF
IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(dom)) THEN
  IF ((dom=='0+').OR.(dom=='-+')) THEN
    tdom = dom
  ELSE
    tdom = "-+"
  ENDIF
ELSE
  tdom = "-+"
ENDIF
IF (PRESENT(unit)) THEN
  IF ((unit=='R').OR.(unit=='D')) THEN
    tunit = unit
  ELSE
    tunit = "D"
  ENDIF
ELSE
  tunit = "D"
ENDIF

IF (tunit=='R') THEN
  z_cvt = tpi
ELSE
  z_cvt = 180.0_jprd
ENDIF
IF (tdom=='-+') THEN
  z_s = -1.0_jprd
ELSE
  z_s = 0.0_jprd
ENDIF
z_lonmin = z_s*z_cvt
z_lonmax =(2.0_jprd +z_s)*z_cvt

IF ((any(lon(:) < z_lonmin)).OR.(any(lon(:) >= z_lonmax))) THEN
  etat = tne
ELSE
  etat = 1_jpim
ENDIF
IF (lhook) CALL dr_hook('EGGANGLES:VAL_LON_V',1,zhook_handle)
END FUNCTION val_lon_v
! -------------------------------------------------------------------------------
INTEGER(KIND=JPIM) FUNCTION val_coord_s(PT_COORD,NUM_ERR,PI,DOM,UNIT) RESULT(ETAT)
type(lola), INTENT(IN)                               :: pt_coord
CHARACTER (LEN=2), INTENT(IN), OPTIONAL               :: DOM
CHARACTER (LEN=1), INTENT(IN), OPTIONAL               :: UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                 :: PI
INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL              :: NUM_ERR

INTEGER(KIND=JPIM) :: TNE
REAL(KIND=JPRD)    :: TPI
CHARACTER (LEN=2)  :: TDOM
CHARACTER (LEN=1)  :: TUNIT
REAL(KIND=JPRD)    :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:VAL_COORD_S',0,zhook_handle)
IF (PRESENT(num_err))THEN
  tne = num_err
ELSE
  tne = -1_jpim
ENDIF
IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(dom)) THEN
  IF ((dom=='0+').OR.(dom=='-+')) THEN
    tdom = dom
  ELSE
    tdom = "-+"
  ENDIF
ELSE
  tdom = "-+"
ENDIF
IF (PRESENT(unit)) THEN
  IF ((unit=='R').OR.(unit=='D')) THEN
    tunit = unit
  ELSE
    tunit = "D"
  ENDIF
ELSE
  tunit = "D"
ENDIF

IF ((val_lon(pt_coord%LON,tne,tpi,tdom,tunit) == 1_jpim).AND.(val_lat(pt_coord%LAT,tne,tpi,tunit) == 1_jpim)) THEN
  etat = 1_jpim
ELSE
  etat = tne
ENDIF
IF (lhook) CALL dr_hook('EGGANGLES:VAL_COORD_S',1,zhook_handle)
END FUNCTION val_coord_s
! -------------------------------------------------------------------------------
INTEGER(KIND=JPIM) FUNCTION val_coord_v(YD_PT_COORD,K_NUM_ERR,PI,CD_DOM,CD_UNIT) RESULT(ETAT)
type(lola), DIMENSION(:), INTENT(IN)                   :: yd_pt_coord
CHARACTER (LEN=2), INTENT(IN), OPTIONAL                 :: CD_DOM
CHARACTER (LEN=1), INTENT(IN), OPTIONAL                 :: CD_UNIT
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                   :: PI
INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL                :: K_NUM_ERR

INTEGER(KIND=JPIM) :: I_TNE
CHARACTER (LEN=2)  :: CL_TDOM
REAL(KIND=JPRD)    :: Z_TPI
CHARACTER (LEN=1)  :: CL_TUNIT
REAL(KIND=JPRD)    :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:VAL_COORD_V',0,zhook_handle)
IF (PRESENT(k_num_err))THEN
  i_tne = k_num_err
ELSE
  i_tne = -1_jpim
ENDIF
IF (PRESENT(pi)) THEN
  z_tpi = pi
ELSE
  z_tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
IF (PRESENT(cd_dom)) THEN
  IF ((cd_dom=='0+').OR.(cd_dom=='-+')) THEN
    cl_tdom = cd_dom
  ELSE
    cl_tdom = "-+"
  ENDIF
ELSE
  cl_tdom = "-+"
ENDIF
IF (PRESENT(cd_unit)) THEN
  IF ((cd_unit=='R').OR.(cd_unit=='D')) THEN
    cl_tunit = cd_unit
  ELSE
    cl_tunit = "D"
  ENDIF
ELSE
  cl_tunit = "D"
ENDIF

IF ((val_lon(yd_pt_coord(:)%LON,i_tne,z_tpi,cl_tdom,cl_tunit) == 1_jpim).AND. &
 & (val_lat(yd_pt_coord(:)%LAT,i_tne,z_tpi,cl_tunit) == 1_jpim)) THEN
  etat = 1_jpim
ELSE
  etat = i_tne
ENDIF
IF (lhook) CALL dr_hook('EGGANGLES:VAL_COORD_V',1,zhook_handle)
END FUNCTION val_coord_v
! -------------------------------------------------------------------------------
TYPE(lola) FUNCTION LOLAR_S (coord_deg) RESULT (coord_rad)
! DEG => RAD for lola type
TYPE(lola), INTENT(IN)                      :: COORD_DEG

REAL(KIND=JPRD) :: TPI,DTR
REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:LOLAR_S',0,zhook_handle)
tpi = asin(1.0_jprd)*2.0_jprd
dtr = tpi/180.0_jprd
coord_rad%LON = coord_deg%LON*dtr
coord_rad%LAT = coord_deg%LAT*dtr
IF (lhook) CALL dr_hook('EGGANGLES:LOLAR_S',1,zhook_handle)
END FUNCTION lolar_s

FUNCTION lolar_v (COORD_DEG) RESULT (COORD_RAD)
! DEG => RAD for lola type
TYPE(lola), DIMENSION(:), INTENT(IN)                :: COORD_DEG
TYPE(lola), DIMENSION(SIZE(COORD_DEG)) :: COORD_RAD

REAL(KIND=JPRD) :: TPI,DTR
REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:LOLAR_V',0,zhook_handle)
tpi = asin(1.0_jprd)*2.0_jprd
dtr = tpi/180.0_jprd
coord_rad(:)%LON = coord_deg(:)%LON*dtr
coord_rad(:)%LAT = coord_deg(:)%LAT*dtr
IF (lhook) CALL dr_hook('EGGANGLES:LOLAR_V',1,zhook_handle)
END FUNCTION lolar_v
! -------------------------------------------------------------------------------
TYPE(lola) FUNCTION LOLAD_S (coord_rad) RESULT (coord_deg)
! RAD => DEG for lola type
TYPE(lola), INTENT(IN)                      :: COORD_RAD

REAL(KIND=JPRD) :: TPI,RTD
REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:LOLAD_S',0,zhook_handle)
tpi = asin(1.0_jprd)*2.0_jprd
rtd = 180.0_jprd/tpi
coord_deg%LON = coord_rad%LON*rtd
coord_deg%LAT = coord_rad%LAT*rtd
IF (lhook) CALL dr_hook('EGGANGLES:LOLAD_S',1,zhook_handle)
END FUNCTION lolad_s

FUNCTION lolad_v (COORD_RAD) RESULT (COORD_DEG)
! RAD => DEG for lola type
TYPE(lola), DIMENSION(:), INTENT(IN)                :: COORD_RAD
TYPE(lola), DIMENSION(SIZE(COORD_RAD)) :: COORD_DEG

REAL(KIND=JPRD) :: TPI,RTD
REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:LOLAD_V',0,zhook_handle)
tpi = asin(1.0_jprd)*2.0_jprd
rtd = 180.0_jprd/tpi
coord_deg(:)%LON = coord_rad(:)%LON*rtd
coord_deg(:)%LAT = coord_rad(:)%LAT*rtd
IF (lhook) CALL dr_hook('EGGANGLES:LOLAD_V',1,zhook_handle)
END FUNCTION lolad_v
! -------------------------------------------------------------------------------
! Function to compute Cosine,Sine to Angle
! -------------------------------------------------------------------------------
REAL(KIND=JPRD) FUNCTION cosin_to_angle_s(COSINUS,SINUS) RESULT (ANGLE)
! (Cosinus,Sinus) => Angle
REAL(KIND=JPRD), INTENT(IN)                  :: COSINUS,SINUS

REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:COSIN_TO_ANGLE_S',0,zhook_handle)
angle = p_acos(cosinus)*sign(1.0_jprd,sinus)
IF (lhook) CALL dr_hook('EGGANGLES:COSIN_TO_ANGLE_S',1,zhook_handle)
END FUNCTION cosin_to_angle_s

FUNCTION cosin_to_angle_v(COSINUS,SINUS) RESULT (ANGLE)
! (Cosinus,Sinus) => Angle
REAL(KIND=JPRD), DIMENSION(:), INTENT(IN)              :: COSINUS,SINUS
REAL(KIND=JPRD), DIMENSION(SIZE(COSINUS)) :: ANGLE

REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:COSIN_TO_ANGLE_V',0,zhook_handle)
angle(:) = p_acos(cosinus(:))*sign(1.0_jprd,sinus(:))
IF (lhook) CALL dr_hook('EGGANGLES:COSIN_TO_ANGLE_V',1,zhook_handle)
END FUNCTION cosin_to_angle_v
! -------------------------------------------------------------------------------
! -------------------------------------------------------------------------------
! Function to compute Acos without error
! -------------------------------------------------------------------------------
REAL(KIND=JPRD) FUNCTION p_acos_s(COSINUS) RESULT (ANGLE)
! Protected ACOS
REAL(KIND=JPRD), INTENT(IN)                  :: COSINUS

REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:P_ACOS_S',0,zhook_handle)
angle = acos(minimax(cosinus))
IF (lhook) CALL dr_hook('EGGANGLES:P_ACOS_S',1,zhook_handle)
END FUNCTION p_acos_s

FUNCTION p_acos_v(COSINUS) RESULT (ANGLE)
! Protected ACOS
REAL(KIND=JPRD), DIMENSION(:), INTENT(IN)              :: COSINUS
REAL(KIND=JPRD), DIMENSION(SIZE(COSINUS)) :: ANGLE

REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:P_ACOS_V',0,zhook_handle)
angle(:) = acos(minimax(cosinus(:)))
IF (lhook) CALL dr_hook('EGGANGLES:P_ACOS_V',1,zhook_handle)
END FUNCTION p_acos_v
! -------------------------------------------------------------------------------
! -------------------------------------------------------------------------------
! Function to compute Asin without error
! -------------------------------------------------------------------------------
REAL(KIND=JPRD) FUNCTION p_asin_s(SINUS) RESULT (ANGLE)
! Protected ASIN
REAL(KIND=JPRD), INTENT(IN)                  :: SINUS

REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:P_ASIN_S',0,zhook_handle)
angle = asin(minimax(sinus))
IF (lhook) CALL dr_hook('EGGANGLES:P_ASIN_S',1,zhook_handle)
END FUNCTION p_asin_s

FUNCTION p_asin_v(SINUS) RESULT (ANGLE)
! Protected ASIN
REAL(KIND=JPRD), DIMENSION(:), INTENT(IN)            :: SINUS
REAL(KIND=JPRD), DIMENSION(SIZE(SINUS)) :: ANGLE

REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:P_ASIN_V',0,zhook_handle)
angle(:) = asin(minimax(sinus(:)))
IF (lhook) CALL dr_hook('EGGANGLES:P_ASIN_V',1,zhook_handle)
END FUNCTION p_asin_v
! -------------------------------------------------------------------------------
! -------------------------------------------------------------------------------
! Function MinMax
! -------------------------------------------------------------------------------
REAL(KIND=JPRD) FUNCTION minimax_s(VAL,LIM) RESULT (VALO)
! Return Value in [-LIM,LIM]
REAL(KIND=JPRD), INTENT(IN)                      :: VAL
REAL(KIND=JPRD), INTENT(IN), OPTIONAL            :: LIM

REAL(KIND=JPRD) :: TLIM
REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:MINIMAX_S',0,zhook_handle)
IF (PRESENT(lim)) THEN
  tlim = lim
ELSE
  tlim = 1.0_jprd
ENDIF
valo = min(tlim,max(-1.0_jprd*tlim,val))
IF (lhook) CALL dr_hook('EGGANGLES:MINIMAX_S',1,zhook_handle)
END FUNCTION minimax_s

FUNCTION minimax_v(VAL,LIM) RESULT (VALO)
! Return Value in [-LIM,LIM]
REAL(KIND=JPRD), DIMENSION(:), INTENT(IN)          :: VAL
REAL(KIND=JPRD), INTENT(IN), OPTIONAL              :: LIM
REAL(KIND=JPRD), DIMENSION(SIZE(VAL)) :: VALO

REAL(KIND=JPRD) :: TLIM
REAL(KIND=JPRD) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:MINIMAX_V',0,zhook_handle)
IF (PRESENT(lim)) THEN
  tlim = lim
ELSE
  tlim = 1.0_jprd
ENDIF
valo(:) = min(tlim,max(-1.0_jprd*tlim,val(:)))
IF (lhook) CALL dr_hook('EGGANGLES:MINIMAX_V',1,zhook_handle)
END FUNCTION minimax_v
! -------------------------------------------------------------------------------
! -------------------------------------------------------------------------------
! Functions Longitude size/distance
! -------------------------------------------------------------------------------
REAL(KIND=JPRD) FUNCTION dist_2ref_l(COORD_LON,REF_LON,PI) RESULT(DIST)
! COORD_LON, REF_LON in -+Radians
! DIST in -+Radians

! Calcule la distance orientee DIST (abscisse dans l'intervale [-pi,pi[ et d'origine le meridien de
! reference REF_LON) de COORD_LON a REF_LON (coordonnees en radians dans l'intervale
! [-pi,pi[ et avec comme origine le meridien de GreenWiTch). Les valeurs negatives sont vers l'Ouest
! des origines.

! Computes oriented distance DIST (as an absciss in [-pi,pi[ with origin at REF_LON meridian)
! from COORD_LON to REF_LON (coordinates in rad [-pi,pi[ with origin at GreenWiTch meridian)
! Negatives values are on West of origins.

REAL(KIND=JPRD), INTENT(IN)                   :: COORD_LON, REF_LON
REAL(KIND=JPRD), INTENT(IN), OPTIONAL         :: PI 

REAL(KIND=JPRD)                            :: Z  
REAL(KIND=JPRD)                            :: TPI
REAL(KIND=JPRD)                            :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:DIST2REF_L',0,zhook_handle)    

IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
z = (coord_lon-ref_lon)
z = z-sign(tpi,z)*(1.0_jprd+sign(1.0_jprd,abs(z)-tpi))
dist = -z*sign(1.0_jprd,z-tpi) ! because [-pi,pi[ : if pi then -pi 

IF (lhook) CALL dr_hook('EGGANGLES:DIST2REF_L',1,zhook_handle)
END FUNCTION dist_2ref_l
! -------------------------------------------------------------------------------
REAL(KIND=JPRD) FUNCTION dist_2ref_s(PT_COORD,REF_COORD,PI) RESULT(DIST)
! PT_COORD, REF_COORD in -+Radians
! DIST in -+Radians

! Calcule la distance orientee DIST (abscisse dans l'intervale [-pi,pi[ et d'origine le meridien de
! reference REF_COORD%LON) de PT_COORD%LON a REF_COORD%LON (coordonnees en radians dans l'intervale
! [-pi,pi[ et avec comme origine le meridien de GreenWiTch). Les valeurs negatives sont vers l'Ouest
! des origines.

! Computes oriented distance DIST (as an absciss in [-pi,pi[ with origin at REF_COORD%LON meridian)
! from PT_COORD%LON to REF_COORD%LON (coordinates in rad [-pi,pi[ with origin at GreenWiTch meridian)
! Negatives values are on West of origins.

type(lola), INTENT(IN)                       :: pt_coord, ref_coord
REAL(KIND=JPRD), INTENT(IN), OPTIONAL         :: PI 

REAL(KIND=JPRD)                            :: TPI
REAL(KIND=JPRD)                            :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:DIST2REF_S',0,zhook_handle)    

IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
dist = dist_2ref(pt_coord%LON,ref_coord%LON,tpi)

IF (lhook) CALL dr_hook('EGGANGLES:DIST2REF_S',1,zhook_handle)
END FUNCTION dist_2ref_s
! -------------------------------------------------------------------------------
FUNCTION dist_2ref_v(PT_COORD,REF_COORD,PI) RESULT(DIST)
! PT_COORD, REF_COORD in -+Radians
! DIST in -+Radians

! Calcule la distance orientee DIST (abscisse dans l'intervale [-pi,pi[ et d'origine le meridien de
! reference REF_COORD%LON) de PT_COORD%LON a REF_COORD%LON (coordonnees en radians dans l'intervale
! [-pi,pi[ et avec comme origine le meridien de GreenWiTch). Les valeurs negatives sont vers l'Ouest
! des origines.

! Computes oriented distance DIST (as an absciss in [-pi,pi[ with origin at REF_COORD%LON meridian)
! from PT_COORD%LON to REF_COORD%LON (coordinates in rad [-pi,pi[ with origin at GreenWiTch meridian)
! Negatives values are on West of origins.

type(lola), DIMENSION(:), INTENT(IN)                   :: pt_coord
type(lola), INTENT(IN)                                 :: ref_coord
REAL(KIND=JPRD), INTENT(IN), OPTIONAL                   :: PI 
REAL(KIND=JPRD), DIMENSION(SIZE(PT_COORD)) :: DIST

REAL(KIND=JPRD), DIMENSION(SIZE(PT_COORD)) :: Z
REAL(KIND=JPRD)                            :: TPI
REAL(KIND=JPRD)                            :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:DIST2REF_V',0,zhook_handle)    

IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
z(:) = pt_coord(:)%LON-ref_coord%LON
z(:) = z(:)-sign(tpi,z(:))*(1.0_jprd+sign(1.0_jprd,abs(z(:))-tpi))
dist(:) = -z(:)*sign(1.0_jprd,z(:)-tpi) ! because [-pi,pi[ : if pi then -pi 

IF (lhook) CALL dr_hook('EGGANGLES:DIST2REF_V',1,zhook_handle)
END FUNCTION dist_2ref_v
! -------------------------------------------------------------------------------
REAL(KIND=JPRD) FUNCTION size_w2e_l(WEST_LON,EAST_LON,PI) RESULT(TAILLE)
! WEST_LON, EAST_LON in -+Radians
! SIZE in 0+Radians 

! Calcule la distance ou taille (norme entre ]0,2pi]) entre WEST_LON et EAST_LON
! dans le sens des aiguilles d'une montre en regardant du Pole Sud vers le Pole Nord ( ceci
! pour ne pas calculer le complementaire a 2pi ).

! Computes distance or length (norm in ]0,2pi]) between WEST_LON and EAST_LON in
! clockwise seeing from South Pole to North Pole.

REAL(KIND=JPRD), INTENT(IN)                   :: WEST_LON, EAST_LON
REAL(KIND=JPRD), INTENT(IN), OPTIONAL         :: PI 

REAL(KIND=JPRD)                            :: Z  
REAL(KIND=JPRD)                            :: TPI
REAL(KIND=JPRD)                            :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:SIZE_W2E_L',0,zhook_handle)    

IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
z =  dist_2ref(west_lon,east_lon,tpi)
taille = tpi*(1.0_jprd+sign(1.0_jprd,z))-z

IF (lhook) CALL dr_hook('EGGANGLES:SIZE_W2E_L',1,zhook_handle)
END FUNCTION size_w2e_l
! -------------------------------------------------------------------------------
REAL(KIND=JPRD) FUNCTION size_w2e_s(WEST_COORD,EAST_COORD,PI) RESULT(TAILLE)
! WEST_COORD, EAST_COORD in -+Radians
! SIZE in 0+Radians 

! Calcule la distance ou taille (norme entre ]0,2pi]) entre WEST_COORD%LON et EAST_COORD%LON
! dans le sens des aiguilles d'une montre en regardant du Pole Sud vers le Pole Nord ( ceci
! pour ne pas calculer le complementaire a 2pi ).

! Computes distance or length (norm in ]0,2pi]) between WEST_COORD%LON and EAST_COORD%LON in
! clockwise seeing from South Pole to North Pole.

type(lola), INTENT(IN)                       :: west_coord, east_coord
REAL(KIND=JPRD), INTENT(IN), OPTIONAL         :: PI 

REAL(KIND=JPRD)                            :: TPI
REAL(KIND=JPRD)                            :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('EGGANGLES:SIZE_W2E_S',0,zhook_handle)    

IF (PRESENT(pi)) THEN
  tpi = pi
ELSE
  tpi = asin(1.0_jprd)*2.0_jprd
ENDIF
taille = size_w2e(west_coord%LON,east_coord%LON,tpi)

IF (lhook) CALL dr_hook('EGGANGLES:SIZE_W2E_S',1,zhook_handle)
END FUNCTION size_w2e_s
! -------------------------------------------------------------------------------
END MODULE eggangles