LMDZ
gfl_subs.F90
Go to the documentation of this file.
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
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
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)
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
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
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)
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)
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)
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
type(type_gfl_comp), pointer ycpf
Definition: yom_ygfl.F90:56
logical lencld2
Definition: yophnc.F90:39
type(type_gfl_comp), pointer yr
Definition: yom_ygfl.F90:48
subroutine, public define_gfl_comp(YDGFLC, CDNAME, KGRIB, LDGP, KREQIN, PREFVALI, LDREQOUT, LDERS, LD5, LDT1, LDGPINGP, LDTRAJIO, LDTHERMACT, PR, PRCP)
Definition: gfl_subs.F90:66
subroutine falsify_gflc(YDGFLC)
Definition: gfl_subs.F90:704
Definition: yophnc.F90:1
type(type_gfl_comp) ycpf_save
Definition: gfl_subs.F90:53
logical l_cld_deact
Definition: gfl_subs.F90:54
type(type_gfl_comp) ya_save
Definition: gfl_subs.F90:50
type(type_gfl_comp), pointer yl
Definition: yom_ygfl.F90:46
subroutine abor1(CDTEXT)
Definition: abor1.F90:2
integer(kind=jpim) msavtend_s
Definition: yomslphy.F90:26
type(type_gfl_comp), pointer ys
Definition: yom_ygfl.F90:47
type(type_gfld) ygfl
Definition: yom_ygfl.F90:41
integer(kind=jpim) nflevg
Definition: yomdim.F90:112
subroutine, public set_gfl_attr(YDGFLC, LDADV, LDT9, LDPHY, LDPT, LDPC, LDADJUST0, LDADJUST1, KCOUPLING, PREFVALC, LDBIPER, CDSLINT)
Definition: gfl_subs.F90:339
subroutine, public print_gfl
Definition: gfl_subs.F90:500
subroutine copy_gflc_gflc(YDGFLC1, YDGFLC2)
Definition: gfl_subs.F90:804
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
integer, parameter jprb
Definition: parkind1.F90:31
type(type_gfl_comp) yi_save
Definition: gfl_subs.F90:49
type(type_gfl_comp) ys_save
Definition: gfl_subs.F90:52
subroutine noadvect_gflc(YDGFLC)
Definition: gfl_subs.F90:769
type(type_gfl_comp), pointer yptrc
Definition: gfl_subs.F90:47
Definition: yomdim.F90:1
integer(kind=jpim), parameter jpgfl
Definition: yom_ygfl.F90:24
type(type_gfl_comp), pointer ya
Definition: yom_ygfl.F90:51
type(type_gfl_comp), pointer yi
Definition: yom_ygfl.F90:45
Definition: yomlun.F90:1
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
logical lhook
Definition: yomhook.F90:12
type(type_gfl_comp), pointer ylastgflc
Definition: gfl_subs.F90:46
subroutine dr_hook(CDNAME, KSWITCH, PKEY)
Definition: yomhook.F90:17
integer, parameter jpim
Definition: parkind1.F90:13
type(type_gfl_comp), dimension(jpgfl), target ygflc
Definition: yom_ygfl.F90:42
type(type_gfl_comp) yr_save
Definition: gfl_subs.F90:51
integer(kind=jpim) nflsul
Definition: yomdim.F90:114
type(type_gfl_comp) yl_save
Definition: gfl_subs.F90:48