local_trafos.F90

Go to the documentation of this file.

MODULE local_trafos
!**** LOCAL_TRAFOS transform localized quantities to other quantities

!     Purpose.
!     --------
!     Transform wind speed, direction to components and vice versa
!     Other functions also: value extracted from an array with an index
!        defined from a second array

!**   Interface.
!     ----------
!        USE LOCAL_TRAFOS

!     Author.
!     -------
!        H. Hersbach     ECMWF

!     Modifications.
!     --------------
!        Original: 2007-04-11

!        2009-09-04 C. Payan IVALFROMIDX added
!            allows to match an integer in an array from the index of an 
!            other integer's array

!     ------------------------------------------------------------------


USE parkind1  ,ONLY : jpim, jprm, jprd
USE yomhook   ,ONLY : lhook,   dr_hook

IMPLICIT NONE

PRIVATE

INTERFACE ucom
  MODULE PROCEDURE ucom4, ucom8
END INTERFACE

INTERFACE vcom
  MODULE PROCEDURE vcom4, vcom8
END INTERFACE

INTERFACE uv2ff
  MODULE PROCEDURE uv2ff4, uv2ff8
END INTERFACE

INTERFACE uv2dd
  MODULE PROCEDURE uv2dd4, uv2dd8
END INTERFACE

PUBLIC ucom, vcom, uv2ff, uv2dd, ivalfromidx

REAL(KIND=JPRM), PARAMETER :: parc4=360._jprm
REAL(KIND=JPRM), PARAMETER :: degcon4=3.14159265358979_jprm/180._jprm

REAL(KIND=JPRD), PARAMETER :: parc8=360._jprd
REAL(KIND=JPRD), PARAMETER :: degcon8=3.14159265358979_jprd/180._jprd


CONTAINS

!***********************************************************************
FUNCTION ucom4(PDD,PFF) RESULT(UCOM)
REAL(KIND=JPRM)                  :: UCOM 
REAL(KIND=JPRM)   ,INTENT(IN)    :: PDD,PFF 
REAL(KIND=JPRD)                  :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UCOM',0,zhook_handle)
ucom = -pff * sin(pdd*degcon4)
IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UCOM',1,zhook_handle)
END FUNCTION ucom4

FUNCTION ucom8(PDD,PFF) RESULT(UCOM)
REAL(KIND=JPRD)                  :: UCOM 
REAL(KIND=JPRD)   ,INTENT(IN)    :: PDD,PFF 
REAL(KIND=JPRD)                  :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UCOM',0,zhook_handle)
ucom = -pff * sin(pdd*degcon8)
IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UCOM',1,zhook_handle)
END FUNCTION ucom8


!***********************************************************************
FUNCTION vcom4(PDD,PFF) RESULT(VCOM)
REAL(KIND=JPRM)                  :: VCOM 
REAL(KIND=JPRM)   ,INTENT(IN)    :: PDD,PFF 
REAL(KIND=JPRD)                  :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:VCOM',0,zhook_handle)
vcom = -pff * cos(pdd*degcon4)
IF (lhook) CALL dr_hook('LOCAL_TRAFOS:VCOM',1,zhook_handle)
END FUNCTION vcom4

FUNCTION vcom8(PDD,PFF) RESULT(VCOM)
REAL(KIND=JPRD)                  :: VCOM 
REAL(KIND=JPRD)   ,INTENT(IN)    :: PDD,PFF 
REAL(KIND=JPRD)                  :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:VCOM',0,zhook_handle)
vcom = -pff * cos(pdd*degcon8)
IF (lhook) CALL dr_hook('LOCAL_TRAFOS:VCOM',1,zhook_handle)
END FUNCTION vcom8


!***********************************************************************
FUNCTION uv2ff4(PUU,PVV) RESULT(UV2FF)
REAL(KIND=JPRM)                  :: UV2FF 
REAL(KIND=JPRM)   ,INTENT(IN)    :: PUU,PVV
REAL(KIND=JPRD)                  :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UV2FF',0,zhook_handle)
uv2ff =sqrt(puu*puu+pvv*pvv)
IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UV2FF',1,zhook_handle)
END FUNCTION uv2ff4

FUNCTION uv2ff8(PUU,PVV) RESULT(UV2FF)
REAL(KIND=JPRD)                  :: UV2FF 
REAL(KIND=JPRD)   ,INTENT(IN)    :: PUU,PVV
REAL(KIND=JPRD)                  :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UV2FF',0,zhook_handle)
uv2ff =sqrt(puu*puu+pvv*pvv)
IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UV2FF',1,zhook_handle)
END FUNCTION uv2ff8


!***********************************************************************
FUNCTION uv2dd4(PUU,PVV) RESULT(UV2DD)
REAL(KIND=JPRM)                  :: UV2DD
REAL(KIND=JPRM)   ,INTENT(IN)    :: PUU,PVV
REAL(KIND=JPRD)                  :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UV2DD',0,zhook_handle)

IF (puu == 0._jprm .AND. pvv == 0._jprm) THEN
   uv2dd = 0.5_jprm*parc4
ELSE
   uv2dd =mod(parc4+atan2(-puu,-pvv)/degcon4,parc4)
ENDIF
      
IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UV2DD',1,zhook_handle)
END FUNCTION uv2dd4

FUNCTION uv2dd8(PUU,PVV) RESULT(UV2DD)
REAL(KIND=JPRD)                  :: UV2DD
REAL(KIND=JPRD)   ,INTENT(IN)    :: PUU,PVV
REAL(KIND=JPRD)                  :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UV2DD',0,zhook_handle)

IF (puu == 0._jprd .AND. pvv == 0._jprd) THEN
   uv2dd = 0.5_jprd*parc8
ELSE
   uv2dd =mod(parc8+atan2(-puu,-pvv)/degcon8,parc8)
ENDIF
      
IF (lhook) CALL dr_hook('LOCAL_TRAFOS:UV2DD',1,zhook_handle)
END FUNCTION uv2dd8

!***********************************************************************
FUNCTION ivalfromidx(KTABVAL,KTABIDX,KCOND,KDEFAULT)
INTEGER(KIND=JPIM)               :: IVALFROMIDX
INTEGER(KIND=JPIM) ,DIMENSION(:) ,INTENT(IN)  :: KTABVAL ,KTABIDX
INTEGER(KIND=JPIM) ,INTENT(IN)   :: KCOND ,KDEFAULT
INTEGER(KIND=JPIM)               :: JJ ,IMXIDX
REAL(KIND=JPRD)                  :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:IVALFROMIDX',0,zhook_handle)

ivalfromidx=kdefault
imxidx=min(SIZE(ktabidx),SIZE(ktabval))

DO jj=1,imxidx
  IF (ktabidx(jj)==kcond) THEN
    ivalfromidx=ktabval(jj)
    EXIT
  ENDIF
ENDDO

IF (lhook) CALL dr_hook('LOCAL_TRAFOS:IVALFROMIDX',1,zhook_handle)
END FUNCTION ivalfromidx

!***********************************************************************
END MODULE local_trafos