mode_trip_function.F90

Go to the documentation of this file.

!########################
MODULE mode_trip_function
!########################
!
!!****  *MODE_TRIP_FUNCTION*
!!
!!    PURPOSE
!!    -------
!    
!      The purpose of this routine is to store here all functions 
!      used by MODE_TRIP_INIT.
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!       NONE          
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme       * Meteo France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    15/04/08
!--------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!-------------------------------------------------------------------------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
 CONTAINS
!-------------------------------------------------------------------------------
!
!     ###############################################
      FUNCTION irnxtx(IX,NX,IRIV) RESULT(KNEXTX)
!     ###############################################
!
IMPLICIT NONE
!
INTEGER, INTENT(IN)  :: IX,NX,IRIV 
INTEGER              :: KNEXTX
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:IRNXTX',0,zhook_handle)
IF(iriv==1.OR.iriv==5)THEN
  knextx = ix 
ELSEIF(iriv==8.OR.iriv==7.OR.iriv==6)THEN
  IF(ix==1)THEN
    knextx = nx
  ELSE
    knextx = ix-1
  ENDIF
ELSEIF(iriv==2.OR.iriv==3.OR.iriv==4)THEN
  IF(ix==nx)THEN
    knextx = 1
  ELSE
    knextx = ix+1
  ENDIF
ELSE
    knextx = 0
ENDIF
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:IRNXTX',1,zhook_handle)
!
END FUNCTION irnxtx
!
!-------------------------------------------------------------------------------
!
!     ###############################################
      FUNCTION irnxty(IY,NY,IRIV) RESULT(KNEXTY)
!     ###############################################
!
IMPLICIT NONE
!
INTEGER, INTENT(IN)  :: IY,NY,IRIV 
INTEGER              :: KNEXTY
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:IRNXTY',0,zhook_handle)
IF(iriv==7.OR.iriv==3)THEN
  knexty = iy 
ELSEIF(iriv==6.OR.iriv==5.OR.iriv==4)THEN
  knexty = iy-1
ELSEIF(iriv==8.OR.iriv==1.OR.iriv==2)THEN
  IF(iy==ny)THEN
    knexty = 0
  ELSE
    knexty = iy+1
  ENDIF
ELSE
  knexty = 0
ENDIF
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:IRNXTY',1,zhook_handle)
!
END FUNCTION irnxty
!
!-------------------------------------------------------------------------------
!
!     ###############################################
      FUNCTION getlon(IX,NX) RESULT(PLON0)
!     ###############################################
!
IMPLICIT NONE
!
INTEGER, INTENT(IN)  :: IX,NX 
REAL                 :: PLON0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GETLON',0,zhook_handle)
plon0 = 360.0 * (REAL(ix)-0.5) / REAL(NX) - 180.0
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GETLON',1,zhook_handle)
!
END FUNCTION getlon
!
!-------------------------------------------------------------------------------
!
!     ###############################################
      FUNCTION getlat(IY,NY) RESULT(PLAT0)
!     ###############################################
!
IMPLICIT NONE
!
INTEGER, INTENT(IN)  :: IY,NY 
REAL                 :: PLAT0
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GETLAT',0,zhook_handle)
plat0 = 180.0 * (REAL(iy)-0.5) / REAL(NY) - 90.0
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GETLAT',1,zhook_handle)
!
END FUNCTION getlat
!
!-------------------------------------------------------------------------------
!
!     ###############################################
      FUNCTION givelon(ZY) RESULT(PDLON)
!     ###############################################
!
USE modd_trip_par, ONLY : xpi, xrad
!
IMPLICIT NONE
!
REAL, INTENT(IN)  :: ZY
REAL              :: PDLON
!
REAL, PARAMETER   :: ZE2 = 0.006694470
REAL :: ZR, ZY_RAD, ZRA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GIVELON',0,zhook_handle)
zra = xrad/1000.0
!
zy_rad = zy * xpi / 180.
!
pdlon = xpi / 180.0 * zra * cos(zy_rad) / sqrt(1.0 - ze2 * sin(zy_rad) * sin(zy_rad))
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GIVELON',1,zhook_handle)
!
END FUNCTION givelon
!
!-------------------------------------------------------------------------------
!
!     ###############################################
      FUNCTION givelat(ZY) RESULT(PDLAT)
!     ###############################################
!
USE modd_trip_par, ONLY : xpi, xrad
!
IMPLICIT NONE
!
REAL, INTENT(IN)  :: ZY
REAL              :: PDLAT
!
REAL, PARAMETER   :: ZE2 = 0.006694470
REAL :: ZR, ZY_RAD, ZRA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GIVELAT',0,zhook_handle)
zra = xrad/1000.0
!
zy_rad = zy * xpi / 180.
!
pdlat = xpi / 180.0 * zra * (1.0-ze2) / sqrt( (1.0 - ze2 * sin(zy_rad) * sin(zy_rad))**3 )
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GIVELAT',1,zhook_handle)
!
END FUNCTION givelat
!
!-------------------------------------------------------------------------------
!
!     ###############################################
      FUNCTION giverad(ZY) RESULT(PRAD)
!     ###############################################
!
USE modd_trip_par, ONLY : xrad, xpi
!
IMPLICIT NONE
!
REAL, INTENT(IN)  :: ZY
REAL              :: PRAD
!
REAL, PARAMETER   :: ZE2 = 0.006694470
REAL :: ZR, ZY_RAD, ZRN, ZRA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GIVERAD',0,zhook_handle)
zra = xrad/1000.0
!
zy_rad = zy * xpi / 180.
!
zrn = zra / sqrt(1.0 - ze2 *  sin(zy_rad) * sin(zy_rad) )
!
prad = zrn * sqrt( 1.0 - ze2 * sin(zy_rad) + ze2 * ze2 * sin(zy_rad) * sin(zy_rad) )
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GIVERAD',1,zhook_handle)
!
END FUNCTION giverad
!
!-------------------------------------------------------------------------------
!
!     ###############################################
      FUNCTION givelen(ZX,ZY,ZX_N,ZY_N) RESULT(PLEN0)
!     ###############################################
!
IMPLICIT NONE
!
REAL, INTENT(IN)  :: ZX,ZY,ZX_N,ZY_N
REAL              :: PLEN0
!
REAL :: ZLAT, ZDX, ZDY, ZRAD, ZDLON, ZDLAT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GIVELEN',0,zhook_handle)
zdlon = abs(zx-zx_n)
zdlat = abs(zy-zy_n)
!
IF(zdlon>=180.0)zdlon = abs(360.0 - zdlon)
!
plen0 = 0.0
!
IF(zx==zx_n)THEN
  zlat  = (zy+zy_n) / 2.0
  plen0 = givelat(zlat) * zdlat
ELSEIF(zy==zy_n)THEN
  zlat  = zy
  plen0 = givelon(zlat) * zdlon
ELSE
  zlat  = (zy+zy_n) / 2.0
  zrad  = giverad(zlat)
  zdx   = givelon(zlat) * zdlon / zrad
  zdy   = givelat(zlat) * zdlat / zrad
  plen0 = acos(cos(zdx)*cos(zdy)) * zrad
ENDIF
IF (lhook) CALL dr_hook('MODE_TRIP_FUNCTION:GIVELEN',1,zhook_handle)
!
END FUNCTION givelen
!
!-------------------------------------------------------------------------------
!
END MODULE mode_trip_function