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 |