GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/ctstar.F90 Lines: 7 7 100.0 %
Date: 2023-06-30 12:51:15 Branches: 2 2 100.0 %

Line Branch Exec Source
1
288
SUBROUTINE CTSTAR(KPROMA,KSTART,KPROF,PTB,PRESBH,PRESBF,POROG,PTSTAR,PT0)
2
3
!**** *CTSTAR* - COMPUTES STANDARD SURFACE TEMPERATURE
4
!                              AND SURFACE TEMPERATURE.
5
6
!     PURPOSE.
7
!     --------
8
9
!           COMPUTES THE STANDARD SURFACE TEMPERATURE AND THE SURFACE
10
!           TEMPERATURE TO BE USED FOR EXTRAPOLATIONS OF TEMPERATURE
11
!           AND GEOPOTENTIEL.
12
13
!**   INTERFACE.
14
!     ----------
15
!        *CALL* *CTSTAR(..)*
16
17
!        EXPLICIT ARGUMENTS
18
!        --------------------
19
20
!        KPROMA         - HORIZONTAL DIMENSIONS.             (INPUT)
21
!        KSTART         - START OF WORK                      (INPUT)
22
!        KPROF          - DEPTH OF WORK                      (INPUT)
23
24
!        PTB(KPROMA)    - TEMPERATURE AT NFLEVG-1             (INPUT)
25
!        PRESBH(KPROMA) - LOWEST MODEL HALF LEVEL PRESSURES  (INPUT)
26
27
!        PRESBF(KPROMA) - PRESSURE AT NFLEVG-1                (INPUT)
28
!        POROG(KPROMA)  - MODEL ORGRAPHY                     (INPUT)
29
30
31
!        PTSTAR(KPROMA) - SURFACE TEMPERATURE                (OUTPUT)
32
33
!        PT0(KPROMA)    - STANDARD SURFACE TEMPERATURE       (OUTPUT)
34
35
!        IMPLICIT ARGUMENTS :    CONSTANTS FROM YOMSTA,YOMCST.
36
!        --------------------
37
38
!     METHOD.
39
!     -------
40
!        SEE DOCUMENTATION
41
42
!     EXTERNALS.   NONE.
43
!     ----------
44
45
!     REFERENCE.
46
!     ----------
47
!        ECMWF Research Department documentation of the IFS
48
49
!     AUTHOR.
50
!     -------
51
!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*
52
53
!     MODIFICATIONS.
54
!     --------------
55
!        ORIGINAL : 89-05-02
56
57
!      Modification : 93-06-01 M.Hamrud (Comment only, now T from NFLEVG-1)
58
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
59
60
!     ------------------------------------------------------------------
61
62
!USE PARKIND1
63
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/parkind1.F90.php#parkind1>  ,ONLY : JPIM     ,JPRB
64
!USE YOMHOOK
65
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/yomhook.F90.php#yomhook>   ,ONLY : LHOOK,   DR_HOOK
66
67
!USE YOMCST, ONLY : RG, RD
68
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomcst.F90.php#yomcst>   , ONLY :  RG
69
70
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>       ,RD
71
!USE YOMSTA
72
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomsta.F90.php#yomsta>   , ONLY : RDTDZ1
73
74
IMPLICIT NONE
75
76
include "YOMCST.h"
77
!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
78
!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART
79
!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF
80
INTEGER,INTENT(IN)    :: KPROMA
81
INTEGER,INTENT(IN)    :: KSTART
82
INTEGER,INTENT(IN)    :: KPROF
83
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PTB(KPROMA)
84
REAL   ,INTENT(IN)    :: PTB(KPROMA)
85
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBH(KPROMA)
86
REAL   ,INTENT(IN)    :: PRESBH(KPROMA)
87
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBF(KPROMA)
88
REAL   ,INTENT(IN)    :: PRESBF(KPROMA)
89
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(KPROMA)
90
REAL   ,INTENT(IN)    :: POROG(KPROMA)
91
!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTSTAR(KPROMA)
92
REAL   ,INTENT(OUT)   :: PTSTAR(KPROMA)
93
!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PT0(KPROMA)
94
REAL   ,INTENT(OUT)   :: PT0(KPROMA)
95
!IM INTEGER(KIND=JPIM) :: JL
96
INTEGER :: JL
97
98
!IM REAL(KIND=JPRB) :: ZALPHA, ZDTDZSG
99
REAL :: ZALPHA, ZDTDZSG
100
!IM REAL(KIND=JPRB) :: ZHOOK_HANDLE
101
REAL :: ZHOOK_HANDLE
102
!IM beg
103
REAL, PARAMETER                  :: RDTDZ1=-0.0065 !or USE YOMSTA
104
!IM end
105
106
!     ------------------------------------------------------------------
107
108
!*       1.    COMPUTES SURFACE TEMPERATURE
109
!*             THEN STANDARD SURFACE TEMPERATURE.
110
111
!IF (LHOOK) CALL DR_HOOK('CTSTAR',0,ZHOOK_HANDLE)
112
288
ZDTDZSG=-RDTDZ1/RG
113
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>
114
288
ZALPHA=ZDTDZSG*RD
115
286560
DO JL=KSTART,KPROF
116
117
   !IM PTSTAR(JL)=PTB(JL)*(1.0_JPRB+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0_JPRB))
118
286272
   PTSTAR(JL)=PTB(JL)*(1.0+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0))
119
286560
   PT0(JL)=PTSTAR(JL)+ZDTDZSG*POROG(JL)
120
!  print*,'cstar JL ptb zalpha PRESBH PRESBF ptstar' &
121
!  ,JL,PTB(JL),ZALPHA,PRESBH(JL),PRESBF(JL),PTSTAR(JL)
122
ENDDO
123
124
125
!     ------------------------------------------------------------------
126
127
!IF (LHOOK) CALL DR_HOOK('CTSTAR',1,ZHOOK_HANDLE)
128
288
END SUBROUTINE CTSTAR