GCC Code Coverage Report

Directory: ./
File: rad/gpxyb.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 32 64 50.0%
Branches: 15 40 37.5%
Line Branch Exec Source
1 1 SUBROUTINE GPXYB(KPROMA,KSTART,KPROF,KFLEV,PVDELB,PVC,&
2 1 & PRES,PDELP,PRDELP,PLNPR,PALPH,PRTGR,&
3 & PRPRES,PRPP)
4
5 !**** *GPXYB* - Computes auxillary arrays
6
7 ! Purpose.
8 ! --------
9 ! COMPUTES AUXILLARY ARRAYS RELATED TO THE HYBRID COORDINATE
10
11 !** Interface.
12 ! ----------
13 ! *CALL* *GPXYB(..)
14
15 ! Explicit arguments :
16 ! --------------------
17 ! KPROMA : dimensioning
18 ! KSTART : start of work
19 ! KPROF : depth of work
20 ! KFLEV : vert. dimensioning
21
22 ! PVDELB(KPROMA,0:KFLEV) : related to vert. coordinate (input)
23 ! PVC (KPROMA,0:KFLEV) : " " " " " (input)
24 ! PRES (KPROMA,0:KFLEV) : HALF LEVEL PRESSURE (input)
25 ! PDELP (KPROMA,KFLEV) : PRESSURE DIFFERENCE ACROSS LAYERS (output)
26 ! PRDELP(KPROMA,KFLEV) : THEIR INVERSE (output)
27 ! PLNPR (KPROMA,KFLEV) : LOGARITHM OF RATIO OF PRESSURE (output)
28 ! PALPH (KPROMA,KFLEV) : COEFFICIENTS OF THE HYDROSTATICS (output)
29 ! PRTGR (KPROMA,KFLEV) : FOR PRES. GRAD. TERM AND ENE. CONV.(output)
30 ! ((rssavnabla prehyd/prehyd)_[layer]
31 ! = prtgr_[layer] * (rssavnabla prehyds))
32 ! PRPRES(KPROMA,KFLEV) : inverse of HALF LEVEL PRESSURE (output)
33 ! PRPP (KPROMA,KFLEV) : inverse of PRES(J)*PRES(J-1) (output)
34
35 ! Implicit arguments : None.
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 : 88-02-04
56 ! Modified : 94-10-11 by Radmila Bubnova: correction in the case
57 ! of the other approximation of d (ln p).
58 ! Modified : 99-06-04 Optimisation D.SALMOND
59 ! Modified : 02-03-08 K. YESSAD: consistent discretisations of
60 ! "alpha" (PALPH) and "prtgr" (PRTGR)
61 ! for finite element vertical discretisation
62 ! to allow model to run with MF-physics and DDH.
63 ! Modified : 03-07-07 J. Hague: Replace divides with reciprocal
64 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
65 ! Modified : 15-Feb-2005 by K. YESSAD: ZTOPPRES becomes TOPPRES
66 ! ------------------------------------------------------------------
67
68 USE PARKIND1 ,ONLY : JPIM ,JPRB
69 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
70
71 USE YOMDYN , ONLY : NDLNPR ,RHYDR0
72 USE YOMCST , ONLY : RD ,RCVD
73 USE YOMGEM , ONLY : VDELA ,VAF ,VBF ,TOPPRES
74 USE YOMCVER , ONLY : LVERTFE
75
76 ! ------------------------------------------------------------------
77
78 IMPLICIT NONE
79
80 INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA
81 INTEGER(KIND=JPIM),INTENT(IN) :: KFLEV
82 INTEGER(KIND=JPIM),INTENT(IN) :: KSTART
83 INTEGER(KIND=JPIM),INTENT(IN) :: KPROF
84 REAL(KIND=JPRB) ,INTENT(IN) :: PVDELB(KFLEV)
85 REAL(KIND=JPRB) ,INTENT(IN) :: PVC(KFLEV)
86 REAL(KIND=JPRB) ,INTENT(IN) :: PRES(KPROMA,0:KFLEV)
87 REAL(KIND=JPRB) ,INTENT(INOUT) :: PDELP(KPROMA,KFLEV)
88 REAL(KIND=JPRB) ,INTENT(INOUT) :: PRDELP(KPROMA,KFLEV)
89 REAL(KIND=JPRB) ,INTENT(INOUT) :: PLNPR(KPROMA,KFLEV)
90 REAL(KIND=JPRB) ,INTENT(OUT) :: PALPH(KPROMA,KFLEV)
91 REAL(KIND=JPRB) ,INTENT(OUT) :: PRTGR(KPROMA,KFLEV)
92 REAL(KIND=JPRB) ,INTENT(OUT) :: PRPRES(KPROMA,KFLEV)
93 REAL(KIND=JPRB) ,INTENT(INOUT) :: PRPP(KPROMA,KFLEV)
94
95 ! ------------------------------------------------------------------
96
97 INTEGER(KIND=JPIM) :: IFIRST, JLEV, JLON, JJ, JTEMP, JM
98
99 REAL(KIND=JPRB) :: ZPRESF
100 2 REAL(KIND=JPRB) :: ZRPRES(KPROMA,2)
101 REAL(KIND=JPRB) :: ZPRESFD
102 REAL(KIND=JPRB) :: ZHOOK_HANDLE
103
104 ! ------------------------------------------------------------------
105
106 INTERFACE
107 SUBROUTINE ABOR1(CDTEXT)
108 CHARACTER(LEN=*) :: CDTEXT
109 END SUBROUTINE ABOR1
110 END INTERFACE
111
112 ! ------------------------------------------------------------------
113
114
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (LHOOK) CALL DR_HOOK('GPXYB',0,ZHOOK_HANDLE)
115
116 ! ------------------------------------------------------------------
117
118 !* 0. Level to begin normal computations
119 ! ----------------------------------
120
121 ! This is introduced to allow the use of GPXYB without the implicit
122 ! assumption that the top level input for pressure is 0 hPa. This
123 ! is used in the surface observation operators where you do not want
124 ! to compute geopotential at all model levels.
125 ! The first block if is for economy (no do loop start up) and the second
126 ! for safety.
127 !print *,'GPXYB: NDLNPR RHYDR0=',NDLNPR,RHYDR0
128 1 TOPPRES=0.1 !!!!! A REVOIR (MPL) 29042010 passe de 0 a 0.1 comme ARPEGE
129
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF(PRES(KSTART,0) <= TOPPRES)THEN
130 IFIRST=2
131 ELSE
132 IFIRST=1
133 ✗ DO JLON=KSTART,KPROF
134 ✗ IF(PRES(JLON,0) <= TOPPRES)then
135 IFIRST=2
136 EXIT
137 ENDIF
138 ENDDO
139 ENDIF
140 ! ------------------------------------------------------------------
141
142 !* 1. COMPUTES EVERYTHING.
143 ! --------------------
144
145 !print *,'NDLNPR LVERTFE',NDLNPR,LVERTFE
146
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF(NDLNPR == 0) THEN
147
148
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF(LVERTFE) THEN
149 ✗ DO JLEV=1,KFLEV
150 ✗ DO JLON=KSTART,KPROF
151 ✗ PDELP(JLON,JLEV)=VDELA(JLEV) + PVDELB(JLEV)*PRES(JLON,KFLEV)
152 ✗ PRDELP(JLON,JLEV)=1.0_JPRB/PDELP(JLON,JLEV)
153 ✗ ZPRESF =VAF(JLEV) + VBF(JLEV)*PRES(JLON,KFLEV)
154 ✗ ZPRESFD=1.0_JPRB/ZPRESF
155 ✗ PLNPR(JLON,JLEV)=PDELP(JLON,JLEV)*ZPRESFD
156 ! * PRTGR needed for DDH and option LVERCOR=T.
157 ! for finite element vertical discretisation,
158 ! "prtgr_[layer]" is simply B_[layer]/prehyd_[layer]
159 ✗ PRTGR (JLON,JLEV)=VBF(JLEV)*ZPRESFD
160 ! * PALPH needed for MF physics:
161 ✗ PALPH(JLON,JLEV)=(PRES(JLON,JLEV)-ZPRESF)*ZPRESFD
162 ENDDO
163 ENDDO
164 ELSE
165 JJ=1
166 JM=2
167
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
 2 DO JLON=KSTART,KPROF
168 2 ZRPRES(JLON,JM)=1.0_JPRB/PRES(JLON,IFIRST-1)
169 ENDDO
170
2/2
✓ Branch 0 taken 38 times.
✓ Branch 1 taken 1 times.
 39 DO JLEV=IFIRST,KFLEV
171
2/2
✓ Branch 0 taken 38 times.
✓ Branch 1 taken 38 times.
 76 DO JLON=KSTART,KPROF
172 38 ZRPRES(JLON,JJ)=1.0_JPRB/PRES(JLON,JLEV)
173 38 PDELP (JLON,JLEV)=PRES(JLON,JLEV)-PRES(JLON,JLEV-1)
174 38 PRDELP(JLON,JLEV)=1.0_JPRB/PDELP(JLON,JLEV)
175 38 PLNPR (JLON,JLEV)=LOG(PRES(JLON,JLEV)*ZRPRES(JLON,JM))
176 38 PRPRES(JLON,JLEV)=ZRPRES(JLON,JJ)
177 PALPH (JLON,JLEV)=1.0_JPRB-PRES(JLON,JLEV-1)*PRDELP(JLON,JLEV)&
178 38 & *PLNPR(JLON,JLEV)
179 38 PRPP (JLON,JLEV)=ZRPRES(JLON,JJ)*ZRPRES(JLON,JM)
180 PRTGR (JLON,JLEV)=PRDELP(JLON,JLEV)&
181 & *(PVDELB(JLEV)+PVC(JLEV)*PLNPR(JLON,JLEV)*PRDELP(JLON,&
182 76 & JLEV))
183 ! print *,'GPXYB JLEV JLON JJ PRES ZPRES PDELP ', JLEV,JLON,JJ,PRES(JLON,JLEV),ZRPRES(JLON,JJ),PDELP(JLON,JLEV)
184 ! print *,'GPXYB JLEV JLON JM PRDELP PLNPR ', JLEV,JLON,JM,PRDELP(JLON,JLEV),PLNPR (JLON,JLEV)
185 ! print *,'GPXYB JLEV JLON JJ PRPRES PALPH ', JLEV,JLON,JJ,PRPRES(JLON,JLEV),PALPH (JLON,JLEV)
186 ! print *,'GPXYB JLEV JLON PRPP PRTGR PVDELB PVC ', JLEV,JLON,PRPP (JLON,JLEV),PRTGR (JLON,JLEV),PVDELB(JLEV),PVC(JLEV)
187 ENDDO
188 JTEMP=JM
189 JM=JJ
190 1 JJ=JTEMP
191 ENDDO
192
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
 2 DO JLEV=1,IFIRST-1
193
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
 3 DO JLON=KSTART,KPROF
194 1 PDELP (JLON,JLEV)=PRES(JLON,JLEV)-PRES(JLON,JLEV-1)
195 1 PRDELP(JLON,JLEV)=1.0_JPRB/PDELP(JLON,JLEV)
196 1 PLNPR (JLON,JLEV)=LOG(PRES(JLON,1)/TOPPRES)
197 1 PRPRES(JLON,JLEV)=1.0_JPRB/PRES(JLON,1)
198 1 PALPH (JLON,JLEV)=RHYDR0
199 1 PRPP (JLON,JLEV)=1.0_JPRB/(PRES(JLON,1)*TOPPRES)
200 2 PRTGR (JLON,JLEV)=PRDELP(JLON,JLEV)*PVDELB(JLEV)
201 ENDDO
202 ENDDO
203 ENDIF
204
205 ✗ ELSEIF(NDLNPR == 1) THEN
206 ✗ IF(LVERTFE) THEN
207 ✗ CALL ABOR1(' LVERTFE=.T. NOT COMPATIBLE WITH NDLNPR == 1')
208 ENDIF
209
210 ✗ DO JLEV=IFIRST,KFLEV
211 ✗ DO JLON=KSTART,KPROF
212 ✗ PDELP (JLON,JLEV)=PRES(JLON,JLEV)-PRES(JLON,JLEV-1)
213 ✗ PRDELP(JLON,JLEV)=1.0_JPRB/PDELP(JLON,JLEV)
214 ✗ PRPP (JLON,JLEV)=1.0_JPRB/(PRES(JLON,JLEV)*PRES(JLON,JLEV-1))
215 ✗ PLNPR (JLON,JLEV)=PDELP(JLON,JLEV)*SQRT(PRPP(JLON,JLEV))
216 PALPH (JLON,JLEV)=1.0_JPRB-PRES(JLON,JLEV-1)*PRDELP(JLON,JLEV)&
217 ✗ & *PLNPR(JLON,JLEV)
218 PRTGR (JLON,JLEV)=PRDELP(JLON,JLEV)&
219 & *(PVDELB(JLEV)+PVC(JLEV)*PLNPR(JLON,JLEV)*PRDELP(JLON,&
220 ✗ & JLEV))
221 ✗ PRPRES(JLON,JLEV)=1.0_JPRB/PRES(JLON,JLEV)
222 ENDDO
223 ENDDO
224
225 ✗ DO JLEV=1,IFIRST-1
226 ✗ DO JLON=KSTART,KPROF
227 ✗ PDELP (JLON,JLEV)=PRES(JLON,JLEV)
228 ✗ PRDELP(JLON,JLEV)=1.0_JPRB/PDELP(JLON,JLEV)
229 ✗ PLNPR (JLON,JLEV)=2.0_JPRB+RCVD/RD
230 ✗ PALPH (JLON,JLEV)=1.0_JPRB
231 ✗ PRTGR (JLON,JLEV)=PRDELP(JLON,JLEV)*PVDELB(JLEV)
232 ✗ PRPRES(JLON,JLEV)=1.0_JPRB/PRES(JLON,1)
233 ✗ PRPP (JLON,JLEV)=(PLNPR(JLON,JLEV)*PRDELP(JLON,JLEV))**2
234 ENDDO
235 ENDDO
236
237 ENDIF
238
239 ! (PLNPR(JLON,1) AND PRPP(JLON,1) ARE A PRIORI NOT USED LATER)
240
241 ! ------------------------------------------------------------------
242
243
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (LHOOK) CALL DR_HOOK('GPXYB',1,ZHOOK_HANDLE)
244 1 END SUBROUTINE GPXYB
245