GCC Code Coverage Report


Directory: ./
File: phys/ctstar.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 7 7 100.0%
Branches: 2 2 100.0%

Line Branch Exec Source
1 480 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 480 ZDTDZSG=-RDTDZ1/RG
113 !<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>
114 480 ZALPHA=ZDTDZSG*RD
115
2/2
✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
477600 DO JL=KSTART,KPROF
116
117 !IM PTSTAR(JL)=PTB(JL)*(1.0_JPRB+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0_JPRB))
118 477120 PTSTAR(JL)=PTB(JL)*(1.0+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0))
119 477600 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 480 END SUBROUTINE CTSTAR
129