source: LMDZ6/trunk/libf/phylmd/rrtm/gfl_subs.F90 @ 3592

Last change on this file since 3592 was 2010, checked in by Laurent Fairhead, 11 years ago

Modifications pour OpenMP

OpenMP modifications
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 27.1 KB
Line 
1MODULE 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!-------------------------------------------------------------------------
27USE PARKIND1  ,ONLY : JPIM     ,JPRB
28USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
29
30USE YOMLUN   , ONLY : NULOUT
31USE TYPE_GFLS ,ONLY : TYPE_GFL_COMP
32USE YOM_YGFL , ONLY : YGFL,JPGFL,YGFLC,YL,YI,YA,YR,YS,YCPF
33USE YOPHNC   , ONLY : LENCLD2
34USE YOMSLPHY  ,ONLY : MSAVTEND_S
35USE YOMDIM   , ONLY : NFLEVG   ,NFLSUL
36
37IMPLICIT NONE
38SAVE
39
40PRIVATE
41!PUBLIC DEFINE_GFL_COMP,PRINT_GFL,SET_GFL_ATTR,DEACT_CLOUD_GFL,REACT_CLOUD_GFL
42! MPL 10.12.08
43PUBLIC DEFINE_GFL_COMP,PRINT_GFL,SET_GFL_ATTR
44
45! For internal use
46TYPE(TYPE_GFL_COMP),POINTER :: YLASTGFLC ! Pointer to last defined field
47TYPE(TYPE_GFL_COMP),POINTER :: YPTRC     ! Temporary field pointer
48TYPE(TYPE_GFL_COMP)  :: YL_SAVE ! For saving status of cloud fields
49TYPE(TYPE_GFL_COMP)  :: YI_SAVE ! For saving status of cloud fields
50TYPE(TYPE_GFL_COMP)  :: YA_SAVE ! For saving status of cloud fields
51TYPE(TYPE_GFL_COMP)  :: YR_SAVE ! For saving status of cloud fields
52TYPE(TYPE_GFL_COMP)  :: YS_SAVE ! For saving status of cloud fields
53TYPE(TYPE_GFL_COMP)  :: YCPF_SAVE ! For saving status of cloud fields
54LOGICAL :: 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!-------------------------------------------------------------------------
61CONTAINS
62!-------------------------------------------------------------------------
63
64SUBROUTINE 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
100TYPE(TYPE_GFL_COMP),TARGET,INTENT(INOUT) :: YDGFLC
101CHARACTER(LEN=16),INTENT(IN) :: CDNAME
102INTEGER(KIND=JPIM),INTENT(IN) :: KGRIB
103INTEGER(KIND=JPIM),INTENT(IN) :: KREQIN
104REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PREFVALI
105LOGICAL,INTENT(IN)::   LDREQOUT
106LOGICAL,INTENT(IN) ::   LDGP
107LOGICAL,INTENT(IN) ::   LDERS
108LOGICAL,INTENT(IN) ::   LD5
109LOGICAL,INTENT(IN) ::   LDT1
110LOGICAL,INTENT(IN),OPTIONAL ::   LDGPINGP
111LOGICAL,INTENT(IN),OPTIONAL ::   LDTRAJIO
112LOGICAL,INTENT(IN),OPTIONAL ::   LDTHERMACT
113REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PR
114REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PRCP
115 
116INTEGER(KIND=JPIM) :: JGFL, ICURFLDPT, ICURFLDPC
117LOGICAL,SAVE :: LLFIRSTCALL = .TRUE.
118REAL(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
127IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEFINE_GFL_COMP',0,ZHOOK_HANDLE)
128IF(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.
172ENDIF
173
174!-------------------------------------------------------------------------
175
176!      2. Define GFL component
177!         --------------------
178
179!      2.1 Some checks
180IF(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
187ENDIF
188IF(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
193ENDIF
194IF(YGFL%NUMFLDS == JPGFL) THEN
195  WRITE(NULOUT,*) ' MAXIMUM NUMBER OF FIELDS ALREADY DEFINED'
196  CALL ABOR1('YOMMFL: EXCEED NUMBER OF FIELDS')
197ENDIF
198
199!      2.2 Define field attributes
200
201ICURFLDPT = YGFL%NUMFLDS+1
202ICURFLDPC = YGFL%NUMFLDS+1
203
204YDGFLC%LACTIVE = .TRUE.
205YDGFLC%CNAME = CDNAME
206YDGFLC%IGRBCODE = KGRIB
207YDGFLC%NREQIN = KREQIN
208IF (PRESENT(PREFVALI)) THEN
209  YDGFLC%REFVALI = PREFVALI
210ENDIF
211YDGFLC%LREQOUT = LDREQOUT
212YDGFLC%LGP = LDGP
213YDGFLC%LSP= .NOT. YDGFLC%LGP
214YDGFLC%LT5 = LD5
215YDGFLC%LT1 = LDT1
216YDGFLC%LCDERS  = LDERS
217IF(PRESENT(LDGPINGP)) YDGFLC%LGPINGP=LDGPINGP
218IF(PRESENT(LDTRAJIO)) YDGFLC%LTRAJIO=LDTRAJIO
219IF(PRESENT(LDTHERMACT)) YDGFLC%LTHERMACT=LDTHERMACT
220IF(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
227ENDIF
228
229!    2.3  Numbers of fields and dimensions
230YGFL%NUMFLDS = YGFL%NUMFLDS+1
231IF (YDGFLC%LT5) YGFL%NUMFLDS5 = YGFL%NUMFLDS5+1
232
233IF(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
238ELSE
239  YGFL%NDIM = YGFL%NDIM+1
240  YGFL%NDIM0 = YGFL%NDIM0+1
241  IF (YDGFLC%LT5) YGFL%NDIM5 = YGFL%NDIM5+1
242ENDIF
243
244IF(YDGFLC%LSP) THEN
245  YGFL%NUMSPFLDS =YGFL%NUMSPFLDS+1
246ELSE
247  YGFL%NUMGPFLDS =YGFL%NUMGPFLDS+1
248ENDIF
249
250IF (YDGFLC%LT1)  THEN
251  YGFL%NUMFLDS1 = YGFL%NUMFLDS1+1
252  YGFL%NDIM1 = YGFL%NDIM1+1
253  IF (YDGFLC%LSP) YGFL%NUMSPFLDS1 =YGFL%NUMSPFLDS1+1
254ENDIF 
255
256!    2.4  Define field "pointers"
257YDGFLC%MP5 = -HUGE(JPGFL)
258IF (YDGFLC%LGP) THEN
259  YDGFLC%MP = YGFL%NDIM0
260  IF (YDGFLC%LT5) YDGFLC%MP5 = YGFL%NDIM5
261ELSE
262  YDGFLC%MP = YGFL%NUMFLDS
263  IF (YDGFLC%LT5) YDGFLC%MP5 = YGFL%NUMFLDS5
264ENDIF
265IF (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
272ELSE
273  YDGFLC%MPL = -HUGE(JPGFL)
274  YDGFLC%MPM = -HUGE(JPGFL)
275  YDGFLC%MP5L = -HUGE(JPGFL)
276  YDGFLC%MP5M = -HUGE(JPGFL)
277ENDIF
278
279IF(YDGFLC%LSP) THEN
280  YDGFLC%MPSP = YGFL%NUMSPFLDS
281ELSE
282  YDGFLC%MPSP = -HUGE(JPGFL)
283ENDIF
284
285IF (YDGFLC%LT1)  THEN
286  YDGFLC%MP1 = YGFL%NUMFLDS1
287ELSE
288  YDGFLC%MP1 = -HUGE(JPGFL)
289ENDIF 
290 
291!      2.6  Possibly reassign pointers (needed for multiple fields with derivatives)
292
293IF(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
325ENDIF
326
327!    2.7  Point to last defined field
328YDGFLC%PREVIOUS=>YLASTGFLC
329YLASTGFLC => YDGFLC
330IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEFINE_GFL_COMP',1,ZHOOK_HANDLE)
331
332!     ------------------------------------------------------------------
333END SUBROUTINE DEFINE_GFL_COMP
334
335!=========================================================================
336
337SUBROUTINE 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
372TYPE(TYPE_GFL_COMP),TARGET,INTENT(INOUT) :: YDGFLC
373LOGICAL,INTENT(IN),OPTIONAL :: LDADV
374LOGICAL,INTENT(IN),OPTIONAL :: LDT9
375LOGICAL,INTENT(IN),OPTIONAL :: LDPHY
376LOGICAL,INTENT(IN),OPTIONAL :: LDPT
377LOGICAL,INTENT(IN),OPTIONAL :: LDPC
378LOGICAL,INTENT(IN),OPTIONAL :: LDADJUST0
379LOGICAL,INTENT(IN),OPTIONAL :: LDADJUST1
380INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOUPLING
381REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PREFVALC
382LOGICAL,INTENT(IN),OPTIONAL :: LDBIPER
383CHARACTER(LEN=12),INTENT(IN),OPTIONAL  :: CDSLINT
384
385INTEGER(KIND=JPIM) :: IGFLPTR
386REAL(KIND=JPRB) :: ZHOOK_HANDLE
387
388!-------------------------------------------------------------------------
389
390IF (LHOOK) CALL DR_HOOK('GFL_SUBS:SET_GFL_ATTR',0,ZHOOK_HANDLE)
391IF(YDGFLC%MP < 1 .OR. YDGFLC%MP > YGFL%NUMFLDS) THEN
392  CALL ABOR1('SET_GFL_ATTR: GFL COMPONENT NOT SET UP')
393ELSE
394  IGFLPTR=YDGFLC%MP
395ENDIF
396
397IF(PRESENT(LDADV)) THEN
398  YDGFLC%LADV = LDADV
399ENDIF
400IF(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)
407ENDIF
408 
409
410! Other timelevels etc.
411
412IF(PRESENT(LDT9)) THEN
413  YDGFLC%LT9 = LDT9
414ENDIF
415IF(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
421ELSE
422  YDGFLC%MP9 = YDGFLC%MP
423  YDGFLC%MP9_PH = YDGFLC%MP9
424  WRITE(NULOUT,*) 'WARNING YDGFLC%MP9 = YDGFLC%MP',YDGFLC%MP9,YDGFLC%MP
425ENDIF
426
427IF(PRESENT(LDPHY)) THEN
428  YDGFLC%LPHY = LDPHY
429ENDIF
430IF(YGFL%NUMFLDSPHY == 0)YGFL%NUMFLDSPHY=YGFL%NUMFLDSPHY-MSAVTEND_S
431IF(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
440ENDIF
441
442IF(PRESENT(LDPT)) THEN
443  YDGFLC%LPT = LDPT
444ENDIF
445IF(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
451ENDIF
452IF(PRESENT(LDPC)) THEN
453  YDGFLC%LPC = LDPC
454ENDIF
455IF(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
461ENDIF
462
463
464! LAM attributes (do not involve extra dimensioning or pointers)
465
466IF(PRESENT(LDADJUST0)) THEN
467  YDGFLC%LADJUST0 = LDADJUST0
468ENDIF
469IF(PRESENT(LDADJUST1)) THEN
470  YDGFLC%LADJUST1 = LDADJUST1
471ENDIF
472IF(PRESENT(KCOUPLING)) THEN
473  YDGFLC%NCOUPLING = KCOUPLING
474ENDIF
475IF(PRESENT(PREFVALC)) THEN
476  YDGFLC%REFVALC = PREFVALC
477ENDIF
478IF(PRESENT(LDBIPER)) THEN
479  YDGFLC%LBIPER = LDBIPER
480ENDIF
481
482IF(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
491ENDIF
492IF (LHOOK) CALL DR_HOOK('GFL_SUBS:SET_GFL_ATTR',1,ZHOOK_HANDLE)
493
494!     -------------------------------------------------------------------
495END SUBROUTINE SET_GFL_ATTR
496
497!=========================================================================
498
499SUBROUTINE PRINT_GFL
500
501!**** *PRINT_GFL*  - Print GFL attributes
502
503!     -------------------------------------------------------------------
504
505REAL(KIND=JPRB) :: ZHOOK_HANDLE
506IF (LHOOK) CALL DR_HOOK('GFL_SUBS:PRINT_GFL',0,ZHOOK_HANDLE)
507WRITE(NULOUT,*) ' ---- GFL COMPONENT ATTRIBUTES ----'
508IF(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
532ENDIF
533
534WRITE(NULOUT,*) ' ---- YGFL ATTRIBUTES ----'
535WRITE(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
539WRITE(NULOUT,*) ' YGFL%NUMFLDS_SL1=',YGFL%NUMFLDS_SL1
540WRITE(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)
577WRITE(NULOUT,*) ' --------------------------------------------'
578IF (LHOOK) CALL DR_HOOK('GFL_SUBS:PRINT_GFL',1,ZHOOK_HANDLE)
579END 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
703SUBROUTINE 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
718TYPE(TYPE_GFL_COMP),INTENT(INOUT) :: YDGFLC
719REAL(KIND=JPRB) :: ZHOOK_HANDLE
720
721IF (LHOOK) CALL DR_HOOK('GFL_SUBS:FALSIFY_GFLC',0,ZHOOK_HANDLE)
722YDGFLC%CNAME     = ''
723YDGFLC%IGRBCODE  = -HUGE(JPGFL)
724YDGFLC%LADV      = .FALSE.
725YDGFLC%NREQIN    = 0
726YDGFLC%REFVALI   = 0.0_JPRB
727YDGFLC%LREQOUT   = .FALSE.
728YDGFLC%LGPINGP   = .TRUE.
729YDGFLC%LTRAJIO   = .FALSE.
730YDGFLC%LGP       = .FALSE.
731YDGFLC%LSP       = .FALSE.
732YDGFLC%LCDERS    = .FALSE.
733YDGFLC%LACTIVE   = .FALSE.
734YDGFLC%LTHERMACT = .FALSE.
735YDGFLC%LT9       = .FALSE.
736YDGFLC%LT1       = .FALSE.
737YDGFLC%LT5       = .FALSE.
738YDGFLC%LPHY      = .FALSE.
739YDGFLC%LPT       = .FALSE.
740YDGFLC%LPC       = .FALSE.
741YDGFLC%LADJUST0  = .FALSE.
742YDGFLC%LADJUST1  = .FALSE.
743YDGFLC%NCOUPLING = 0
744YDGFLC%REFVALC   = 0.0_JPRB
745YDGFLC%LBIPER    = .FALSE.
746YDGFLC%CSLINT    = ''
747YDGFLC%R         = 0.0_JPRB
748YDGFLC%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)
763IF (LHOOK) CALL DR_HOOK('GFL_SUBS:FALSIFY_GFLC',1,ZHOOK_HANDLE)
764
765END SUBROUTINE FALSIFY_GFLC
766!=========================================================================
767
768SUBROUTINE 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
783TYPE(TYPE_GFL_COMP),INTENT(INOUT) :: YDGFLC
784REAL(KIND=JPRB) :: ZHOOK_HANDLE
785
786IF (LHOOK) CALL DR_HOOK('GFL_SUBS:NOADVECT_GFLC',0,ZHOOK_HANDLE)
787YDGFLC%LADV      = .FALSE.
788YDGFLC%LCDERS    = .FALSE.
789YDGFLC%LT1       = .FALSE.
790YDGFLC%LT5       = .FALSE.
791YDGFLC%LPHY      = .FALSE.
792YDGFLC%LPT       = .FALSE.
793YDGFLC%LADJUST0  = .FALSE.
794YDGFLC%LADJUST1  = .FALSE.
795YDGFLC%LBIPER    = .FALSE.
796YDGFLC%CSLINT    = ''
797IF (LHOOK) CALL DR_HOOK('GFL_SUBS:NOADVECT_GFLC',1,ZHOOK_HANDLE)
798
799END SUBROUTINE NOADVECT_GFLC
800
801!=========================================================================
802
803SUBROUTINE 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
818TYPE (TYPE_GFL_COMP), INTENT(INOUT) :: YDGFLC1
819TYPE (TYPE_GFL_COMP), INTENT(IN)    :: YDGFLC2
820REAL(KIND=JPRB) :: ZHOOK_HANDLE
821
822IF (LHOOK) CALL DR_HOOK('GFL_SUBS:COPY_GFLC_GFLC',0,ZHOOK_HANDLE)
823YDGFLC1%CNAME     = YDGFLC2%CNAME
824YDGFLC1%IGRBCODE  = YDGFLC2%IGRBCODE
825YDGFLC1%LADV      = YDGFLC2%LADV
826YDGFLC1%NREQIN    = YDGFLC2%NREQIN
827YDGFLC1%REFVALI   = YDGFLC2%REFVALI
828YDGFLC1%LREQOUT   = YDGFLC2%LREQOUT
829YDGFLC1%LGPINGP   = YDGFLC2%LGPINGP
830YDGFLC1%LTRAJIO   = YDGFLC2%LTRAJIO
831YDGFLC1%LGP       = YDGFLC2%LGP
832YDGFLC1%LSP       = YDGFLC2%LSP
833YDGFLC1%LPT       = YDGFLC2%LPT
834YDGFLC1%LPC       = YDGFLC2%LPC
835YDGFLC1%LCDERS    = YDGFLC2%LCDERS
836YDGFLC1%LACTIVE   = YDGFLC2%LACTIVE
837YDGFLC1%LTHERMACT = YDGFLC2%LTHERMACT
838YDGFLC1%LT9       = YDGFLC2%LT9
839YDGFLC1%LT1       = YDGFLC2%LT1
840YDGFLC1%LT5       = YDGFLC2%LT5
841YDGFLC1%LPHY      = YDGFLC2%LPHY
842YDGFLC1%LADJUST0  = YDGFLC2%LADJUST0
843YDGFLC1%LADJUST1  = YDGFLC2%LADJUST1
844YDGFLC1%NCOUPLING = YDGFLC2%NCOUPLING
845YDGFLC1%REFVALC   = YDGFLC2%REFVALC
846YDGFLC1%LBIPER    = YDGFLC2%LBIPER
847YDGFLC1%CSLINT    = YDGFLC2%CSLINT
848YDGFLC1%R         = YDGFLC2%R
849YDGFLC1%RCP       = YDGFLC2%RCP
850YDGFLC1%MP        = YDGFLC2%MP
851YDGFLC1%MPL       = YDGFLC2%MPL
852YDGFLC1%MPM       = YDGFLC2%MPM
853YDGFLC1%MP9       = YDGFLC2%MP9
854YDGFLC1%MP1       = YDGFLC2%MP1
855YDGFLC1%MP5       = YDGFLC2%MP5
856YDGFLC1%MP5L      = YDGFLC2%MP5L
857YDGFLC1%MP5M      = YDGFLC2%MP5M
858YDGFLC1%MPSLP     = YDGFLC2%MPSLP
859YDGFLC1%MP_SPL    = YDGFLC2%MP_SPL
860YDGFLC1%MP_SL1    = YDGFLC2%MP_SL1
861YDGFLC1%MPSP      = YDGFLC2%MPSP
862YDGFLC1%MPPT      = YDGFLC2%MPPT
863YDGFLC1%MPPC      = YDGFLC2%MPPC
864!yt YDGFLC1%PREVIOUS => YDGFLC2%PREVIOUS
865IF (LHOOK) CALL DR_HOOK('GFL_SUBS:COPY_GFLC_GFLC',1,ZHOOK_HANDLE)
866
867END SUBROUTINE COPY_GFLC_GFLC
868
869!=========================================================================
870
871END MODULE GFL_SUBS
Note: See TracBrowser for help on using the repository browser.