1 |
|
|
MODULE GFL_SUBS |
2 |
|
|
|
3 |
|
|
! Purpose. |
4 |
|
|
! -------- |
5 |
|
|
|
6 |
|
|
! GFL_SUBS contains routines to do basic manipulatutions of GFL descriptors |
7 |
|
|
|
8 |
|
|
! Author. |
9 |
|
|
! ------- |
10 |
|
|
! Mats Hamrud(ECMWF) |
11 |
|
|
|
12 |
|
|
! Modifications. |
13 |
|
|
! -------------- |
14 |
|
|
! Original : 2003-03-01 |
15 |
|
|
! Modifications: |
16 |
|
|
! 03/07/09 C. Fischer - add Arome/Aladin attributes |
17 |
|
|
! M.Hamrud 01-Oct-2003 CY28 Cleaning |
18 |
|
|
! M. Tudor 31-Oct-2003 physics tendencies |
19 |
|
|
! Y.Tremolet 03-Mar-2004 Protect *EACT_CLOUD_GFL for multiple calls |
20 |
|
|
! Y.Tremolet 12-Mar-2004 Save/falsify GFLC |
21 |
|
|
! J.Haseler 10-Oct-2005 Switch for I/O to trajectory structure |
22 |
|
|
! Y. Bouteloup 28-Jan-2005 Add YR (rain !) in DEACT_CLOUD_GFL |
23 |
|
|
! 20-Feb-2005 J. Vivoda 3TL PC Eulerian scheme, GWADV scheme for PC_FULL |
24 |
|
|
! Y. Bouteloup 25-Dec-2005 Add YS (snow !) in DEACT_CLOUD_GFL |
25 |
|
|
! A. Trojakova 29-June-2006 Add YCPF in DEACT_CLOUD_GFL |
26 |
|
|
!------------------------------------------------------------------------- |
27 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
28 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
29 |
|
|
|
30 |
|
|
USE YOMLUN , ONLY : NULOUT |
31 |
|
|
USE TYPE_GFLS ,ONLY : TYPE_GFL_COMP |
32 |
|
|
USE YOM_YGFL , ONLY : YGFL,JPGFL,YGFLC,YL,YI,YA,YR,YS,YCPF |
33 |
|
|
USE YOPHNC , ONLY : LENCLD2 |
34 |
|
|
USE YOMSLPHY ,ONLY : MSAVTEND_S |
35 |
|
|
USE YOMDIM , ONLY : NFLEVG ,NFLSUL |
36 |
|
|
|
37 |
|
|
IMPLICIT NONE |
38 |
|
|
SAVE |
39 |
|
|
|
40 |
|
|
PRIVATE |
41 |
|
|
!PUBLIC DEFINE_GFL_COMP,PRINT_GFL,SET_GFL_ATTR,DEACT_CLOUD_GFL,REACT_CLOUD_GFL |
42 |
|
|
! MPL 10.12.08 |
43 |
|
|
PUBLIC DEFINE_GFL_COMP,PRINT_GFL,SET_GFL_ATTR |
44 |
|
|
|
45 |
|
|
! For internal use |
46 |
|
|
TYPE(TYPE_GFL_COMP),POINTER :: YLASTGFLC ! Pointer to last defined field |
47 |
|
|
TYPE(TYPE_GFL_COMP),POINTER :: YPTRC ! Temporary field pointer |
48 |
|
|
TYPE(TYPE_GFL_COMP) :: YL_SAVE ! For saving status of cloud fields |
49 |
|
|
TYPE(TYPE_GFL_COMP) :: YI_SAVE ! For saving status of cloud fields |
50 |
|
|
TYPE(TYPE_GFL_COMP) :: YA_SAVE ! For saving status of cloud fields |
51 |
|
|
TYPE(TYPE_GFL_COMP) :: YR_SAVE ! For saving status of cloud fields |
52 |
|
|
TYPE(TYPE_GFL_COMP) :: YS_SAVE ! For saving status of cloud fields |
53 |
|
|
TYPE(TYPE_GFL_COMP) :: YCPF_SAVE ! For saving status of cloud fields |
54 |
|
|
LOGICAL :: L_CLD_DEACT=.FALSE. |
55 |
|
|
|
56 |
|
|
!$OMP THREADPRIVATE(l_cld_deact,ya_save,ycpf_save,yi_save,yl_save,ylastgflc,yptrc,yr_save,ys_save) |
57 |
|
|
|
58 |
|
|
#include "abor1.intfb.h" |
59 |
|
|
|
60 |
|
|
!------------------------------------------------------------------------- |
61 |
|
|
CONTAINS |
62 |
|
|
!------------------------------------------------------------------------- |
63 |
|
|
|
64 |
|
|
SUBROUTINE DEFINE_GFL_COMP(YDGFLC,CDNAME,KGRIB,LDGP,KREQIN,PREFVALI, & |
65 |
|
|
& LDREQOUT,LDERS,LD5,LDT1,LDGPINGP,LDTRAJIO,LDTHERMACT,PR,PRCP) |
66 |
|
|
|
67 |
|
|
!**** *DEFINE_GFL_COMP* - Setup indivual GFL field |
68 |
|
|
|
69 |
|
|
! Purpose. |
70 |
|
|
! -------- |
71 |
|
|
! Basic allocation of GFL descriptor structure (on first call) |
72 |
|
|
! Setup basic attributes of individual GFL component |
73 |
|
|
|
74 |
|
|
! Explicit arguments : |
75 |
|
|
! -------------------- |
76 |
|
|
|
77 |
|
|
! YDGFLC - field handle |
78 |
|
|
! CDNAME - field ARPEGE name |
79 |
|
|
! KGRIB - GRIB code |
80 |
|
|
! LDGP - if TRUE gridpoint field |
81 |
|
|
! KREQIN - 1 if required in input, 0 if not, -1 if initialised with refernence value |
82 |
|
|
! PREFVALI - reference value for initialisation in case NREQIN==-1 |
83 |
|
|
! LDREQOUT- TRUE if requiered in output |
84 |
|
|
! LDERS - TRUE if derivatives required (only possible for spectral field) |
85 |
|
|
! LD5 - TRUE if field needs to be present in trajectory (T5) |
86 |
|
|
! LD1 - TRUE if field needs to be present in t+dt array (GFLT1) |
87 |
|
|
! LDTRAJIO- TRUE if field written to/from trajectory structure files |
88 |
|
|
|
89 |
|
|
! Author. |
90 |
|
|
! ------- |
91 |
|
|
! Mats Hamrud *ECMWF* |
92 |
|
|
|
93 |
|
|
! Modifications. |
94 |
|
|
! -------------- |
95 |
|
|
! Original : 2003-03-01 |
96 |
|
|
! Modifications: |
97 |
|
|
! 03/07/09 C. Fischer - add Arome/Aladin attributes |
98 |
|
|
!------------------------------------------------------------------------- |
99 |
|
|
|
100 |
|
|
TYPE(TYPE_GFL_COMP),TARGET,INTENT(INOUT) :: YDGFLC |
101 |
|
|
CHARACTER(LEN=16),INTENT(IN) :: CDNAME |
102 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KGRIB |
103 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KREQIN |
104 |
|
|
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PREFVALI |
105 |
|
|
LOGICAL,INTENT(IN):: LDREQOUT |
106 |
|
|
LOGICAL,INTENT(IN) :: LDGP |
107 |
|
|
LOGICAL,INTENT(IN) :: LDERS |
108 |
|
|
LOGICAL,INTENT(IN) :: LD5 |
109 |
|
|
LOGICAL,INTENT(IN) :: LDT1 |
110 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDGPINGP |
111 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDTRAJIO |
112 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDTHERMACT |
113 |
|
|
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PR |
114 |
|
|
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PRCP |
115 |
|
|
|
116 |
|
|
INTEGER(KIND=JPIM) :: JGFL, ICURFLDPT, ICURFLDPC |
117 |
|
|
LOGICAL,SAVE :: LLFIRSTCALL = .TRUE. |
118 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
119 |
|
|
!$OMP THREADPRIVATE(llfirstcall) |
120 |
|
|
|
121 |
|
|
|
122 |
|
|
!------------------------------------------------------------------------- |
123 |
|
|
|
124 |
|
|
! 1. Initialization of YGFL on first call to this routine |
125 |
|
|
! ---------------------------------------------------- |
126 |
|
|
|
127 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEFINE_GFL_COMP',0,ZHOOK_HANDLE) |
128 |
|
|
IF(LLFIRSTCALL) THEN |
129 |
|
|
YGFL%NUMFLDS = 0 |
130 |
|
|
YGFL%NUMFLDS9 = 0 |
131 |
|
|
YGFL%NUMFLDS1 = 0 |
132 |
|
|
YGFL%NUMFLDS5 = 0 |
133 |
|
|
YGFL%NUMFLDSPHY = 0 |
134 |
|
|
YGFL%NUMFLDS_SPL = 0 |
135 |
|
|
YGFL%NUMFLDS_SL1 = 0 |
136 |
|
|
YGFL%NUMFLDSPT = 0 |
137 |
|
|
YGFL%NUMFLDSPC = 0 |
138 |
|
|
YGFL%NDIM = 0 |
139 |
|
|
YGFL%NDIM0 = 0 |
140 |
|
|
YGFL%NDIM9 = 0 |
141 |
|
|
YGFL%NDIM1 = 0 |
142 |
|
|
YGFL%NDIM5 = 0 |
143 |
|
|
YGFL%NDIMSLP = 0 |
144 |
|
|
YGFL%NDIM_SPL = 0 |
145 |
|
|
YGFL%NDIMPT = 0 |
146 |
|
|
YGFL%NDIMPC = 0 |
147 |
|
|
YGFL%NDERS = 0 |
148 |
|
|
YGFL%NUMSPFLDS = 0 |
149 |
|
|
YGFL%NUMGPFLDS = 0 |
150 |
|
|
YGFL%NUMSPFLDS1 = 0 |
151 |
|
|
DO JGFL=1,JPGFL |
152 |
|
|
CALL FALSIFY_GFLC(YGFLC(JGFL)) |
153 |
|
|
YGFLC(JGFL)%MP = -HUGE(JPGFL) |
154 |
|
|
YGFLC(JGFL)%MPL = -HUGE(JPGFL) |
155 |
|
|
YGFLC(JGFL)%MPM = -HUGE(JPGFL) |
156 |
|
|
YGFLC(JGFL)%MP9 = -HUGE(JPGFL) |
157 |
|
|
YGFLC(JGFL)%MP9_PH = -HUGE(JPGFL) |
158 |
|
|
YGFLC(JGFL)%MP1 = -HUGE(JPGFL) |
159 |
|
|
YGFLC(JGFL)%MP5 = -HUGE(JPGFL) |
160 |
|
|
YGFLC(JGFL)%MP5L = -HUGE(JPGFL) |
161 |
|
|
YGFLC(JGFL)%MP5M = -HUGE(JPGFL) |
162 |
|
|
YGFLC(JGFL)%MPSLP = -HUGE(JPGFL) |
163 |
|
|
YGFLC(JGFL)%MPSP = -HUGE(JPGFL) |
164 |
|
|
YGFLC(JGFL)%MP_SPL = -HUGE(JPGFL) |
165 |
|
|
YGFLC(JGFL)%MP_SL1 = -HUGE(JPGFL) |
166 |
|
|
YGFLC(JGFL)%MP_SLX = -HUGE(JPGFL) |
167 |
|
|
YGFLC(JGFL)%MPPT = -HUGE(JPGFL) |
168 |
|
|
YGFLC(JGFL)%MPPC = -HUGE(JPGFL) |
169 |
|
|
ENDDO |
170 |
|
|
NULLIFY(YLASTGFLC) |
171 |
|
|
LLFIRSTCALL = .FALSE. |
172 |
|
|
ENDIF |
173 |
|
|
|
174 |
|
|
!------------------------------------------------------------------------- |
175 |
|
|
|
176 |
|
|
! 2. Define GFL component |
177 |
|
|
! -------------------- |
178 |
|
|
|
179 |
|
|
! 2.1 Some checks |
180 |
|
|
IF(LDGP) THEN |
181 |
|
|
DO JGFL=1,YGFL%NUMFLDS |
182 |
|
|
IF(.NOT. YGFLC(JGFL)%LGP) THEN |
183 |
|
|
! Grid-point fields should be defined before any spectral field |
184 |
|
|
CALL ABOR1('YOMMFL:DEFINE_GFL_COMP:GRIDPOINT BEFORE SPECTRAL') |
185 |
|
|
ENDIF |
186 |
|
|
ENDDO |
187 |
|
|
ENDIF |
188 |
|
|
IF(LDGP) THEN |
189 |
|
|
IF(LDERS) THEN |
190 |
|
|
! Derivatives can only be defined for spectral fields |
191 |
|
|
CALL ABOR1('YOMMFL:DEFINE_GFL_COMP:DERIVATIVES ONLY WITH SPECTRAL') |
192 |
|
|
ENDIF |
193 |
|
|
ENDIF |
194 |
|
|
IF(YGFL%NUMFLDS == JPGFL) THEN |
195 |
|
|
WRITE(NULOUT,*) ' MAXIMUM NUMBER OF FIELDS ALREADY DEFINED' |
196 |
|
|
CALL ABOR1('YOMMFL: EXCEED NUMBER OF FIELDS') |
197 |
|
|
ENDIF |
198 |
|
|
|
199 |
|
|
! 2.2 Define field attributes |
200 |
|
|
|
201 |
|
|
ICURFLDPT = YGFL%NUMFLDS+1 |
202 |
|
|
ICURFLDPC = YGFL%NUMFLDS+1 |
203 |
|
|
|
204 |
|
|
YDGFLC%LACTIVE = .TRUE. |
205 |
|
|
YDGFLC%CNAME = CDNAME |
206 |
|
|
YDGFLC%IGRBCODE = KGRIB |
207 |
|
|
YDGFLC%NREQIN = KREQIN |
208 |
|
|
IF (PRESENT(PREFVALI)) THEN |
209 |
|
|
YDGFLC%REFVALI = PREFVALI |
210 |
|
|
ENDIF |
211 |
|
|
YDGFLC%LREQOUT = LDREQOUT |
212 |
|
|
YDGFLC%LGP = LDGP |
213 |
|
|
YDGFLC%LSP= .NOT. YDGFLC%LGP |
214 |
|
|
YDGFLC%LT5 = LD5 |
215 |
|
|
YDGFLC%LT1 = LDT1 |
216 |
|
|
YDGFLC%LCDERS = LDERS |
217 |
|
|
IF(PRESENT(LDGPINGP)) YDGFLC%LGPINGP=LDGPINGP |
218 |
|
|
IF(PRESENT(LDTRAJIO)) YDGFLC%LTRAJIO=LDTRAJIO |
219 |
|
|
IF(PRESENT(LDTHERMACT)) YDGFLC%LTHERMACT=LDTHERMACT |
220 |
|
|
IF(YDGFLC%LTHERMACT) THEN |
221 |
|
|
IF(.NOT.PRESENT(PR)) & |
222 |
|
|
&CALL ABOR1('GFL_SUBS:DEFINE_GFL_COMPONENT - PR MISSING') |
223 |
|
|
IF(.NOT.PRESENT(PRCP)) & |
224 |
|
|
&CALL ABOR1('GFL_SUBS:DEFINE_GFL_COMPONENT - PRCP MISSING') |
225 |
|
|
YDGFLC%R = PR |
226 |
|
|
YDGFLC%RCP = PRCP |
227 |
|
|
ENDIF |
228 |
|
|
|
229 |
|
|
! 2.3 Numbers of fields and dimensions |
230 |
|
|
YGFL%NUMFLDS = YGFL%NUMFLDS+1 |
231 |
|
|
IF (YDGFLC%LT5) YGFL%NUMFLDS5 = YGFL%NUMFLDS5+1 |
232 |
|
|
|
233 |
|
|
IF(YDGFLC%LCDERS) THEN |
234 |
|
|
YGFL%NDIM = YGFL%NDIM+3 |
235 |
|
|
YGFL%NDIM0 = YGFL%NDIM0+3 |
236 |
|
|
YGFL%NDERS = YGFL%NDERS+1 |
237 |
|
|
IF (YDGFLC%LT5) YGFL%NDIM5 = YGFL%NDIM5+3 |
238 |
|
|
ELSE |
239 |
|
|
YGFL%NDIM = YGFL%NDIM+1 |
240 |
|
|
YGFL%NDIM0 = YGFL%NDIM0+1 |
241 |
|
|
IF (YDGFLC%LT5) YGFL%NDIM5 = YGFL%NDIM5+1 |
242 |
|
|
ENDIF |
243 |
|
|
|
244 |
|
|
IF(YDGFLC%LSP) THEN |
245 |
|
|
YGFL%NUMSPFLDS =YGFL%NUMSPFLDS+1 |
246 |
|
|
ELSE |
247 |
|
|
YGFL%NUMGPFLDS =YGFL%NUMGPFLDS+1 |
248 |
|
|
ENDIF |
249 |
|
|
|
250 |
|
|
IF (YDGFLC%LT1) THEN |
251 |
|
|
YGFL%NUMFLDS1 = YGFL%NUMFLDS1+1 |
252 |
|
|
YGFL%NDIM1 = YGFL%NDIM1+1 |
253 |
|
|
IF (YDGFLC%LSP) YGFL%NUMSPFLDS1 =YGFL%NUMSPFLDS1+1 |
254 |
|
|
ENDIF |
255 |
|
|
|
256 |
|
|
! 2.4 Define field "pointers" |
257 |
|
|
YDGFLC%MP5 = -HUGE(JPGFL) |
258 |
|
|
IF (YDGFLC%LGP) THEN |
259 |
|
|
YDGFLC%MP = YGFL%NDIM0 |
260 |
|
|
IF (YDGFLC%LT5) YDGFLC%MP5 = YGFL%NDIM5 |
261 |
|
|
ELSE |
262 |
|
|
YDGFLC%MP = YGFL%NUMFLDS |
263 |
|
|
IF (YDGFLC%LT5) YDGFLC%MP5 = YGFL%NUMFLDS5 |
264 |
|
|
ENDIF |
265 |
|
|
IF (YDGFLC%LCDERS) THEN |
266 |
|
|
YDGFLC%MPM = YDGFLC%MP+YGFL%NDERS |
267 |
|
|
YDGFLC%MPL = YDGFLC%MP+2*YGFL%NDERS |
268 |
|
|
IF(YDGFLC%LT5) THEN |
269 |
|
|
YDGFLC%MP5M = YDGFLC%MP5+YGFL%NDERS |
270 |
|
|
YDGFLC%MP5L = YDGFLC%MP5+2*YGFL%NDERS |
271 |
|
|
ENDIF |
272 |
|
|
ELSE |
273 |
|
|
YDGFLC%MPL = -HUGE(JPGFL) |
274 |
|
|
YDGFLC%MPM = -HUGE(JPGFL) |
275 |
|
|
YDGFLC%MP5L = -HUGE(JPGFL) |
276 |
|
|
YDGFLC%MP5M = -HUGE(JPGFL) |
277 |
|
|
ENDIF |
278 |
|
|
|
279 |
|
|
IF(YDGFLC%LSP) THEN |
280 |
|
|
YDGFLC%MPSP = YGFL%NUMSPFLDS |
281 |
|
|
ELSE |
282 |
|
|
YDGFLC%MPSP = -HUGE(JPGFL) |
283 |
|
|
ENDIF |
284 |
|
|
|
285 |
|
|
IF (YDGFLC%LT1) THEN |
286 |
|
|
YDGFLC%MP1 = YGFL%NUMFLDS1 |
287 |
|
|
ELSE |
288 |
|
|
YDGFLC%MP1 = -HUGE(JPGFL) |
289 |
|
|
ENDIF |
290 |
|
|
|
291 |
|
|
! 2.6 Possibly reassign pointers (needed for multiple fields with derivatives) |
292 |
|
|
|
293 |
|
|
IF(ASSOCIATED(YLASTGFLC)) THEN |
294 |
|
|
YPTRC=>YLASTGFLC |
295 |
|
|
DO |
296 |
|
|
IF(.NOT.LDGP) THEN |
297 |
|
|
IF(YPTRC%LCDERS) THEN |
298 |
|
|
YPTRC%MPM = YPTRC%MPM+1 |
299 |
|
|
IF(LDERS)THEN |
300 |
|
|
YPTRC%MPL = YPTRC%MPL+2 |
301 |
|
|
ELSE |
302 |
|
|
YPTRC%MPL = YPTRC%MPL+1 |
303 |
|
|
ENDIF |
304 |
|
|
ENDIF |
305 |
|
|
WRITE(NULOUT,*)' DEFINE_GFL_COMP:CHECKING ',YPTRC%CNAME |
306 |
|
|
WRITE(NULOUT,*)' REASSIGNED MPL=',YPTRC%MPL,' MPM=',YPTRC%MPM |
307 |
|
|
IF (YDGFLC%LT5) THEN |
308 |
|
|
IF(YPTRC%LT5) THEN |
309 |
|
|
IF(YPTRC%LCDERS) THEN |
310 |
|
|
YPTRC%MP5M = YPTRC%MP5M+1 |
311 |
|
|
IF(LDERS)THEN |
312 |
|
|
YPTRC%MP5L = YPTRC%MP5L+2 |
313 |
|
|
ELSE |
314 |
|
|
YPTRC%MP5L = YPTRC%MP5L+1 |
315 |
|
|
ENDIF |
316 |
|
|
ENDIF |
317 |
|
|
WRITE(NULOUT,*)' REASSIGNED MP5L=',YPTRC%MP5L,' MP5M=',YPTRC%MP5M |
318 |
|
|
ENDIF |
319 |
|
|
ENDIF |
320 |
|
|
|
321 |
|
|
ENDIF |
322 |
|
|
IF(.NOT.ASSOCIATED(YPTRC%PREVIOUS)) EXIT |
323 |
|
|
YPTRC=>YPTRC%PREVIOUS |
324 |
|
|
ENDDO |
325 |
|
|
ENDIF |
326 |
|
|
|
327 |
|
|
! 2.7 Point to last defined field |
328 |
|
|
YDGFLC%PREVIOUS=>YLASTGFLC |
329 |
|
|
YLASTGFLC => YDGFLC |
330 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEFINE_GFL_COMP',1,ZHOOK_HANDLE) |
331 |
|
|
|
332 |
|
|
! ------------------------------------------------------------------ |
333 |
|
|
END SUBROUTINE DEFINE_GFL_COMP |
334 |
|
|
|
335 |
|
|
!========================================================================= |
336 |
|
|
|
337 |
|
|
SUBROUTINE SET_GFL_ATTR(YDGFLC,LDADV,LDT9,LDPHY,LDPT,LDPC,LDADJUST0,& |
338 |
|
|
& LDADJUST1,KCOUPLING,PREFVALC,LDBIPER,CDSLINT) |
339 |
|
|
|
340 |
|
|
!**** *SET_GFL_ATTR* Add attributes to previously setup GFL components |
341 |
|
|
|
342 |
|
|
! Purpose. |
343 |
|
|
! -------- |
344 |
|
|
! Add further attributes to previously setup, by call to DEFINE_GFL_COMP, GFL components |
345 |
|
|
|
346 |
|
|
! Explicit arguments : |
347 |
|
|
! -------------------- |
348 |
|
|
! LDADV - TRUE if field to be advected |
349 |
|
|
! LDT9 - TRUE if field present in t-dt |
350 |
|
|
! LDPHY - TRUE if field updated by physics |
351 |
|
|
! LDPT - TRUE if field present in phy. tend. |
352 |
|
|
! LDPC - TRUE if field in predictor/corrector time stepping treatment (3TL) |
353 |
|
|
! LDADJUST0 - TRUE if field to be adjusted at t |
354 |
|
|
! LDADJUST1 - TRUE if field to be adjusted at t+dt |
355 |
|
|
! KCOUPLING - 1 if field to be coupled, 0 if not, -1 if coupled with REFVALC |
356 |
|
|
! REVALC - refernce value for coupling, used only in case NCOUPLING==-1 |
357 |
|
|
! LDBIPER - TRUE if field to be biperiodised |
358 |
|
|
! CDSLINT - S.L. interpolator |
359 |
|
|
|
360 |
|
|
! Author. |
361 |
|
|
! ------- |
362 |
|
|
! Mats Hamrud *ECMWF* |
363 |
|
|
|
364 |
|
|
! Modifications. |
365 |
|
|
! -------------- |
366 |
|
|
! Original : 2003-03-01 |
367 |
|
|
! Modifications: |
368 |
|
|
! 03/07/09 C. Fischer - add Arome/Aladin attributes |
369 |
|
|
! 2004-Nov F. Vana - update of CDSLINT |
370 |
|
|
!------------------------------------------------------------------------- |
371 |
|
|
|
372 |
|
|
TYPE(TYPE_GFL_COMP),TARGET,INTENT(INOUT) :: YDGFLC |
373 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDADV |
374 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDT9 |
375 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDPHY |
376 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDPT |
377 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDPC |
378 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDADJUST0 |
379 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDADJUST1 |
380 |
|
|
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOUPLING |
381 |
|
|
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PREFVALC |
382 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDBIPER |
383 |
|
|
CHARACTER(LEN=12),INTENT(IN),OPTIONAL :: CDSLINT |
384 |
|
|
|
385 |
|
|
INTEGER(KIND=JPIM) :: IGFLPTR |
386 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
387 |
|
|
|
388 |
|
|
!------------------------------------------------------------------------- |
389 |
|
|
|
390 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:SET_GFL_ATTR',0,ZHOOK_HANDLE) |
391 |
|
|
IF(YDGFLC%MP < 1 .OR. YDGFLC%MP > YGFL%NUMFLDS) THEN |
392 |
|
|
CALL ABOR1('SET_GFL_ATTR: GFL COMPONENT NOT SET UP') |
393 |
|
|
ELSE |
394 |
|
|
IGFLPTR=YDGFLC%MP |
395 |
|
|
ENDIF |
396 |
|
|
|
397 |
|
|
IF(PRESENT(LDADV)) THEN |
398 |
|
|
YDGFLC%LADV = LDADV |
399 |
|
|
ENDIF |
400 |
|
|
IF(YDGFLC%LADV) THEN |
401 |
|
|
IF(.NOT.YDGFLC%LT1) THEN |
402 |
|
|
CALL ABOR1(' GFL field to be advected but LT1=false') |
403 |
|
|
ENDIF |
404 |
|
|
YGFL%NUMFLDS_SL1 = YGFL%NUMFLDS_SL1+1 |
405 |
|
|
YDGFLC%MP_SL1 = YGFL%NUMFLDS_SL1 |
406 |
|
|
YDGFLC%MP_SLX = (YGFL%NUMFLDS_SL1-1)*(NFLEVG+2*NFLSUL) |
407 |
|
|
ENDIF |
408 |
|
|
|
409 |
|
|
|
410 |
|
|
! Other timelevels etc. |
411 |
|
|
|
412 |
|
|
IF(PRESENT(LDT9)) THEN |
413 |
|
|
YDGFLC%LT9 = LDT9 |
414 |
|
|
ENDIF |
415 |
|
|
IF(YDGFLC%LT9 .AND. YDGFLC%MP9 == -HUGE(JPGFL) ) THEN |
416 |
|
|
YGFL%NUMFLDS9 = YGFL%NUMFLDS9+1 |
417 |
|
|
YGFL%NDIM = YGFL%NDIM+1 |
418 |
|
|
YGFL%NDIM9 = YGFL%NDIM9+1 |
419 |
|
|
YDGFLC%MP9 = YGFL%NDIM0+YGFL%NUMFLDS9 |
420 |
|
|
YDGFLC%MP9_PH = YDGFLC%MP9 |
421 |
|
|
ELSE |
422 |
|
|
YDGFLC%MP9 = YDGFLC%MP |
423 |
|
|
YDGFLC%MP9_PH = YDGFLC%MP9 |
424 |
|
|
WRITE(NULOUT,*) 'WARNING YDGFLC%MP9 = YDGFLC%MP',YDGFLC%MP9,YDGFLC%MP |
425 |
|
|
ENDIF |
426 |
|
|
|
427 |
|
|
IF(PRESENT(LDPHY)) THEN |
428 |
|
|
YDGFLC%LPHY = LDPHY |
429 |
|
|
ENDIF |
430 |
|
|
IF(YGFL%NUMFLDSPHY == 0)YGFL%NUMFLDSPHY=YGFL%NUMFLDSPHY-MSAVTEND_S |
431 |
|
|
IF(YDGFLC%MPSLP == -HUGE(JPGFL)) THEN |
432 |
|
|
IF(YDGFLC%LPHY) THEN |
433 |
|
|
IF(.NOT.YDGFLC%LT1) THEN |
434 |
|
|
CALL ABOR1(' GFL field to be modified by physics but LT1=false') |
435 |
|
|
ENDIF |
436 |
|
|
YGFL%NUMFLDSPHY = YGFL%NUMFLDSPHY+1+MSAVTEND_S |
437 |
|
|
YGFL%NDIMSLP = YGFL%NDIMSLP+1+MSAVTEND_S |
438 |
|
|
YDGFLC%MPSLP = YGFL%NUMFLDSPHY |
439 |
|
|
ENDIF |
440 |
|
|
ENDIF |
441 |
|
|
|
442 |
|
|
IF(PRESENT(LDPT)) THEN |
443 |
|
|
YDGFLC%LPT = LDPT |
444 |
|
|
ENDIF |
445 |
|
|
IF(YDGFLC%MPPT == -HUGE(JPGFL)) THEN |
446 |
|
|
IF(YDGFLC%LPT) THEN |
447 |
|
|
YGFL%NUMFLDSPT = YGFL%NUMFLDSPT+1 |
448 |
|
|
YGFL%NDIMPT = YGFL%NDIMPT+1 |
449 |
|
|
YDGFLC%MPPT = YGFL%NUMFLDSPT |
450 |
|
|
ENDIF |
451 |
|
|
ENDIF |
452 |
|
|
IF(PRESENT(LDPC)) THEN |
453 |
|
|
YDGFLC%LPC = LDPC |
454 |
|
|
ENDIF |
455 |
|
|
IF(YDGFLC%MPPC == -HUGE(JPGFL)) THEN |
456 |
|
|
IF(YDGFLC%LPC) THEN |
457 |
|
|
YGFL%NUMFLDSPC = YGFL%NUMFLDSPC+1 |
458 |
|
|
YGFL%NDIMPC = YGFL%NDIMPC+1 |
459 |
|
|
YDGFLC%MPPC = YGFL%NUMFLDSPC |
460 |
|
|
ENDIF |
461 |
|
|
ENDIF |
462 |
|
|
|
463 |
|
|
|
464 |
|
|
! LAM attributes (do not involve extra dimensioning or pointers) |
465 |
|
|
|
466 |
|
|
IF(PRESENT(LDADJUST0)) THEN |
467 |
|
|
YDGFLC%LADJUST0 = LDADJUST0 |
468 |
|
|
ENDIF |
469 |
|
|
IF(PRESENT(LDADJUST1)) THEN |
470 |
|
|
YDGFLC%LADJUST1 = LDADJUST1 |
471 |
|
|
ENDIF |
472 |
|
|
IF(PRESENT(KCOUPLING)) THEN |
473 |
|
|
YDGFLC%NCOUPLING = KCOUPLING |
474 |
|
|
ENDIF |
475 |
|
|
IF(PRESENT(PREFVALC)) THEN |
476 |
|
|
YDGFLC%REFVALC = PREFVALC |
477 |
|
|
ENDIF |
478 |
|
|
IF(PRESENT(LDBIPER)) THEN |
479 |
|
|
YDGFLC%LBIPER = LDBIPER |
480 |
|
|
ENDIF |
481 |
|
|
|
482 |
|
|
IF(PRESENT(CDSLINT)) THEN |
483 |
|
|
YDGFLC%CSLINT=CDSLINT |
484 |
|
|
IF(YDGFLC%MP_SPL == -HUGE(JPGFL)) THEN |
485 |
|
|
IF(CDSLINT == 'LAITVSPCQM ') THEN |
486 |
|
|
YGFL%NUMFLDS_SPL = YGFL%NUMFLDS_SPL+1 |
487 |
|
|
YGFL%NDIM_SPL = YGFL%NDIM_SPL+1 |
488 |
|
|
YDGFLC%MP_SPL = YGFL%NUMFLDS_SPL |
489 |
|
|
ENDIF |
490 |
|
|
ENDIF |
491 |
|
|
ENDIF |
492 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:SET_GFL_ATTR',1,ZHOOK_HANDLE) |
493 |
|
|
|
494 |
|
|
! ------------------------------------------------------------------- |
495 |
|
|
END SUBROUTINE SET_GFL_ATTR |
496 |
|
|
|
497 |
|
|
!========================================================================= |
498 |
|
|
|
499 |
|
|
SUBROUTINE PRINT_GFL |
500 |
|
|
|
501 |
|
|
!**** *PRINT_GFL* - Print GFL attributes |
502 |
|
|
|
503 |
|
|
! ------------------------------------------------------------------- |
504 |
|
|
|
505 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
506 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:PRINT_GFL',0,ZHOOK_HANDLE) |
507 |
|
|
WRITE(NULOUT,*) ' ---- GFL COMPONENT ATTRIBUTES ----' |
508 |
|
|
IF(ASSOCIATED(YLASTGFLC)) THEN |
509 |
|
|
YPTRC=>YLASTGFLC |
510 |
|
|
DO |
511 |
|
|
WRITE(NULOUT,*) ' GFL COMPONENT DEFINED - NAME=',& |
512 |
|
|
& YPTRC%CNAME,' GRIBCODE=', YPTRC%IGRBCODE |
513 |
|
|
WRITE(NULOUT,*)' LGP=',YPTRC%LGP,' NREQIN=',YPTRC%NREQIN, & |
514 |
|
|
& ' LREQOUT=',YPTRC%LREQOUT,' REFVALI=',YPTRC%REFVALI, & |
515 |
|
|
& ' LCDERS=', YPTRC%LCDERS,' LADV=',YPTRC%LADV, & |
516 |
|
|
& ' LPHY=',YPTRC%LPHY,' LPT=',YPTRC%LPT,' LPC=',YPTRC%LPC |
517 |
|
|
WRITE(NULOUT,*)' LADJUST0=',YPTRC%LADJUST0,' LADJUST1=',YPTRC%LADJUST1,& |
518 |
|
|
& ' NCOUPLING=',YPTRC%NCOUPLING,' REFVALC=',YPTRC%REFVALC,& |
519 |
|
|
& ' LBIPER=',YPTRC%LBIPER |
520 |
|
|
WRITE(NULOUT,*)' LTRAJIO=',YPTRC%LTRAJIO,' LGPINGP=',YPTRC%LGPINGP |
521 |
|
|
WRITE(NULOUT,*)' CSLINT=',YPTRC%CSLINT |
522 |
|
|
WRITE(NULOUT,*)'LTHERMACT=',YPTRC%LTHERMACT,& |
523 |
|
|
& ' R=',YPTRC%R,' RCP=',YPTRC%RCP |
524 |
|
|
WRITE(NULOUT,*)' MP=',YPTRC%MP,' MPL=',YPTRC%MPL,& |
525 |
|
|
& ' MPM=',YPTRC%MPM,' MP9=',YPTRC%MP9,' MP1=',YPTRC%MP1,& |
526 |
|
|
& ' MP5=',YPTRC%MP5,' MP5L=',YPTRC%MP5L,' MP5M=',YPTRC%MP5M, & |
527 |
|
|
& ' MPSLP=',YPTRC%MPSLP,' MPSP=',YPTRC%MPSP,& |
528 |
|
|
& ' MPPT=',YPTRC%MPPT, ' MPPC=',YPTRC%MPPC |
529 |
|
|
IF(.NOT.ASSOCIATED(YPTRC%PREVIOUS)) EXIT |
530 |
|
|
YPTRC=>YPTRC%PREVIOUS |
531 |
|
|
ENDDO |
532 |
|
|
ENDIF |
533 |
|
|
|
534 |
|
|
WRITE(NULOUT,*) ' ---- YGFL ATTRIBUTES ----' |
535 |
|
|
WRITE(NULOUT,*) ' YGFL%NUMFLDS=',YGFL%NUMFLDS,& |
536 |
|
|
& ' YGFL%NUMSPFLDS=',YGFL%NUMSPFLDS,' YGFL%NUMGPFLDS=',YGFL%NUMGPFLDS,& |
537 |
|
|
& ' YGFL%NDERS=',YGFL%NDERS,' YGFL%NUMFLDSPT=',YGFL%NUMFLDSPT,& |
538 |
|
|
& ' YGFL%NUMFLDSPC=',YGFL%NUMFLDSPC |
539 |
|
|
WRITE(NULOUT,*) ' YGFL%NUMFLDS_SL1=',YGFL%NUMFLDS_SL1 |
540 |
|
|
WRITE(NULOUT,*) ' YGFL%NDIM=',YGFL%NDIM,' YGFL%NDIM0=',YGFL%NDIM0,& |
541 |
|
|
& ' YGFL%NDIM9=',YGFL%NDIM9,' YGFL%NDIM1=',YGFL%NDIM1,& |
542 |
|
|
& ' YGFL%NDIM5=',YGFL%NDIM5,' YGFL%NDIMSLP=',YGFL%NDIMSLP,& |
543 |
|
|
& ' YGFL%NDIMPT=',YGFL%NDIMPT,' YGFL%NDIMPC=',YGFL%NDIMPC |
544 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%CNAMES=',YGFL%CNAMES(1:YGFL%NUMFLDS) |
545 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%IGRBCODE=',YGFL%IGRBCODE(1:YGFL%NUMFLDS) |
546 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%NREQIN=',YGFL%NREQIN(1:YGFL%NUMFLDS) |
547 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%REFVALI=',YGFL%REFVALI(1:YGFL%NUMFLDS) |
548 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LREQOUT=',YGFL%LREQOUT(1:YGFL%NUMFLDS) |
549 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LADV=',YGFL%LADV(1:YGFL%NUMFLDS) |
550 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%CSLINT=',YGFL%CSLINT(1:YGFL%NUMFLDS) |
551 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP=',YGFL%MP(1:YGFL%NUMFLDS) |
552 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LSP=',YGFL%LSP(1:YGFL%NUMFLDS) |
553 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPSP=',YGFL%MPSP(1:YGFL%NUMFLDS) |
554 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LCDERS=',YGFL%LCDERS(1:YGFL%NUMFLDS) |
555 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LTRAJIO=',YGFL%LTRAJIO(1:YGFL%NUMFLDS) |
556 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPL=',YGFL%MPL(1:YGFL%NUMFLDS) |
557 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPM=',YGFL%MPM(1:YGFL%NUMFLDS) |
558 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LT9=',YGFL%LT9(1:YGFL%NUMFLDS) |
559 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP9=',YGFL%MP9(1:YGFL%NUMFLDS) |
560 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LT1=',YGFL%LT1(1:YGFL%NUMFLDS) |
561 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP1=',YGFL%MP1(1:YGFL%NUMFLDS) |
562 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LT5=',YGFL%LT5(1:YGFL%NUMFLDS) |
563 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP5=',YGFL%MP5(1:YGFL%NUMFLDS) |
564 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP5L=',YGFL%MP5L(1:YGFL%NUMFLDS) |
565 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP5M=',YGFL%MP5M(1:YGFL%NUMFLDS) |
566 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LPHY=',YGFL%LPHY(1:YGFL%NUMFLDS) |
567 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPSLP=',YGFL%MPSLP(1:YGFL%NUMFLDS) |
568 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LPT=',YGFL%LPT(1:YGFL%NUMFLDS) |
569 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPPT=',YGFL%MPPT(1:YGFL%NUMFLDS) |
570 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LPC=',YGFL%LPC(1:YGFL%NUMFLDS) |
571 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPPC=',YGFL%MPPC(1:YGFL%NUMFLDS) |
572 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LADJUST0=',YGFL%LADJUST0(1:YGFL%NUMFLDS) |
573 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LADJUST1=',YGFL%LADJUST1(1:YGFL%NUMFLDS) |
574 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%NCOUPLING=',YGFL%NCOUPLING(1:YGFL%NUMFLDS) |
575 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%REFVALC=',YGFL%REFVALC(1:YGFL%NUMFLDS) |
576 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LBIPER=',YGFL%LBIPER(1:YGFL%NUMFLDS) |
577 |
|
|
WRITE(NULOUT,*) ' --------------------------------------------' |
578 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:PRINT_GFL',1,ZHOOK_HANDLE) |
579 |
|
|
END SUBROUTINE PRINT_GFL |
580 |
|
|
|
581 |
|
|
!========================================================================= |
582 |
|
|
|
583 |
|
|
!SUBROUTINE DEACT_CLOUD_GFL ! commente par MPL 10.12.08 (et REACT_CLOUD_GFL) |
584 |
|
|
! |
585 |
|
|
!**** *DEACT_CLOUD_GFL* Deactivate prognostic cloud variables |
586 |
|
|
! |
587 |
|
|
! ------------------------------------------------------------------ |
588 |
|
|
! |
589 |
|
|
!INTEGER(KIND=JPIM) :: JGFL |
590 |
|
|
!REAL(KIND=JPRB) :: ZHOOK_HANDLE |
591 |
|
|
! |
592 |
|
|
!#include "suslb.intfb.h" |
593 |
|
|
! |
594 |
|
|
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEACT_CLOUD_GFL',0,ZHOOK_HANDLE) |
595 |
|
|
! |
596 |
|
|
!IF (.NOT.L_CLD_DEACT .AND. & |
597 |
|
|
! & (YL%LACTIVE .OR. YI%LACTIVE .OR. & |
598 |
|
|
! & YR%LACTIVE .OR. YS%LACTIVE .OR. YA%LACTIVE .OR. YCPF%LACTIVE ) ) THEN |
599 |
|
|
! CALL COPY_GFLC_GFLC(YL_SAVE,YL) |
600 |
|
|
! CALL COPY_GFLC_GFLC(YI_SAVE,YI) |
601 |
|
|
! CALL COPY_GFLC_GFLC(YR_SAVE,YR) |
602 |
|
|
! CALL COPY_GFLC_GFLC(YS_SAVE,YS) |
603 |
|
|
! CALL COPY_GFLC_GFLC(YA_SAVE,YA) |
604 |
|
|
! CALL COPY_GFLC_GFLC(YCPF_SAVE,YCPF) |
605 |
|
|
! |
606 |
|
|
! IF( .NOT. LENCLD2) THEN |
607 |
|
|
! IF (YL%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
608 |
|
|
! IF (YI%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
609 |
|
|
! IF (YR%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
610 |
|
|
! IF (YS%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
611 |
|
|
! IF (YA%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
612 |
|
|
! IF (YCPF%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
613 |
|
|
! |
614 |
|
|
! IF (YL%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
615 |
|
|
! IF (YI%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
616 |
|
|
! IF (YR%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
617 |
|
|
! IF (YS%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
618 |
|
|
! IF (YA%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
619 |
|
|
! IF (YCPF%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
620 |
|
|
! |
621 |
|
|
! CALL FALSIFY_GFLC(YL) |
622 |
|
|
! CALL FALSIFY_GFLC(YI) |
623 |
|
|
! CALL FALSIFY_GFLC(YR) |
624 |
|
|
! CALL FALSIFY_GFLC(YS) |
625 |
|
|
! CALL FALSIFY_GFLC(YA) |
626 |
|
|
! CALL FALSIFY_GFLC(YCPF) |
627 |
|
|
! ELSE |
628 |
|
|
! CALL NOADVECT_GFLC(YL) |
629 |
|
|
! CALL NOADVECT_GFLC(YI) |
630 |
|
|
! CALL NOADVECT_GFLC(YR) |
631 |
|
|
! CALL NOADVECT_GFLC(YS) |
632 |
|
|
! CALL NOADVECT_GFLC(YA) |
633 |
|
|
! CALL NOADVECT_GFLC(YCPF) |
634 |
|
|
! ENDIF |
635 |
|
|
! YGFL%NUMFLDS_SL1 = 0 |
636 |
|
|
! DO JGFL=1,YGFL%NUMFLDS |
637 |
|
|
! YGFLC(JGFL)%MP_SL1 = -HUGE(JPGFL) |
638 |
|
|
! IF(YGFLC(JGFL)%LADV) THEN |
639 |
|
|
! YGFL%NUMFLDS_SL1 = YGFL%NUMFLDS_SL1+1 |
640 |
|
|
! YGFLC(JGFL)%MP_SL1 = YGFL%NUMFLDS_SL1 |
641 |
|
|
! YGFLC(JGFL)%MP_SLX = (YGFLC(JGFL)%MP_SL1-1)*(NFLEVG+2*NFLSUL) |
642 |
|
|
! ENDIF |
643 |
|
|
! ENDDO |
644 |
|
|
! CALL SUSLB |
645 |
|
|
! |
646 |
|
|
! L_CLD_DEACT=.TRUE. |
647 |
|
|
! WRITE(NULOUT,*)' CLOUD FIELDS DE-ACTIVATAD, YGFL%NUMGPFLDS=', & |
648 |
|
|
! & YGFL%NUMGPFLDS,' YGFL%NUMFLDS_SL1=', YGFL%NUMFLDS_SL1 |
649 |
|
|
!ENDIF |
650 |
|
|
! |
651 |
|
|
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEACT_CLOUD_GFL',1,ZHOOK_HANDLE) |
652 |
|
|
! |
653 |
|
|
!END SUBROUTINE DEACT_CLOUD_GFL |
654 |
|
|
! |
655 |
|
|
!!========================================================================= |
656 |
|
|
! |
657 |
|
|
!SUBROUTINE REACT_CLOUD_GFL |
658 |
|
|
!!**** *REACT_CLOUD_GFL* Reactivate prognostic cloud variables |
659 |
|
|
! |
660 |
|
|
!INTEGER(KIND=JPIM) :: JGFL |
661 |
|
|
!REAL(KIND=JPRB) :: ZHOOK_HANDLE |
662 |
|
|
!LOGICAL :: LLGPI,LLGPL,LLGPA |
663 |
|
|
!#include "suslb.intfb.h" |
664 |
|
|
!! ------------------------------------------------------------------ |
665 |
|
|
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:REACT_CLOUD_GFL',0,ZHOOK_HANDLE) |
666 |
|
|
! |
667 |
|
|
!IF (L_CLD_DEACT) THEN |
668 |
|
|
! LLGPL = YL%LGP |
669 |
|
|
! LLGPI = YI%LGP |
670 |
|
|
! LLGPA = YA%LGP |
671 |
|
|
! |
672 |
|
|
! CALL COPY_GFLC_GFLC(YL,YL_SAVE) |
673 |
|
|
! CALL COPY_GFLC_GFLC(YI,YI_SAVE) |
674 |
|
|
! CALL COPY_GFLC_GFLC(YA,YA_SAVE) |
675 |
|
|
! |
676 |
|
|
! IF (.NOT. LLGPL .AND. YL%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS+1 |
677 |
|
|
! IF (.NOT. LLGPI .AND. YI%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS+1 |
678 |
|
|
! IF (.NOT. LLGPA .AND. YA%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS+1 |
679 |
|
|
! |
680 |
|
|
! YGFL%NUMFLDS_SL1 = 0 |
681 |
|
|
! DO JGFL=1,YGFL%NUMFLDS |
682 |
|
|
! YGFLC(JGFL)%MP_SL1 = -HUGE(JPGFL) |
683 |
|
|
! IF(YGFLC(JGFL)%LADV) THEN |
684 |
|
|
! YGFL%NUMFLDS_SL1 = YGFL%NUMFLDS_SL1+1 |
685 |
|
|
! YGFLC(JGFL)%MP_SL1 = YGFL%NUMFLDS_SL1 |
686 |
|
|
! YGFLC(JGFL)%MP_SLX = (YGFLC(JGFL)%MP_SL1-1)*(NFLEVG+2*NFLSUL) |
687 |
|
|
! ENDIF |
688 |
|
|
! ENDDO |
689 |
|
|
! CALL SUSLB |
690 |
|
|
! |
691 |
|
|
! L_CLD_DEACT=.FALSE. |
692 |
|
|
! WRITE(NULOUT,*)' CLOUD FIELDS RE-ACTIVATAD, YGFL%NUMGPFLDS=', & |
693 |
|
|
! & YGFL%NUMGPFLDS,' YGFL%NUMFLDS_SL1=', YGFL%NUMFLDS_SL1 |
694 |
|
|
!ENDIF |
695 |
|
|
! |
696 |
|
|
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:REACT_CLOUD_GFL',1,ZHOOK_HANDLE) |
697 |
|
|
! |
698 |
|
|
!! ------------------------------------------------------------------ |
699 |
|
|
!END SUBROUTINE REACT_CLOUD_GFL |
700 |
|
|
|
701 |
|
|
!========================================================================= |
702 |
|
|
|
703 |
|
|
SUBROUTINE FALSIFY_GFLC(YDGFLC) |
704 |
|
|
|
705 |
|
|
! Purpose. |
706 |
|
|
! -------- |
707 |
|
|
! Set field descriptors to false. |
708 |
|
|
|
709 |
|
|
! Author. |
710 |
|
|
! ------- |
711 |
|
|
! Y. Tremolet |
712 |
|
|
|
713 |
|
|
! Modifications. |
714 |
|
|
! -------------- |
715 |
|
|
! Original : 2004-03-12 |
716 |
|
|
!------------------------------------------------------------------------- |
717 |
|
|
|
718 |
|
|
TYPE(TYPE_GFL_COMP),INTENT(INOUT) :: YDGFLC |
719 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
720 |
|
|
|
721 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:FALSIFY_GFLC',0,ZHOOK_HANDLE) |
722 |
|
|
YDGFLC%CNAME = '' |
723 |
|
|
YDGFLC%IGRBCODE = -HUGE(JPGFL) |
724 |
|
|
YDGFLC%LADV = .FALSE. |
725 |
|
|
YDGFLC%NREQIN = 0 |
726 |
|
|
YDGFLC%REFVALI = 0.0_JPRB |
727 |
|
|
YDGFLC%LREQOUT = .FALSE. |
728 |
|
|
YDGFLC%LGPINGP = .TRUE. |
729 |
|
|
YDGFLC%LTRAJIO = .FALSE. |
730 |
|
|
YDGFLC%LGP = .FALSE. |
731 |
|
|
YDGFLC%LSP = .FALSE. |
732 |
|
|
YDGFLC%LCDERS = .FALSE. |
733 |
|
|
YDGFLC%LACTIVE = .FALSE. |
734 |
|
|
YDGFLC%LTHERMACT = .FALSE. |
735 |
|
|
YDGFLC%LT9 = .FALSE. |
736 |
|
|
YDGFLC%LT1 = .FALSE. |
737 |
|
|
YDGFLC%LT5 = .FALSE. |
738 |
|
|
YDGFLC%LPHY = .FALSE. |
739 |
|
|
YDGFLC%LPT = .FALSE. |
740 |
|
|
YDGFLC%LPC = .FALSE. |
741 |
|
|
YDGFLC%LADJUST0 = .FALSE. |
742 |
|
|
YDGFLC%LADJUST1 = .FALSE. |
743 |
|
|
YDGFLC%NCOUPLING = 0 |
744 |
|
|
YDGFLC%REFVALC = 0.0_JPRB |
745 |
|
|
YDGFLC%LBIPER = .FALSE. |
746 |
|
|
YDGFLC%CSLINT = '' |
747 |
|
|
YDGFLC%R = 0.0_JPRB |
748 |
|
|
YDGFLC%RCP = 0.0_JPRB |
749 |
|
|
!yt YDGFLC%MP = -HUGE(JPGFL) |
750 |
|
|
!yt YDGFLC%MPL = -HUGE(JPGFL) |
751 |
|
|
!yt YDGFLC%MPM = -HUGE(JPGFL) |
752 |
|
|
!yt YDGFLC%MP9 = -HUGE(JPGFL) |
753 |
|
|
!yt YDGFLC%MP1 = -HUGE(JPGFL) |
754 |
|
|
!yt YDGFLC%MP5 = -HUGE(JPGFL) |
755 |
|
|
!yt YDGFLC%MP5L = -HUGE(JPGFL) |
756 |
|
|
!yt YDGFLC%MP5M = -HUGE(JPGFL) |
757 |
|
|
!yt YDGFLC%MPSLP = -HUGE(JPGFL) |
758 |
|
|
!yt YDGFLC%MPSP = -HUGE(JPGFL) |
759 |
|
|
!yt YDGFLC%MP_SPL = -HUGE(JPGFL) |
760 |
|
|
!yt;-) YDGFLC%MPPT = -HUGE(JPGFL) |
761 |
|
|
!yt;-) YDGFLC%MPPC = -HUGE(JPGFL) |
762 |
|
|
!yt NULLIFY(YDGFLC%PREVIOUS) |
763 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:FALSIFY_GFLC',1,ZHOOK_HANDLE) |
764 |
|
|
|
765 |
|
|
END SUBROUTINE FALSIFY_GFLC |
766 |
|
|
!========================================================================= |
767 |
|
|
|
768 |
|
|
SUBROUTINE NOADVECT_GFLC(YDGFLC) |
769 |
|
|
|
770 |
|
|
! Purpose. |
771 |
|
|
! -------- |
772 |
|
|
! Switch off advection ect. |
773 |
|
|
|
774 |
|
|
! Author. |
775 |
|
|
! ------- |
776 |
|
|
! Y. Tremolet |
777 |
|
|
|
778 |
|
|
! Modifications. |
779 |
|
|
! -------------- |
780 |
|
|
! Original : 2004-03-12 |
781 |
|
|
!------------------------------------------------------------------------- |
782 |
|
|
|
783 |
|
|
TYPE(TYPE_GFL_COMP),INTENT(INOUT) :: YDGFLC |
784 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
785 |
|
|
|
786 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:NOADVECT_GFLC',0,ZHOOK_HANDLE) |
787 |
|
|
YDGFLC%LADV = .FALSE. |
788 |
|
|
YDGFLC%LCDERS = .FALSE. |
789 |
|
|
YDGFLC%LT1 = .FALSE. |
790 |
|
|
YDGFLC%LT5 = .FALSE. |
791 |
|
|
YDGFLC%LPHY = .FALSE. |
792 |
|
|
YDGFLC%LPT = .FALSE. |
793 |
|
|
YDGFLC%LADJUST0 = .FALSE. |
794 |
|
|
YDGFLC%LADJUST1 = .FALSE. |
795 |
|
|
YDGFLC%LBIPER = .FALSE. |
796 |
|
|
YDGFLC%CSLINT = '' |
797 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:NOADVECT_GFLC',1,ZHOOK_HANDLE) |
798 |
|
|
|
799 |
|
|
END SUBROUTINE NOADVECT_GFLC |
800 |
|
|
|
801 |
|
|
!========================================================================= |
802 |
|
|
|
803 |
|
|
SUBROUTINE COPY_GFLC_GFLC(YDGFLC1,YDGFLC2) |
804 |
|
|
|
805 |
|
|
! Purpose. |
806 |
|
|
! -------- |
807 |
|
|
! Copy field descriptors. |
808 |
|
|
|
809 |
|
|
! Author. |
810 |
|
|
! ------- |
811 |
|
|
! Y. Tremolet |
812 |
|
|
|
813 |
|
|
! Modifications. |
814 |
|
|
! -------------- |
815 |
|
|
! Original : 2004-03-12 |
816 |
|
|
!------------------------------------------------------------------------- |
817 |
|
|
|
818 |
|
|
TYPE (TYPE_GFL_COMP), INTENT(INOUT) :: YDGFLC1 |
819 |
|
|
TYPE (TYPE_GFL_COMP), INTENT(IN) :: YDGFLC2 |
820 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
821 |
|
|
|
822 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:COPY_GFLC_GFLC',0,ZHOOK_HANDLE) |
823 |
|
|
YDGFLC1%CNAME = YDGFLC2%CNAME |
824 |
|
|
YDGFLC1%IGRBCODE = YDGFLC2%IGRBCODE |
825 |
|
|
YDGFLC1%LADV = YDGFLC2%LADV |
826 |
|
|
YDGFLC1%NREQIN = YDGFLC2%NREQIN |
827 |
|
|
YDGFLC1%REFVALI = YDGFLC2%REFVALI |
828 |
|
|
YDGFLC1%LREQOUT = YDGFLC2%LREQOUT |
829 |
|
|
YDGFLC1%LGPINGP = YDGFLC2%LGPINGP |
830 |
|
|
YDGFLC1%LTRAJIO = YDGFLC2%LTRAJIO |
831 |
|
|
YDGFLC1%LGP = YDGFLC2%LGP |
832 |
|
|
YDGFLC1%LSP = YDGFLC2%LSP |
833 |
|
|
YDGFLC1%LPT = YDGFLC2%LPT |
834 |
|
|
YDGFLC1%LPC = YDGFLC2%LPC |
835 |
|
|
YDGFLC1%LCDERS = YDGFLC2%LCDERS |
836 |
|
|
YDGFLC1%LACTIVE = YDGFLC2%LACTIVE |
837 |
|
|
YDGFLC1%LTHERMACT = YDGFLC2%LTHERMACT |
838 |
|
|
YDGFLC1%LT9 = YDGFLC2%LT9 |
839 |
|
|
YDGFLC1%LT1 = YDGFLC2%LT1 |
840 |
|
|
YDGFLC1%LT5 = YDGFLC2%LT5 |
841 |
|
|
YDGFLC1%LPHY = YDGFLC2%LPHY |
842 |
|
|
YDGFLC1%LADJUST0 = YDGFLC2%LADJUST0 |
843 |
|
|
YDGFLC1%LADJUST1 = YDGFLC2%LADJUST1 |
844 |
|
|
YDGFLC1%NCOUPLING = YDGFLC2%NCOUPLING |
845 |
|
|
YDGFLC1%REFVALC = YDGFLC2%REFVALC |
846 |
|
|
YDGFLC1%LBIPER = YDGFLC2%LBIPER |
847 |
|
|
YDGFLC1%CSLINT = YDGFLC2%CSLINT |
848 |
|
|
YDGFLC1%R = YDGFLC2%R |
849 |
|
|
YDGFLC1%RCP = YDGFLC2%RCP |
850 |
|
|
YDGFLC1%MP = YDGFLC2%MP |
851 |
|
|
YDGFLC1%MPL = YDGFLC2%MPL |
852 |
|
|
YDGFLC1%MPM = YDGFLC2%MPM |
853 |
|
|
YDGFLC1%MP9 = YDGFLC2%MP9 |
854 |
|
|
YDGFLC1%MP1 = YDGFLC2%MP1 |
855 |
|
|
YDGFLC1%MP5 = YDGFLC2%MP5 |
856 |
|
|
YDGFLC1%MP5L = YDGFLC2%MP5L |
857 |
|
|
YDGFLC1%MP5M = YDGFLC2%MP5M |
858 |
|
|
YDGFLC1%MPSLP = YDGFLC2%MPSLP |
859 |
|
|
YDGFLC1%MP_SPL = YDGFLC2%MP_SPL |
860 |
|
|
YDGFLC1%MP_SL1 = YDGFLC2%MP_SL1 |
861 |
|
|
YDGFLC1%MPSP = YDGFLC2%MPSP |
862 |
|
|
YDGFLC1%MPPT = YDGFLC2%MPPT |
863 |
|
|
YDGFLC1%MPPC = YDGFLC2%MPPC |
864 |
|
|
!yt YDGFLC1%PREVIOUS => YDGFLC2%PREVIOUS |
865 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:COPY_GFLC_GFLC',1,ZHOOK_HANDLE) |
866 |
|
|
|
867 |
|
|
END SUBROUTINE COPY_GFLC_GFLC |
868 |
|
|
|
869 |
|
|
!========================================================================= |
870 |
|
|
|
871 |
|
|
END MODULE GFL_SUBS |