GCC Code Coverage Report


Directory: ./
File: rad/gppref.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 7 7 100.0%
Branches: 6 8 75.0%

Line Branch Exec Source
1 1 SUBROUTINE GPPREF(KPROMA,KSTART,KPROF,KFLEV,PVAH,PVBH,PALPH,PRESH,PRESF)
2
3 !**** *GPPREF* - Computes full level pressure
4
5 ! Purpose.
6 ! --------
7 ! Computes pressures at half and full model levels.
8
9 !** Interface.
10 ! ----------
11 ! *CALL* *GPPREF(...)
12
13 ! Explicit arguments :
14 ! --------------------
15 ! KPROMA : dimensioning
16 ! KSTART : start of work
17 ! KPROF : depth of work
18 ! KFLEV : vert. dimensioning
19 ! PVAH(KFLEV),PVBH(KFLEV)- vertical coordinate
20 ! PALPH (KPROMA,KFLEV) - COEFF OF THE HYDROST
21 ! PRESH(KPROMA,0:KFLEV) - HALF LEVEL PRESSURE
22 ! PRESF(KPROMA,KFLEV) - FULL LEVEL PRESSURE
23 !
24 ! Implicit arguments : NONE.
25 ! --------------------
26
27 ! Method.
28 ! -------
29 ! See documentation
30
31 ! Externals. None.
32 ! ----------
33
34 ! Reference.
35 ! ----------
36 ! ECMWF Research Department documentation of the IFS
37
38 ! PHk*ln(PHk) - PHk-1*ln(PHk-1)
39 ! Full level P: ln(PFk) = [ ------------------------------- - 1. ]
40 ! PHk - PHk-1
41
42 ! which simplifies to: PFk = Pk+1/2 * exp(-ALPHA)
43
44 ! In case of NDLNPR=1 it becomes even simpler (no need of LAPRXP any
45 ! more in principle !) :
46 ! PFk = Pk+1/2 * (1.-ALPHA) except at the top
47 ! level :
48 ! PF1 = P1.5 / (2+Cv/R)
49
50 ! Author.
51 ! -------
52 ! Erik Andersson, Mats Hamrud and Philippe Courtier *ECMWF*
53
54 ! Modifications.
55 ! --------------
56 ! Original : 92-11-23
57 ! Modified : 95-01-31 by Radmila Bubnova: correction in the case
58 ! of the other approximation of d (ln p).
59 ! Modified : 00-11-22 by Agathe Untch: modifications for vertical
60 ! finite elements
61 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
62 ! Modified : 04-11-15 by K. YESSAD: improve the hierarchy of tests
63 ! Modified : 15-Feb-2005 by K. YESSAD: ZTOPPRES becomes TOPPRES
64 ! ------------------------------------------------------------------
65
66 USE PARKIND1 ,ONLY : JPIM ,JPRB
67 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
68
69 USE YOMCT0 , ONLY : LAPRXPK
70 USE YOMDYN , ONLY : NDLNPR
71 USE YOMCST , ONLY : RD ,RCVD
72 USE YOMCVER , ONLY : LVERTFE
73 USE YOMGEM , ONLY : VAF ,VBF ,TOPPRES
74
75 ! ------------------------------------------------------------------
76
77 IMPLICIT NONE
78
79 INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA
80 INTEGER(KIND=JPIM),INTENT(IN) :: KFLEV
81 INTEGER(KIND=JPIM),INTENT(IN) :: KSTART
82 INTEGER(KIND=JPIM),INTENT(IN) :: KPROF
83 REAL(KIND=JPRB) :: PVAH(0:KFLEV) ! Argument NOT used
84 REAL(KIND=JPRB) :: PVBH(0:KFLEV) ! Argument NOT used
85 REAL(KIND=JPRB) ,INTENT(IN) :: PALPH(KPROMA,KFLEV)
86 REAL(KIND=JPRB) ,INTENT(IN) :: PRESH(KPROMA,0:KFLEV)
87 REAL(KIND=JPRB) ,INTENT(OUT) :: PRESF(KPROMA,KFLEV)
88
89 ! ------------------------------------------------------------------
90
91 INTEGER(KIND=JPIM) :: IFIRST, JLEV, JLON
92 REAL(KIND=JPRB) :: ZMUL
93 REAL(KIND=JPRB) :: ZHOOK_HANDLE
94
95 ! ------------------------------------------------------------------
96
97
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (LHOOK) CALL DR_HOOK('GPPREF',0,ZHOOK_HANDLE)
98
99 ! ------------------------------------------------------------------
100
101 !* 1. Level to begin normal computations
102 ! ----------------------------------
103
104 ! This is introduced to allow the use of GPPREF without the implicit
105 ! assumption that the top level input for pressure is 0 hPa.
106 ! This restriction is only necessary in the case of use of NDLNPR=1.
107 !
108 ! LVERTFE : .T./.F. Finite element/conventional vertical discretisation.
109 ! NDLNPR : NDLNPR=0: conventional formulation of delta, i.e. ln(P(l)/P(l-1)).
110 ! NDLNPR=1: formulation of delta used in non hydrostatic model,
111 ! LAPRXPK : way of computing full-levels pressures in primitive equation
112 !
113 1 LVERTFE=.TRUE. !!!!! A REVOIR (MPL) comment faut-il vraiment calculer PRESF ?
114
115 IF ((.NOT.LVERTFE).AND.(NDLNPR == 1)) THEN
116 IF(PRESH(KSTART,0) <= TOPPRES)THEN
117 IFIRST=2
118 ELSE
119 IFIRST=1
120 DO JLON=KSTART,KPROF
121 IF(PRESH(JLON,0) <= TOPPRES)THEN
122 IFIRST=2
123 EXIT
124 ENDIF
125 ENDDO
126 ENDIF
127 ENDIF
128
129 ! ------------------------------------------------------------------
130
131 !* 2. COMPUTES FULL LEVEL PRESSURES.
132 ! ------------------------------
133
134 IF (LVERTFE) THEN
135
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
40 DO JLEV=1,KFLEV
136 ! print *,'GPPREF: LVERTFE KFLEV KSTART KPROF JLEV',LVERTFE,KFLEV,KSTART,KPROF,JLEV
137
2/2
✓ Branch 0 taken 39 times.
✓ Branch 1 taken 39 times.
79 PRESF(KSTART:KPROF,JLEV)=VAF(JLEV)+VBF(JLEV)*PRESH(KSTART:KPROF,KFLEV)
138 ENDDO
139 ELSE
140 IF (NDLNPR == 0) THEN
141 IF (LAPRXPK) THEN
142 DO JLEV=1,KFLEV
143 DO JLON=KSTART,KPROF
144 PRESF(JLON,JLEV)=(PRESH(JLON,JLEV-1)+PRESH(JLON,JLEV))*0.5_JPRB
145 ENDDO
146 ENDDO
147 ELSE
148 DO JLEV=1,KFLEV
149 DO JLON=KSTART,KPROF
150 PRESF(JLON,JLEV)=EXP(-PALPH(JLON,JLEV))*PRESH(JLON,JLEV)
151 ENDDO
152 ENDDO
153 ENDIF
154 ELSEIF (NDLNPR == 1) THEN
155 DO JLEV=IFIRST,KFLEV
156 DO JLON=KSTART,KPROF
157 PRESF(JLON,JLEV)=(1.0_JPRB-PALPH(JLON,JLEV))*PRESH(JLON,JLEV)
158 ENDDO
159 ENDDO
160 ZMUL=1.0_JPRB/(2.0_JPRB+RCVD/RD)
161 DO JLEV=1,IFIRST-1
162 DO JLON=KSTART,KPROF
163 PRESF(JLON,JLEV)=PRESH(JLON,JLEV)*ZMUL
164 ENDDO
165 ENDDO
166 ENDIF
167 ENDIF
168
169 ! ------------------------------------------------------------------
170
171
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (LHOOK) CALL DR_HOOK('GPPREF',1,ZHOOK_HANDLE)
172 1 END SUBROUTINE GPPREF
173