MODULE GFL_SUBS

!     Purpose.
!     --------

!      GFL_SUBS contains routines to do basic manipulatutions of GFL descriptors 

!     Author.
!     -------
!     Mats Hamrud(ECMWF)

!     Modifications.
!     --------------
!        Original : 2003-03-01
!        Modifications:
!        03/07/09 C. Fischer - add Arome/Aladin attributes
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M. Tudor      31-Oct-2003 physics tendencies
!        Y.Tremolet    03-Mar-2004 Protect *EACT_CLOUD_GFL for multiple calls
!        Y.Tremolet    12-Mar-2004 Save/falsify GFLC
!        J.Haseler     10-Oct-2005 Switch for I/O to trajectory  structure
!        Y. Bouteloup  28-Jan-2005 Add YR (rain !) in DEACT_CLOUD_GFL
!        20-Feb-2005 J. Vivoda  3TL PC Eulerian scheme, GWADV scheme for PC_FULL 
!        Y. Bouteloup  25-Dec-2005 Add YS (snow !) in DEACT_CLOUD_GFL
!        A. Trojakova  29-June-2006 Add YCPF in DEACT_CLOUD_GFL
!-------------------------------------------------------------------------
USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMLUN   , ONLY : NULOUT
USE TYPE_GFLS ,ONLY : TYPE_GFL_COMP 
USE YOM_YGFL , ONLY : YGFL,JPGFL,YGFLC,YL,YI,YA,YR,YS,YCPF
USE YOPHNC   , ONLY : LENCLD2
USE YOMSLPHY  ,ONLY : MSAVTEND_S
USE YOMDIM   , ONLY : NFLEVG   ,NFLSUL

IMPLICIT NONE
SAVE

PRIVATE
!PUBLIC DEFINE_GFL_COMP,PRINT_GFL,SET_GFL_ATTR,DEACT_CLOUD_GFL,REACT_CLOUD_GFL
! MPL 10.12.08
PUBLIC DEFINE_GFL_COMP,PRINT_GFL,SET_GFL_ATTR

! For internal use
TYPE(TYPE_GFL_COMP),POINTER :: YLASTGFLC ! Pointer to last defined field
TYPE(TYPE_GFL_COMP),POINTER :: YPTRC     ! Temporary field pointer
TYPE(TYPE_GFL_COMP)  :: YL_SAVE ! For saving status of cloud fields
TYPE(TYPE_GFL_COMP)  :: YI_SAVE ! For saving status of cloud fields
TYPE(TYPE_GFL_COMP)  :: YA_SAVE ! For saving status of cloud fields
TYPE(TYPE_GFL_COMP)  :: YR_SAVE ! For saving status of cloud fields
TYPE(TYPE_GFL_COMP)  :: YS_SAVE ! For saving status of cloud fields
TYPE(TYPE_GFL_COMP)  :: YCPF_SAVE ! For saving status of cloud fields
LOGICAL :: L_CLD_DEACT=.FALSE.

#include "abor1.intfb.h"

!-------------------------------------------------------------------------
CONTAINS
!-------------------------------------------------------------------------

SUBROUTINE DEFINE_GFL_COMP(YDGFLC,CDNAME,KGRIB,LDGP,KREQIN,PREFVALI, &
 & LDREQOUT,LDERS,LD5,LDT1,LDGPINGP,LDTRAJIO,LDTHERMACT,PR,PRCP)

!**** *DEFINE_GFL_COMP*  - Setup indivual GFL field
 
!     Purpose.
!     --------
!     Basic allocation of GFL descriptor structure (on first call)
!     Setup basic attributes of individual GFL component

!        Explicit arguments :
!        --------------------

!        YDGFLC  - field handle
!        CDNAME  - field ARPEGE name
!        KGRIB   - GRIB code
!        LDGP    - if TRUE gridpoint field
!        KREQIN  - 1 if required in input, 0 if not, -1 if initialised with refernence value
!        PREFVALI - reference value for initialisation in case NREQIN==-1
!        LDREQOUT- TRUE if requiered in output
!        LDERS   - TRUE if derivatives required (only possible for spectral field)
!        LD5     - TRUE if field needs to be present in trajectory (T5)
!        LD1     - TRUE if field needs to be present in t+dt array (GFLT1) 
!        LDTRAJIO- TRUE if field written to/from trajectory structure files

!     Author.
!     -------
!      Mats Hamrud  *ECMWF*

!     Modifications.
!     --------------
!      Original : 2003-03-01
!      Modifications:
!      03/07/09 C. Fischer - add Arome/Aladin attributes
!-------------------------------------------------------------------------

TYPE(TYPE_GFL_COMP),TARGET,INTENT(INOUT) :: YDGFLC
CHARACTER(LEN=16),INTENT(IN) :: CDNAME
INTEGER(KIND=JPIM),INTENT(IN) :: KGRIB
INTEGER(KIND=JPIM),INTENT(IN) :: KREQIN
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PREFVALI
LOGICAL,INTENT(IN)::   LDREQOUT
LOGICAL,INTENT(IN) ::   LDGP
LOGICAL,INTENT(IN) ::   LDERS 
LOGICAL,INTENT(IN) ::   LD5 
LOGICAL,INTENT(IN) ::   LDT1
LOGICAL,INTENT(IN),OPTIONAL ::   LDGPINGP
LOGICAL,INTENT(IN),OPTIONAL ::   LDTRAJIO
LOGICAL,INTENT(IN),OPTIONAL ::   LDTHERMACT
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PR
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PRCP
 
INTEGER(KIND=JPIM) :: JGFL, ICURFLDPT, ICURFLDPC
LOGICAL,SAVE :: LLFIRSTCALL = .TRUE.
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!-------------------------------------------------------------------------

!       1. Initialization of YGFL on first call to this routine
!          ----------------------------------------------------

IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEFINE_GFL_COMP',0,ZHOOK_HANDLE)
IF(LLFIRSTCALL) THEN
  YGFL%NUMFLDS     = 0
  YGFL%NUMFLDS9    = 0
  YGFL%NUMFLDS1    = 0
  YGFL%NUMFLDS5    = 0
  YGFL%NUMFLDSPHY  = 0
  YGFL%NUMFLDS_SPL = 0
  YGFL%NUMFLDS_SL1 = 0
  YGFL%NUMFLDSPT   = 0
  YGFL%NUMFLDSPC   = 0
  YGFL%NDIM        = 0
  YGFL%NDIM0       = 0
  YGFL%NDIM9       = 0
  YGFL%NDIM1       = 0
  YGFL%NDIM5       = 0
  YGFL%NDIMSLP     = 0
  YGFL%NDIM_SPL    = 0
  YGFL%NDIMPT      = 0
  YGFL%NDIMPC      = 0
  YGFL%NDERS       = 0
  YGFL%NUMSPFLDS   = 0
  YGFL%NUMGPFLDS   = 0
  YGFL%NUMSPFLDS1  = 0
  DO JGFL=1,JPGFL
    CALL FALSIFY_GFLC(YGFLC(JGFL))
    YGFLC(JGFL)%MP        = -HUGE(JPGFL)
    YGFLC(JGFL)%MPL       = -HUGE(JPGFL)
    YGFLC(JGFL)%MPM       = -HUGE(JPGFL)
    YGFLC(JGFL)%MP9       = -HUGE(JPGFL)
    YGFLC(JGFL)%MP9_PH    = -HUGE(JPGFL)
    YGFLC(JGFL)%MP1       = -HUGE(JPGFL)
    YGFLC(JGFL)%MP5       = -HUGE(JPGFL)
    YGFLC(JGFL)%MP5L      = -HUGE(JPGFL)
    YGFLC(JGFL)%MP5M      = -HUGE(JPGFL)
    YGFLC(JGFL)%MPSLP     = -HUGE(JPGFL)
    YGFLC(JGFL)%MPSP      = -HUGE(JPGFL)
    YGFLC(JGFL)%MP_SPL    = -HUGE(JPGFL)
    YGFLC(JGFL)%MP_SL1    = -HUGE(JPGFL)
    YGFLC(JGFL)%MP_SLX    = -HUGE(JPGFL)
    YGFLC(JGFL)%MPPT      = -HUGE(JPGFL)
    YGFLC(JGFL)%MPPC      = -HUGE(JPGFL)
  ENDDO
  NULLIFY(YLASTGFLC)
  LLFIRSTCALL = .FALSE.
ENDIF

!-------------------------------------------------------------------------

!      2. Define GFL component
!         --------------------

!      2.1 Some checks
IF(LDGP) THEN
  DO JGFL=1,YGFL%NUMFLDS
    IF(.NOT. YGFLC(JGFL)%LGP) THEN
      !        Grid-point fields should be defined before any spectral field 
      CALL ABOR1('YOMMFL:DEFINE_GFL_COMP:GRIDPOINT BEFORE SPECTRAL')
    ENDIF
  ENDDO
ENDIF
IF(LDGP) THEN
  IF(LDERS) THEN
    !      Derivatives can only be defined for spectral fields
    CALL ABOR1('YOMMFL:DEFINE_GFL_COMP:DERIVATIVES ONLY WITH SPECTRAL')
  ENDIF
ENDIF
IF(YGFL%NUMFLDS == JPGFL) THEN
  WRITE(NULOUT,*) ' MAXIMUM NUMBER OF FIELDS ALREADY DEFINED'
  CALL ABOR1('YOMMFL: EXCEED NUMBER OF FIELDS')
ENDIF

!      2.2 Define field attributes

ICURFLDPT = YGFL%NUMFLDS+1
ICURFLDPC = YGFL%NUMFLDS+1

YDGFLC%LACTIVE = .TRUE.
YDGFLC%CNAME = CDNAME
YDGFLC%IGRBCODE = KGRIB
YDGFLC%NREQIN = KREQIN
IF (PRESENT(PREFVALI)) THEN
  YDGFLC%REFVALI = PREFVALI
ENDIF 
YDGFLC%LREQOUT = LDREQOUT
YDGFLC%LGP = LDGP
YDGFLC%LSP= .NOT. YDGFLC%LGP
YDGFLC%LT5 = LD5
YDGFLC%LT1 = LDT1
YDGFLC%LCDERS  = LDERS
IF(PRESENT(LDGPINGP)) YDGFLC%LGPINGP=LDGPINGP
IF(PRESENT(LDTRAJIO)) YDGFLC%LTRAJIO=LDTRAJIO
IF(PRESENT(LDTHERMACT)) YDGFLC%LTHERMACT=LDTHERMACT
IF(YDGFLC%LTHERMACT) THEN
  IF(.NOT.PRESENT(PR)) &
   &CALL ABOR1('GFL_SUBS:DEFINE_GFL_COMPONENT - PR MISSING')
  IF(.NOT.PRESENT(PRCP)) &
   &CALL ABOR1('GFL_SUBS:DEFINE_GFL_COMPONENT - PRCP MISSING')
  YDGFLC%R = PR
  YDGFLC%RCP = PRCP
ENDIF

!    2.3  Numbers of fields and dimensions
YGFL%NUMFLDS = YGFL%NUMFLDS+1
IF (YDGFLC%LT5) YGFL%NUMFLDS5 = YGFL%NUMFLDS5+1

IF(YDGFLC%LCDERS) THEN
  YGFL%NDIM = YGFL%NDIM+3
  YGFL%NDIM0 = YGFL%NDIM0+3
  YGFL%NDERS = YGFL%NDERS+1
  IF (YDGFLC%LT5) YGFL%NDIM5 = YGFL%NDIM5+3
ELSE
  YGFL%NDIM = YGFL%NDIM+1
  YGFL%NDIM0 = YGFL%NDIM0+1
  IF (YDGFLC%LT5) YGFL%NDIM5 = YGFL%NDIM5+1
ENDIF

IF(YDGFLC%LSP) THEN
  YGFL%NUMSPFLDS =YGFL%NUMSPFLDS+1
ELSE
  YGFL%NUMGPFLDS =YGFL%NUMGPFLDS+1
ENDIF

IF (YDGFLC%LT1)  THEN
  YGFL%NUMFLDS1 = YGFL%NUMFLDS1+1
  YGFL%NDIM1 = YGFL%NDIM1+1
  IF (YDGFLC%LSP) YGFL%NUMSPFLDS1 =YGFL%NUMSPFLDS1+1
ENDIF  

!    2.4  Define field "pointers"
YDGFLC%MP5 = -HUGE(JPGFL)
IF (YDGFLC%LGP) THEN
  YDGFLC%MP = YGFL%NDIM0
  IF (YDGFLC%LT5) YDGFLC%MP5 = YGFL%NDIM5
ELSE
  YDGFLC%MP = YGFL%NUMFLDS
  IF (YDGFLC%LT5) YDGFLC%MP5 = YGFL%NUMFLDS5
ENDIF
IF (YDGFLC%LCDERS) THEN
  YDGFLC%MPM = YDGFLC%MP+YGFL%NDERS
  YDGFLC%MPL = YDGFLC%MP+2*YGFL%NDERS
  IF(YDGFLC%LT5) THEN
    YDGFLC%MP5M = YDGFLC%MP5+YGFL%NDERS
    YDGFLC%MP5L = YDGFLC%MP5+2*YGFL%NDERS
  ENDIF
ELSE
  YDGFLC%MPL = -HUGE(JPGFL)
  YDGFLC%MPM = -HUGE(JPGFL)
  YDGFLC%MP5L = -HUGE(JPGFL)
  YDGFLC%MP5M = -HUGE(JPGFL)
ENDIF

IF(YDGFLC%LSP) THEN
  YDGFLC%MPSP = YGFL%NUMSPFLDS
ELSE
  YDGFLC%MPSP = -HUGE(JPGFL)
ENDIF

IF (YDGFLC%LT1)  THEN
  YDGFLC%MP1 = YGFL%NUMFLDS1
ELSE
  YDGFLC%MP1 = -HUGE(JPGFL)
ENDIF  
  
!      2.6  Possibly reassign pointers (needed for multiple fields with derivatives)

IF(ASSOCIATED(YLASTGFLC)) THEN
  YPTRC=>YLASTGFLC
  DO
    IF(.NOT.LDGP) THEN
      IF(YPTRC%LCDERS) THEN
        YPTRC%MPM = YPTRC%MPM+1
        IF(LDERS)THEN
          YPTRC%MPL = YPTRC%MPL+2
        ELSE
          YPTRC%MPL = YPTRC%MPL+1
        ENDIF
      ENDIF
      WRITE(NULOUT,*)' DEFINE_GFL_COMP:CHECKING ',YPTRC%CNAME
      WRITE(NULOUT,*)' REASSIGNED MPL=',YPTRC%MPL,' MPM=',YPTRC%MPM
      IF (YDGFLC%LT5) THEN
        IF(YPTRC%LT5) THEN
          IF(YPTRC%LCDERS) THEN
            YPTRC%MP5M = YPTRC%MP5M+1
            IF(LDERS)THEN
              YPTRC%MP5L = YPTRC%MP5L+2
            ELSE
              YPTRC%MP5L = YPTRC%MP5L+1
            ENDIF
          ENDIF
          WRITE(NULOUT,*)' REASSIGNED MP5L=',YPTRC%MP5L,' MP5M=',YPTRC%MP5M
        ENDIF
      ENDIF

    ENDIF
    IF(.NOT.ASSOCIATED(YPTRC%PREVIOUS)) EXIT
    YPTRC=>YPTRC%PREVIOUS
  ENDDO
ENDIF

!    2.7  Point to last defined field
YDGFLC%PREVIOUS=>YLASTGFLC
YLASTGFLC => YDGFLC
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEFINE_GFL_COMP',1,ZHOOK_HANDLE)

!     ------------------------------------------------------------------
END SUBROUTINE DEFINE_GFL_COMP

!=========================================================================

SUBROUTINE SET_GFL_ATTR(YDGFLC,LDADV,LDT9,LDPHY,LDPT,LDPC,LDADJUST0,&
 & LDADJUST1,KCOUPLING,PREFVALC,LDBIPER,CDSLINT)  

!**** *SET_GFL_ATTR* Add attributes to previously setup GFL components

!     Purpose.
!     --------
!     Add further attributes to previously setup, by call to DEFINE_GFL_COMP, GFL components

!        Explicit arguments :
!        --------------------
!        LDADV   - TRUE if field to be advected
!        LDT9    - TRUE if field present in t-dt
!        LDPHY   - TRUE if field updated by physics
!        LDPT    - TRUE if field present in phy. tend.
!        LDPC    - TRUE if field in predictor/corrector time stepping treatment (3TL)
!        LDADJUST0  - TRUE if field to be adjusted at t
!        LDADJUST1  - TRUE if field to be adjusted at t+dt
!        KCOUPLING - 1 if field to be coupled, 0 if not, -1 if coupled with REFVALC
!        REVALC     - refernce value for coupling, used only in case NCOUPLING==-1
!        LDBIPER    - TRUE if field to be biperiodised
!        CDSLINT - S.L. interpolator

!     Author.
!     -------
!      Mats Hamrud  *ECMWF*

!     Modifications.
!     --------------
!      Original : 2003-03-01
!      Modifications:
!      03/07/09 C. Fischer - add Arome/Aladin attributes
!      2004-Nov F. Vana - update of CDSLINT
!-------------------------------------------------------------------------

TYPE(TYPE_GFL_COMP),TARGET,INTENT(INOUT) :: YDGFLC
LOGICAL,INTENT(IN),OPTIONAL :: LDADV
LOGICAL,INTENT(IN),OPTIONAL :: LDT9 
LOGICAL,INTENT(IN),OPTIONAL :: LDPHY
LOGICAL,INTENT(IN),OPTIONAL :: LDPT
LOGICAL,INTENT(IN),OPTIONAL :: LDPC
LOGICAL,INTENT(IN),OPTIONAL :: LDADJUST0
LOGICAL,INTENT(IN),OPTIONAL :: LDADJUST1
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOUPLING
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PREFVALC
LOGICAL,INTENT(IN),OPTIONAL :: LDBIPER
CHARACTER(LEN=12),INTENT(IN),OPTIONAL  :: CDSLINT

INTEGER(KIND=JPIM) :: IGFLPTR
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!-------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('GFL_SUBS:SET_GFL_ATTR',0,ZHOOK_HANDLE)
IF(YDGFLC%MP < 1 .OR. YDGFLC%MP > YGFL%NUMFLDS) THEN
  CALL ABOR1('SET_GFL_ATTR: GFL COMPONENT NOT SET UP')
ELSE
  IGFLPTR=YDGFLC%MP
ENDIF

IF(PRESENT(LDADV)) THEN
  YDGFLC%LADV = LDADV
ENDIF
IF(YDGFLC%LADV) THEN
  IF(.NOT.YDGFLC%LT1) THEN
    CALL ABOR1(' GFL field to be advected but LT1=false')
  ENDIF
  YGFL%NUMFLDS_SL1 = YGFL%NUMFLDS_SL1+1
  YDGFLC%MP_SL1 = YGFL%NUMFLDS_SL1
  YDGFLC%MP_SLX = (YGFL%NUMFLDS_SL1-1)*(NFLEVG+2*NFLSUL)
ENDIF
  

! Other timelevels etc.

IF(PRESENT(LDT9)) THEN
  YDGFLC%LT9 = LDT9
ENDIF
IF(YDGFLC%LT9 .AND. YDGFLC%MP9 == -HUGE(JPGFL) ) THEN
  YGFL%NUMFLDS9 = YGFL%NUMFLDS9+1
  YGFL%NDIM  = YGFL%NDIM+1
  YGFL%NDIM9 = YGFL%NDIM9+1
  YDGFLC%MP9 = YGFL%NDIM0+YGFL%NUMFLDS9
  YDGFLC%MP9_PH = YDGFLC%MP9
ELSE
  YDGFLC%MP9 = YDGFLC%MP
  YDGFLC%MP9_PH = YDGFLC%MP9
  WRITE(NULOUT,*) 'WARNING YDGFLC%MP9 = YDGFLC%MP',YDGFLC%MP9,YDGFLC%MP
ENDIF

IF(PRESENT(LDPHY)) THEN
  YDGFLC%LPHY = LDPHY
ENDIF
IF(YGFL%NUMFLDSPHY == 0)YGFL%NUMFLDSPHY=YGFL%NUMFLDSPHY-MSAVTEND_S
IF(YDGFLC%MPSLP == -HUGE(JPGFL)) THEN
  IF(YDGFLC%LPHY) THEN
    IF(.NOT.YDGFLC%LT1) THEN
      CALL ABOR1(' GFL field to be modified by physics but LT1=false')
    ENDIF
    YGFL%NUMFLDSPHY = YGFL%NUMFLDSPHY+1+MSAVTEND_S
    YGFL%NDIMSLP = YGFL%NDIMSLP+1+MSAVTEND_S
    YDGFLC%MPSLP = YGFL%NUMFLDSPHY
  ENDIF
ENDIF

IF(PRESENT(LDPT)) THEN
  YDGFLC%LPT = LDPT
ENDIF
IF(YDGFLC%MPPT == -HUGE(JPGFL)) THEN
  IF(YDGFLC%LPT) THEN
    YGFL%NUMFLDSPT = YGFL%NUMFLDSPT+1
    YGFL%NDIMPT = YGFL%NDIMPT+1
    YDGFLC%MPPT = YGFL%NUMFLDSPT
  ENDIF
ENDIF
IF(PRESENT(LDPC)) THEN
  YDGFLC%LPC = LDPC
ENDIF
IF(YDGFLC%MPPC == -HUGE(JPGFL)) THEN
  IF(YDGFLC%LPC) THEN
    YGFL%NUMFLDSPC = YGFL%NUMFLDSPC+1
    YGFL%NDIMPC = YGFL%NDIMPC+1
    YDGFLC%MPPC = YGFL%NUMFLDSPC
  ENDIF
ENDIF


! LAM attributes (do not involve extra dimensioning or pointers)

IF(PRESENT(LDADJUST0)) THEN
  YDGFLC%LADJUST0 = LDADJUST0
ENDIF
IF(PRESENT(LDADJUST1)) THEN
  YDGFLC%LADJUST1 = LDADJUST1
ENDIF
IF(PRESENT(KCOUPLING)) THEN
  YDGFLC%NCOUPLING = KCOUPLING
ENDIF
IF(PRESENT(PREFVALC)) THEN
  YDGFLC%REFVALC = PREFVALC
ENDIF
IF(PRESENT(LDBIPER)) THEN
  YDGFLC%LBIPER = LDBIPER
ENDIF

IF(PRESENT(CDSLINT)) THEN
  YDGFLC%CSLINT=CDSLINT
  IF(YDGFLC%MP_SPL == -HUGE(JPGFL)) THEN
    IF(CDSLINT == 'LAITVSPCQM  ') THEN
      YGFL%NUMFLDS_SPL = YGFL%NUMFLDS_SPL+1
      YGFL%NDIM_SPL = YGFL%NDIM_SPL+1
      YDGFLC%MP_SPL = YGFL%NUMFLDS_SPL
    ENDIF
  ENDIF
ENDIF
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:SET_GFL_ATTR',1,ZHOOK_HANDLE)

!     -------------------------------------------------------------------
END SUBROUTINE SET_GFL_ATTR

!=========================================================================

SUBROUTINE PRINT_GFL

!**** *PRINT_GFL*  - Print GFL attributes

!     -------------------------------------------------------------------

REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:PRINT_GFL',0,ZHOOK_HANDLE)
WRITE(NULOUT,*) ' ---- GFL COMPONENT ATTRIBUTES ----'
IF(ASSOCIATED(YLASTGFLC)) THEN
  YPTRC=>YLASTGFLC
  DO
    WRITE(NULOUT,*) ' GFL COMPONENT DEFINED - NAME=',&
     & YPTRC%CNAME,' GRIBCODE=', YPTRC%IGRBCODE  
    WRITE(NULOUT,*)' LGP=',YPTRC%LGP,' NREQIN=',YPTRC%NREQIN, &
     & ' LREQOUT=',YPTRC%LREQOUT,' REFVALI=',YPTRC%REFVALI, &
     & ' LCDERS=', YPTRC%LCDERS,' LADV=',YPTRC%LADV, &
     & ' LPHY=',YPTRC%LPHY,' LPT=',YPTRC%LPT,' LPC=',YPTRC%LPC
    WRITE(NULOUT,*)' LADJUST0=',YPTRC%LADJUST0,' LADJUST1=',YPTRC%LADJUST1,&
     & ' NCOUPLING=',YPTRC%NCOUPLING,' REFVALC=',YPTRC%REFVALC,&
     & ' LBIPER=',YPTRC%LBIPER  
    WRITE(NULOUT,*)' LTRAJIO=',YPTRC%LTRAJIO,' LGPINGP=',YPTRC%LGPINGP
    WRITE(NULOUT,*)' CSLINT=',YPTRC%CSLINT
     WRITE(NULOUT,*)'LTHERMACT=',YPTRC%LTHERMACT,&
      & ' R=',YPTRC%R,' RCP=',YPTRC%RCP
    WRITE(NULOUT,*)' MP=',YPTRC%MP,' MPL=',YPTRC%MPL,&
     & ' MPM=',YPTRC%MPM,' MP9=',YPTRC%MP9,' MP1=',YPTRC%MP1,&
     & ' MP5=',YPTRC%MP5,' MP5L=',YPTRC%MP5L,' MP5M=',YPTRC%MP5M, &
     & ' MPSLP=',YPTRC%MPSLP,' MPSP=',YPTRC%MPSP,&
     & ' MPPT=',YPTRC%MPPT, ' MPPC=',YPTRC%MPPC
    IF(.NOT.ASSOCIATED(YPTRC%PREVIOUS)) EXIT
    YPTRC=>YPTRC%PREVIOUS
  ENDDO
ENDIF

WRITE(NULOUT,*) ' ---- YGFL ATTRIBUTES ----'
WRITE(NULOUT,*) ' YGFL%NUMFLDS=',YGFL%NUMFLDS,&
 & ' YGFL%NUMSPFLDS=',YGFL%NUMSPFLDS,' YGFL%NUMGPFLDS=',YGFL%NUMGPFLDS,&
 & ' YGFL%NDERS=',YGFL%NDERS,' YGFL%NUMFLDSPT=',YGFL%NUMFLDSPT,&
 & ' YGFL%NUMFLDSPC=',YGFL%NUMFLDSPC 
WRITE(NULOUT,*) ' YGFL%NUMFLDS_SL1=',YGFL%NUMFLDS_SL1 
WRITE(NULOUT,*) ' YGFL%NDIM=',YGFL%NDIM,' YGFL%NDIM0=',YGFL%NDIM0,&
 & ' YGFL%NDIM9=',YGFL%NDIM9,' YGFL%NDIM1=',YGFL%NDIM1,&
 & ' YGFL%NDIM5=',YGFL%NDIM5,' YGFL%NDIMSLP=',YGFL%NDIMSLP,&
 & ' YGFL%NDIMPT=',YGFL%NDIMPT,' YGFL%NDIMPC=',YGFL%NDIMPC
!!$WRITE(NULOUT,*) ' YGFL%CNAMES=',YGFL%CNAMES(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%IGRBCODE=',YGFL%IGRBCODE(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%NREQIN=',YGFL%NREQIN(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%REFVALI=',YGFL%REFVALI(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LREQOUT=',YGFL%LREQOUT(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LADV=',YGFL%LADV(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%CSLINT=',YGFL%CSLINT(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MP=',YGFL%MP(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LSP=',YGFL%LSP(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MPSP=',YGFL%MPSP(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LCDERS=',YGFL%LCDERS(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LTRAJIO=',YGFL%LTRAJIO(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MPL=',YGFL%MPL(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MPM=',YGFL%MPM(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LT9=',YGFL%LT9(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MP9=',YGFL%MP9(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LT1=',YGFL%LT1(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MP1=',YGFL%MP1(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LT5=',YGFL%LT5(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MP5=',YGFL%MP5(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MP5L=',YGFL%MP5L(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MP5M=',YGFL%MP5M(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LPHY=',YGFL%LPHY(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MPSLP=',YGFL%MPSLP(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LPT=',YGFL%LPT(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MPPT=',YGFL%MPPT(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LPC=',YGFL%LPC(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%MPPC=',YGFL%MPPC(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LADJUST0=',YGFL%LADJUST0(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LADJUST1=',YGFL%LADJUST1(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%NCOUPLING=',YGFL%NCOUPLING(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%REFVALC=',YGFL%REFVALC(1:YGFL%NUMFLDS)
!!$WRITE(NULOUT,*) ' YGFL%LBIPER=',YGFL%LBIPER(1:YGFL%NUMFLDS)
WRITE(NULOUT,*) ' --------------------------------------------'
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:PRINT_GFL',1,ZHOOK_HANDLE)
END SUBROUTINE PRINT_GFL

!=========================================================================

!SUBROUTINE DEACT_CLOUD_GFL  ! commente par MPL 10.12.08 (et REACT_CLOUD_GFL)
!
!**** *DEACT_CLOUD_GFL* Deactivate prognostic cloud variables
!
!     ------------------------------------------------------------------
!
!INTEGER(KIND=JPIM) :: JGFL
!REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!#include "suslb.intfb.h"
!
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEACT_CLOUD_GFL',0,ZHOOK_HANDLE)
!
!IF (.NOT.L_CLD_DEACT .AND. &
! & (YL%LACTIVE .OR. YI%LACTIVE .OR. &
! &  YR%LACTIVE .OR. YS%LACTIVE .OR. YA%LACTIVE .OR. YCPF%LACTIVE ) ) THEN
!  CALL COPY_GFLC_GFLC(YL_SAVE,YL)
!  CALL COPY_GFLC_GFLC(YI_SAVE,YI)
!  CALL COPY_GFLC_GFLC(YR_SAVE,YR)
!  CALL COPY_GFLC_GFLC(YS_SAVE,YS)
!  CALL COPY_GFLC_GFLC(YA_SAVE,YA)
!  CALL COPY_GFLC_GFLC(YCPF_SAVE,YCPF)
!  
!  IF( .NOT. LENCLD2) THEN
!    IF (YL%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1
!    IF (YI%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1
!    IF (YR%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1
!    IF (YS%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1
!    IF (YA%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1
!    IF (YCPF%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1
!
!    IF (YL%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1
!    IF (YI%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1
!    IF (YR%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1
!    IF (YS%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1
!    IF (YA%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1
!    IF (YCPF%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1
!
!    CALL FALSIFY_GFLC(YL)
!    CALL FALSIFY_GFLC(YI)
!    CALL FALSIFY_GFLC(YR)
!   CALL FALSIFY_GFLC(YS)
!   CALL FALSIFY_GFLC(YA)
!   CALL FALSIFY_GFLC(YCPF)
! ELSE
!   CALL NOADVECT_GFLC(YL)
!   CALL NOADVECT_GFLC(YI)
!   CALL NOADVECT_GFLC(YR)
!   CALL NOADVECT_GFLC(YS)
!   CALL NOADVECT_GFLC(YA)
!   CALL NOADVECT_GFLC(YCPF)
! ENDIF
! YGFL%NUMFLDS_SL1 = 0
! DO JGFL=1,YGFL%NUMFLDS
!   YGFLC(JGFL)%MP_SL1 = -HUGE(JPGFL)
!   IF(YGFLC(JGFL)%LADV) THEN
!     YGFL%NUMFLDS_SL1 = YGFL%NUMFLDS_SL1+1
!     YGFLC(JGFL)%MP_SL1 = YGFL%NUMFLDS_SL1
!     YGFLC(JGFL)%MP_SLX = (YGFLC(JGFL)%MP_SL1-1)*(NFLEVG+2*NFLSUL)
!   ENDIF
! ENDDO
! CALL SUSLB
!
! L_CLD_DEACT=.TRUE.
! WRITE(NULOUT,*)' CLOUD FIELDS DE-ACTIVATAD, YGFL%NUMGPFLDS=', &
! & YGFL%NUMGPFLDS,' YGFL%NUMFLDS_SL1=', YGFL%NUMFLDS_SL1
!ENDIF
!
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEACT_CLOUD_GFL',1,ZHOOK_HANDLE)
!
!END SUBROUTINE DEACT_CLOUD_GFL
!
!!=========================================================================
!
!SUBROUTINE REACT_CLOUD_GFL
!!**** *REACT_CLOUD_GFL* Reactivate prognostic cloud variables
!
!INTEGER(KIND=JPIM) :: JGFL
!REAL(KIND=JPRB) :: ZHOOK_HANDLE
!LOGICAL :: LLGPI,LLGPL,LLGPA
!#include "suslb.intfb.h"
!!     ------------------------------------------------------------------
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:REACT_CLOUD_GFL',0,ZHOOK_HANDLE)
!
!IF (L_CLD_DEACT) THEN
!  LLGPL = YL%LGP
!  LLGPI = YI%LGP
!  LLGPA = YA%LGP
!  
!  CALL COPY_GFLC_GFLC(YL,YL_SAVE)
!  CALL COPY_GFLC_GFLC(YI,YI_SAVE)
!  CALL COPY_GFLC_GFLC(YA,YA_SAVE)
!
!  IF (.NOT. LLGPL .AND. YL%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS+1
!  IF (.NOT. LLGPI .AND. YI%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS+1
!  IF (.NOT. LLGPA .AND. YA%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS+1
!
!  YGFL%NUMFLDS_SL1 = 0
!  DO JGFL=1,YGFL%NUMFLDS
!    YGFLC(JGFL)%MP_SL1 = -HUGE(JPGFL)
!    IF(YGFLC(JGFL)%LADV) THEN
!      YGFL%NUMFLDS_SL1 = YGFL%NUMFLDS_SL1+1
!      YGFLC(JGFL)%MP_SL1 = YGFL%NUMFLDS_SL1
!      YGFLC(JGFL)%MP_SLX = (YGFLC(JGFL)%MP_SL1-1)*(NFLEVG+2*NFLSUL)
!    ENDIF
!  ENDDO
!  CALL SUSLB
!
!  L_CLD_DEACT=.FALSE.
!  WRITE(NULOUT,*)' CLOUD FIELDS RE-ACTIVATAD, YGFL%NUMGPFLDS=', &
!  & YGFL%NUMGPFLDS,' YGFL%NUMFLDS_SL1=', YGFL%NUMFLDS_SL1
!ENDIF
!
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:REACT_CLOUD_GFL',1,ZHOOK_HANDLE)
!
!!     ------------------------------------------------------------------
!END SUBROUTINE REACT_CLOUD_GFL

!=========================================================================

SUBROUTINE FALSIFY_GFLC(YDGFLC)

!     Purpose.
!     --------
!       Set field descriptors to false.

!     Author.
!     -------
!      Y. Tremolet

!     Modifications.
!     --------------
!      Original : 2004-03-12
!-------------------------------------------------------------------------

TYPE(TYPE_GFL_COMP),INTENT(INOUT) :: YDGFLC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('GFL_SUBS:FALSIFY_GFLC',0,ZHOOK_HANDLE)
YDGFLC%CNAME     = ''
YDGFLC%IGRBCODE  = -HUGE(JPGFL)
YDGFLC%LADV      = .FALSE.
YDGFLC%NREQIN    = 0
YDGFLC%REFVALI   = 0.0_JPRB
YDGFLC%LREQOUT   = .FALSE.
YDGFLC%LGPINGP   = .TRUE.
YDGFLC%LTRAJIO   = .FALSE.
YDGFLC%LGP       = .FALSE.
YDGFLC%LSP       = .FALSE.
YDGFLC%LCDERS    = .FALSE.
YDGFLC%LACTIVE   = .FALSE.
YDGFLC%LTHERMACT = .FALSE.
YDGFLC%LT9       = .FALSE.
YDGFLC%LT1       = .FALSE.
YDGFLC%LT5       = .FALSE.
YDGFLC%LPHY      = .FALSE.
YDGFLC%LPT       = .FALSE.
YDGFLC%LPC       = .FALSE.
YDGFLC%LADJUST0  = .FALSE.
YDGFLC%LADJUST1  = .FALSE.
YDGFLC%NCOUPLING = 0
YDGFLC%REFVALC   = 0.0_JPRB
YDGFLC%LBIPER    = .FALSE.
YDGFLC%CSLINT    = ''
YDGFLC%R         = 0.0_JPRB
YDGFLC%RCP       = 0.0_JPRB
!yt YDGFLC%MP        = -HUGE(JPGFL)
!yt YDGFLC%MPL       = -HUGE(JPGFL)
!yt YDGFLC%MPM       = -HUGE(JPGFL)
!yt YDGFLC%MP9       = -HUGE(JPGFL)
!yt YDGFLC%MP1       = -HUGE(JPGFL)
!yt YDGFLC%MP5       = -HUGE(JPGFL)
!yt YDGFLC%MP5L      = -HUGE(JPGFL)
!yt YDGFLC%MP5M      = -HUGE(JPGFL)
!yt YDGFLC%MPSLP     = -HUGE(JPGFL)
!yt YDGFLC%MPSP      = -HUGE(JPGFL)
!yt YDGFLC%MP_SPL    = -HUGE(JPGFL)
!yt;-) YDGFLC%MPPT   = -HUGE(JPGFL)
!yt;-) YDGFLC%MPPC   = -HUGE(JPGFL)
!yt NULLIFY(YDGFLC%PREVIOUS)
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:FALSIFY_GFLC',1,ZHOOK_HANDLE)

END SUBROUTINE FALSIFY_GFLC
!=========================================================================

SUBROUTINE NOADVECT_GFLC(YDGFLC)

!     Purpose.
!     --------
!       Switch off advection ect.

!     Author.
!     -------
!      Y. Tremolet

!     Modifications.
!     --------------
!      Original : 2004-03-12
!-------------------------------------------------------------------------

TYPE(TYPE_GFL_COMP),INTENT(INOUT) :: YDGFLC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('GFL_SUBS:NOADVECT_GFLC',0,ZHOOK_HANDLE)
YDGFLC%LADV      = .FALSE.
YDGFLC%LCDERS    = .FALSE.
YDGFLC%LT1       = .FALSE.
YDGFLC%LT5       = .FALSE.
YDGFLC%LPHY      = .FALSE.
YDGFLC%LPT       = .FALSE.
YDGFLC%LADJUST0  = .FALSE.
YDGFLC%LADJUST1  = .FALSE.
YDGFLC%LBIPER    = .FALSE.
YDGFLC%CSLINT    = ''
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:NOADVECT_GFLC',1,ZHOOK_HANDLE)

END SUBROUTINE NOADVECT_GFLC

!=========================================================================

SUBROUTINE COPY_GFLC_GFLC(YDGFLC1,YDGFLC2)

!     Purpose.
!     --------
!       Copy field descriptors.

!     Author.
!     -------
!      Y. Tremolet

!     Modifications.
!     --------------
!      Original : 2004-03-12
!-------------------------------------------------------------------------

TYPE (TYPE_GFL_COMP), INTENT(INOUT) :: YDGFLC1
TYPE (TYPE_GFL_COMP), INTENT(IN)    :: YDGFLC2
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (LHOOK) CALL DR_HOOK('GFL_SUBS:COPY_GFLC_GFLC',0,ZHOOK_HANDLE)
YDGFLC1%CNAME     = YDGFLC2%CNAME
YDGFLC1%IGRBCODE  = YDGFLC2%IGRBCODE
YDGFLC1%LADV      = YDGFLC2%LADV
YDGFLC1%NREQIN    = YDGFLC2%NREQIN
YDGFLC1%REFVALI   = YDGFLC2%REFVALI
YDGFLC1%LREQOUT   = YDGFLC2%LREQOUT
YDGFLC1%LGPINGP   = YDGFLC2%LGPINGP
YDGFLC1%LTRAJIO   = YDGFLC2%LTRAJIO
YDGFLC1%LGP       = YDGFLC2%LGP
YDGFLC1%LSP       = YDGFLC2%LSP
YDGFLC1%LPT       = YDGFLC2%LPT
YDGFLC1%LPC       = YDGFLC2%LPC
YDGFLC1%LCDERS    = YDGFLC2%LCDERS
YDGFLC1%LACTIVE   = YDGFLC2%LACTIVE
YDGFLC1%LTHERMACT = YDGFLC2%LTHERMACT
YDGFLC1%LT9       = YDGFLC2%LT9
YDGFLC1%LT1       = YDGFLC2%LT1
YDGFLC1%LT5       = YDGFLC2%LT5
YDGFLC1%LPHY      = YDGFLC2%LPHY
YDGFLC1%LADJUST0  = YDGFLC2%LADJUST0
YDGFLC1%LADJUST1  = YDGFLC2%LADJUST1
YDGFLC1%NCOUPLING = YDGFLC2%NCOUPLING
YDGFLC1%REFVALC   = YDGFLC2%REFVALC
YDGFLC1%LBIPER    = YDGFLC2%LBIPER
YDGFLC1%CSLINT    = YDGFLC2%CSLINT
YDGFLC1%R         = YDGFLC2%R
YDGFLC1%RCP       = YDGFLC2%RCP
YDGFLC1%MP        = YDGFLC2%MP
YDGFLC1%MPL       = YDGFLC2%MPL
YDGFLC1%MPM       = YDGFLC2%MPM
YDGFLC1%MP9       = YDGFLC2%MP9
YDGFLC1%MP1       = YDGFLC2%MP1
YDGFLC1%MP5       = YDGFLC2%MP5
YDGFLC1%MP5L      = YDGFLC2%MP5L
YDGFLC1%MP5M      = YDGFLC2%MP5M
YDGFLC1%MPSLP     = YDGFLC2%MPSLP
YDGFLC1%MP_SPL    = YDGFLC2%MP_SPL
YDGFLC1%MP_SL1    = YDGFLC2%MP_SL1
YDGFLC1%MPSP      = YDGFLC2%MPSP
YDGFLC1%MPPT      = YDGFLC2%MPPT
YDGFLC1%MPPC      = YDGFLC2%MPPC
!yt YDGFLC1%PREVIOUS => YDGFLC2%PREVIOUS
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:COPY_GFLC_GFLC',1,ZHOOK_HANDLE)

END SUBROUTINE COPY_GFLC_GFLC

!=========================================================================

END MODULE GFL_SUBS