ctstar.F90

Go to the documentation of this file.

SUBROUTINE ctstar(KPROMA,KSTART,KPROF,PTB,PRESBH,PRESBF,POROG,PTSTAR,PT0)

!**** *CTSTAR* - COMPUTES STANDARD SURFACE TEMPERATURE
!                              AND SURFACE TEMPERATURE.

!     PURPOSE.
!     --------

!           COMPUTES THE STANDARD SURFACE TEMPERATURE AND THE SURFACE
!           TEMPERATURE TO BE USED FOR EXTRAPOLATIONS OF TEMPERATURE
!           AND GEOPOTENTIEL.

!**   INTERFACE.
!     ----------
!        *CALL* *CTSTAR(..)*

!        EXPLICIT ARGUMENTS
!        --------------------

!        KPROMA         - HORIZONTAL DIMENSIONS.             (INPUT)
!        KSTART         - START OF WORK                      (INPUT)
!        KPROF          - DEPTH OF WORK                      (INPUT)

!        PTB(KPROMA)    - TEMPERATURE AT NFLEVG-1             (INPUT)
!        PRESBH(KPROMA) - LOWEST MODEL HALF LEVEL PRESSURES  (INPUT)

!        PRESBF(KPROMA) - PRESSURE AT NFLEVG-1                (INPUT)
!        POROG(KPROMA)  - MODEL ORGRAPHY                     (INPUT)


!        PTSTAR(KPROMA) - SURFACE TEMPERATURE                (OUTPUT)

!        PT0(KPROMA)    - STANDARD SURFACE TEMPERATURE       (OUTPUT)

!        IMPLICIT ARGUMENTS :    CONSTANTS FROM YOMSTA,YOMCST.
!        --------------------

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.   NONE.
!     ----------

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------
!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 89-05-02

!      Modification : 93-06-01 M.Hamrud (Comment only, now T from NFLEVG-1)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

!USE PARKIND1 

!USE YOMHOOK 


!USE YOMCST, ONLY : RG, RD 



!USE YOMSTA 


IMPLICIT NONE

include "YOMCST.h"
!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART
!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF
INTEGER,INTENT(IN)    :: KPROMA
INTEGER,INTENT(IN)    :: KSTART
INTEGER,INTENT(IN)    :: KPROF
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PTB(KPROMA)
REAL   ,INTENT(IN)    :: PTB(kproma)
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBH(KPROMA)
REAL   ,INTENT(IN)    :: PRESBH(kproma)
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBF(KPROMA)
REAL   ,INTENT(IN)    :: PRESBF(kproma)
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(KPROMA)
REAL   ,INTENT(IN)    :: POROG(kproma)
!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTSTAR(KPROMA)
REAL   ,INTENT(OUT)   :: PTSTAR(kproma)
!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PT0(KPROMA)
REAL   ,INTENT(OUT)   :: PT0(kproma)
!IM INTEGER(KIND=JPIM) :: JL
INTEGER :: JL

!IM REAL(KIND=JPRB) :: ZALPHA, ZDTDZSG
REAL :: ZALPHA, ZDTDZSG
!IM REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL :: ZHOOK_HANDLE
!IM beg
REAL, PARAMETER                  :: RDTDZ1=-0.0065 !or USE YOMSTA
!IM end

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

!*       1.    COMPUTES SURFACE TEMPERATURE
!*             THEN STANDARD SURFACE TEMPERATURE.

!IF (LHOOK) CALL DR_HOOK('CTSTAR',0,ZHOOK_HANDLE)
zdtdzsg=-rdtdz1/rg 

zalpha=zdtdzsg*rd
DO jl=kstart,kprof

   !IM PTSTAR(JL)=PTB(JL)*(1.0_JPRB+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0_JPRB))
   ptstar(jl)=ptb(jl)*(1.0+zalpha*(presbh(jl)/presbf(jl)-1.0))
   pt0(jl)=ptstar(jl)+zdtdzsg*porog(jl)
!  print*,'cstar JL ptb zalpha PRESBH PRESBF ptstar' &
!  ,JL,PTB(JL),ZALPHA,PRESBH(JL),PRESBF(JL),PTSTAR(JL)
ENDDO


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

!IF (LHOOK) CALL DR_HOOK('CTSTAR',1,ZHOOK_HANDLE)
END SUBROUTINE ctstar