Context Navigation

gfl_subs.F90 @ 4744

Last change on this file since 4744 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

Rev	Line
[1989]	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
[2010]	56	!$OMP THREADPRIVATE(l_cld_deact,ya_save,ycpf_save,yi_save,yl_save,ylastgflc,yptrc,yr_save,ys_save)
	57
[1989]	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
[2010]	119	!$OMP THREADPRIVATE(llfirstcall)
[1989]	120
[2010]	121
[1989]	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+2NFLSUL)
	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+2NFLSUL)
	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+2NFLSUL)
	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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format