Skip to content
Snippets Groups Projects
ini_budget.f90 130 KiB
Newer Older
  • Learn to ignore specific revisions
  • !MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
    
    !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
    
    !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
    
    !MNH_LIC for details. version 1.
    
    !-----------------------------------------------------------------
    !     ######################
          MODULE MODI_INI_BUDGET
    !     ###################### 
    INTERFACE
    
          SUBROUTINE INI_BUDGET(KLUOUT,PTSTEP,KSV,KRR,            &
    
          ONUMDIFU,ONUMDIFTH,ONUMDIFSV,                                   &
          OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR,             &
          OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, & 
    
          OHORELAX_SV,OVE_RELAX,OCHTRANS,ONUDGING,ODRAGTREE,ODEPOTREE,    &
    
          HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD                        )
    
    !
    INTEGER,         INTENT(IN) :: KLUOUT   ! Logical unit number for prints
    REAL, INTENT(IN) :: PTSTEP              ! time step
    INTEGER, INTENT(IN) :: KSV              ! number of scalar variables
    INTEGER, INTENT(IN) :: KRR              ! number of moist variables
    LOGICAL, INTENT(IN) :: ONUMDIFU         ! switch to activate the numerical
                                            ! diffusion for momentum
    LOGICAL, INTENT(IN) :: ONUMDIFTH        ! for meteorological scalar variables
    LOGICAL, INTENT(IN) :: ONUMDIFSV        ! for tracer scalar variables
    LOGICAL, INTENT(IN) :: OHORELAX_UVWTH  ! switch for the
                           ! horizontal relaxation for U,V,W,TH
    LOGICAL, INTENT(IN) :: OHORELAX_RV     ! switch for the
                           ! horizontal relaxation for Rv
    LOGICAL, INTENT(IN) :: OHORELAX_RC     ! switch for the
                           ! horizontal relaxation for Rc
    LOGICAL, INTENT(IN) :: OHORELAX_RR     ! switch for the
                           ! horizontal relaxation for Rr
    LOGICAL, INTENT(IN) :: OHORELAX_RI     ! switch for the
                           ! horizontal relaxation for Ri
    LOGICAL, INTENT(IN) :: OHORELAX_RS     ! switch for the
                           ! horizontal relaxation for Rs
    LOGICAL, INTENT(IN) :: OHORELAX_RG     ! switch for the
                           ! horizontal relaxation for Rg
    LOGICAL, INTENT(IN) :: OHORELAX_RH     ! switch for the
                           ! horizontal relaxation for Rh
    LOGICAL, INTENT(IN) :: OHORELAX_TKE    ! switch for the
                           ! horizontal relaxation for tke
    LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV     ! switch for the
                           ! horizontal relaxation for scalar variables
    LOGICAL, INTENT(IN) :: OVE_RELAX        ! switch to activate the vertical 
                                            ! relaxation
    LOGICAL, INTENT(IN) :: OCHTRANS         ! switch to activate convective 
                                            !transport for SV
    LOGICAL, INTENT(IN) :: ONUDGING         ! switch to activate nudging
    LOGICAL, INTENT(IN) :: ODRAGTREE        ! switch to activate vegetation drag
    
    LOGICAL, INTENT(IN) :: ODEPOTREE        ! switch to activate droplet deposition on tree
    
    CHARACTER (LEN=*), INTENT(IN) :: HRAD   ! type of the radiation scheme
    CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
    CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the deep convection scheme
    CHARACTER (LEN=*), INTENT(IN) :: HTURB  ! type of the turbulence scheme
    CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence 
                                            ! scheme
    CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
    !
          END SUBROUTINE INI_BUDGET
    !
    END INTERFACE
    !
    END MODULE MODI_INI_BUDGET
    !
    !
    !
    !     #################################################################
    
          SUBROUTINE INI_BUDGET(KLUOUT,PTSTEP,KSV,KRR,            &
    
          ONUMDIFU,ONUMDIFTH,ONUMDIFSV,                                   &
          OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR,             &
          OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, & 
    
          OHORELAX_SV,OVE_RELAX,OCHTRANS,ONUDGING,ODRAGTREE,ODEPOTREE,    &
    
          HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD                        )
    
    !     #################################################################
    !
    !!****  *INI_BUDGET* - routine to initialize the parameters for the budgets
    !!
    !!    PURPOSE
    !!    -------
    !       The purpose of this routine is to set or compute the parameters used
    !     by the MESONH budgets. Names of files for budget recording are processed 
    !     and storage arrays are initialized.               
    !
    !!**  METHOD
    !!    ------
    !!      The essential of information is passed by modules. The choice of budgets 
    !!    and processes set by the user as integers is converted in "actions" 
    !!    readable  by the subroutine BUDGET under the form of string characters. 
    !!    For each complete process composed of several elementary processes, names 
    !!    of elementary processes are concatenated in order to have an explicit name
    !!    in the comment of the recording file for budget. 
    !!
    !!      
    !!    EXTERNAL
    !!    --------   
    !!      None
    !!
    !!    IMPLICIT ARGUMENTS
    !!    ------------------ 
    !!      Module MODD_PARAMETERS: JPBUMAX,JPBUPROMAX
    !!
    !!      Module MODD_CONF: CCONF        
    !!
    !!      Module MODD_DYN:  XSEGLEN 
    !!
    !!
    !!    REFERENCE
    !!    ---------
    !!      Book2 of documentation (routine INI_BUDGET)
    !!      
    !!
    !!    AUTHOR
    !!    ------
    !!	P. Hereil      * Meteo France *
    !!
    !!    MODIFICATIONS
    !!    -------------
    !!      Original        01/03/95 
    !!      J. Stein        25/06/95  put the sources in phase with the code
    !!      J. Stein        20/07/95  reset to FALSE of all the switches when
    !!                                CBUTYPE /= MASK or CART
    !!      J. Stein        26/06/96  add the new sources + add the increment between
    !!                                2 active processes
    !!      J.-P. Pinty     13/12/96  Allowance of multiple SVs
    !!      J.-P. Pinty     11/01/97  Includes deep convection ice and forcing processes
    !!      J.-P. Lafore    10/02/98  Allocation of the RHODJs for budget
    !!      V. Ducrocq      04/06/99  //  
    !!      N. Asencio      18/06/99  // MASK case : delete KIMAX and KJMAX arguments,
    !!                                GET_DIM_EXT_ll initializes the dimensions of the
    !!                                extended local domain.
    !!                                LBU_MASK and XBUSURF are allocated on the extended
    !!                                local domain.
    !!                                add 3 local variables IBUDIM1,IBUDIM2,IBUDIM3
    !!                                to define the dimensions of the budget arrays
    !!                                in the different cases CART and MASK
    !!      J.-P. Pinty     23/09/00  add budget for C2R2
    !!      V. Masson       18/11/02  add budget for 2way nesting
    !!      O.Geoffroy      03/2006   Add KHKO scheme
    !!      J.-P. Pinty     22/04/97  add the explicit hail processes
    !!      C.Lac           10/08/07  Add ADV for PPM without contribution
    !!                                of each direction
    !!      C. Barthe       19/11/09  Add atmospheric electricity
    !!      C.Lac           01/07/11  Add vegetation drag        
    !!      P. Peyrille, M. Tomasini : include in the forcing term the 2D forcing
    !!                                terms in term 2DFRC search for modif PP . but Not very clean! 
    
    !!      C .Lac          27/05/14    add negative corrections for chemical species
    
    !!      C.Lac           29/01/15  Correction for NSV_USER
    
    !!      J.Escobar       02/10/2015 modif for JPHEXT(JPVEXT) variable  
    
    !!      C.Lac           04/12/15  Correction for LSUPSAT 
    !!                   04/2016 (C.LAC) negative contribution to the budget splitted between advection, turbulence and microphysics for KHKO/C2R2
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
    !!      C. Barthe       01/2016   Add budget for LIMA
    
    !!      C.Lac          10/2016   Add budget for droplet deposition
    !!      S. Riette        11/2016  New budgets for ICE3/ICE4
    
    !!  Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
    
    !  P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
    
    !-------------------------------------------------------------------------------
    !
    !*       0.    DECLARATIONS
    !              ------------ 
    !
    USE MODD_PARAMETERS
    USE MODD_BUDGET
    USE MODD_DYN
    USE MODD_CONF
    USE MODD_PARAM_ICE
    USE MODD_PARAM_C2R2
    USE MODD_ELEC_DESCR, ONLY : LINDUCTIVE
    USE MODD_2D_FRC
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
    USE MODD_PARAM_LIMA, ONLY : OWARM=>LWARM, OCOLD=>LCOLD, OSEDI=>LSEDI,   &
                                OHHONI=>LHHONI, ORAIN=>LRAIN, OSEDC=>LSEDC, &
                                ONUCL=>LNUCL, OACTI=>LACTI, OSNOW=>LSNOW,   &
    
                                OHAIL=>LHAIL, OSCAV=>LSCAV, OMEYERS=>LMEYERS,&
    
                                ODEPOC=>LDEPOC, OPTSPLIT=>LPTSPLIT,          &
                                NMOD_CCN
    
    !
    IMPLICIT NONE
    !
    !*       0.1   declarations of argument
    !
    !
    INTEGER,         INTENT(IN) :: KLUOUT   ! Logical unit number for prints
    REAL, INTENT(IN) :: PTSTEP              ! time step
    INTEGER, INTENT(IN) :: KSV              ! number of scalar variables
    INTEGER, INTENT(IN) :: KRR              ! number of moist variables
    LOGICAL, INTENT(IN) :: ONUMDIFU         ! switch to activate the numerical
                                            ! diffusion for momentum
    LOGICAL, INTENT(IN) :: ONUMDIFTH        ! for meteorological scalar variables
    LOGICAL, INTENT(IN) :: ONUMDIFSV        ! for tracer scalar variables
    LOGICAL, INTENT(IN) :: OHORELAX_UVWTH  ! switch for the
                           ! horizontal relaxation for U,V,W,TH
    LOGICAL, INTENT(IN) :: OHORELAX_RV     ! switch for the
                           ! horizontal relaxation for Rv
    LOGICAL, INTENT(IN) :: OHORELAX_RC     ! switch for the
                           ! horizontal relaxation for Rc
    LOGICAL, INTENT(IN) :: OHORELAX_RR     ! switch for the
                           ! horizontal relaxation for Rr
    LOGICAL, INTENT(IN) :: OHORELAX_RI     ! switch for the
                           ! horizontal relaxation for Ri
    LOGICAL, INTENT(IN) :: OHORELAX_RS     ! switch for the
                           ! horizontal relaxation for Rs
    LOGICAL, INTENT(IN) :: OHORELAX_RG     ! switch for the
                           ! horizontal relaxation for Rg
    LOGICAL, INTENT(IN) :: OHORELAX_RH     ! switch for the
                           ! horizontal relaxation for Rh
    LOGICAL, INTENT(IN) :: OHORELAX_TKE    ! switch for the
                           ! horizontal relaxation for tke
    LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV     ! switch for the
                           ! horizontal relaxation for scalar variables
    LOGICAL, INTENT(IN) :: OVE_RELAX        ! switch to activate the vertical 
                                            ! relaxation
    LOGICAL, INTENT(IN) :: OCHTRANS         ! switch to activate convective 
                                            !transport for SV
    LOGICAL, INTENT(IN) :: ONUDGING         ! switch to activate nudging
    LOGICAL, INTENT(IN) :: ODRAGTREE        ! switch to activate vegetation drag
    
    LOGICAL, INTENT(IN) :: ODEPOTREE        ! switch to activate droplet deposition on tree
    
    CHARACTER (LEN=*), INTENT(IN) :: HRAD   ! type of the radiation scheme
    CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
    CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the shallow convection scheme
    CHARACTER (LEN=*), INTENT(IN) :: HTURB  ! type of the turbulence scheme
    CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence 
                                            ! scheme
    CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
    !
    !*       0.2   declarations of local variables
    !                                                     
    INTEGER, DIMENSION(JPBUMAX,JPBUPROMAX+1) :: IPROACTV      ! switches set by the
                                                              ! user for process 
                                                              ! activation
    INTEGER :: JI, JJ, JK , JJJ                               ! loop indices
    INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain
    INTEGER :: ITEN                                           ! tens for CBURECORD
    INTEGER :: IPROC                                          ! counter for processes
    INTEGER :: IIU, IJU                                       ! size along x and y directions
                                                              ! of the extended subdomain
    INTEGER :: IBUDIM1                                        ! first dimension of the budget arrays
                                                              ! = NBUIMAX in CART case
                                                              ! = NBUKMAX in MASK case
    INTEGER :: IBUDIM2                                        ! second dimension of the budget arrays
                                                              ! = NBUJMAX in CART case
                                                              ! = NBUWRNB in MASK case
    INTEGER :: IBUDIM3                                        ! third dimension of the budget arrays
                                                              ! = NBUKMAX in CART case
                                                              ! = NBUMASK in MASK case
    LOGICAL :: GERROR                                         ! switch for error in
                                                              ! budget specifcation
    CHARACTER(LEN=7), DIMENSION(JPBUMAX) :: YEND_COMMENT      ! last part of comment
                                                              ! for budgets records
    CHARACTER(LEN=6), DIMENSION(JPBUMAX,JPBUPROMAX) :: YWORK2 ! used for 
                                                              ! concatenattion of  
                                                              ! comments for budgets
    CHARACTER(LEN=40)                  :: YSTRING
    INTEGER                            :: ILEN
    INTEGER :: JSV               ! loop indice for the SVs
    INTEGER :: IBUPROCNBR_SV_MAX ! Max number of processes for the SVs
    INTEGER :: ILAST_PROC_NBR    ! Index of the last process number
    INTEGER :: IINFO_ll ! return status of the interface routine
    INTEGER :: IRESP   ! Return code of FM-routines
    ! 
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !!!
    !!! the lines below must be update as soon as MODD_BUDGET is updated
    !!!
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !-------------------------------------------------------------------------------
    !
    !*       1.    COMPUTE BUDGET VARIABLES
    !              ------------------------
    !
    NBUSTEP = NINT (XBULEN / PTSTEP)
    NBUTSHIFT=0
    !
    !  common dimension for all CBUTYPE values
    !
    IF (LBU_KCP) THEN
      NBUKMAX = 1
    ELSE
      NBUKMAX = NBUKH - NBUKL +1
    END IF
    !
    IF (CBUTYPE=='CART') THEN              ! cartesian case only
    !
      NBUWRNB = NINT (XBUWRI / XBULEN)  ! only after NBUWRNB budget periods, we write the
                                        ! result on the FM_FILE   
      IF (LBU_ICP) THEN 
        NBUIMAX_ll = 1
      ELSE
        NBUIMAX_ll = NBUIH - NBUIL +1
      END IF
      IF (LBU_JCP) THEN 
        NBUJMAX_ll = 1
      ELSE
        NBUJMAX_ll = NBUJH - NBUJL +1
      END IF
    !
    
      CALL GET_INTERSECTION_ll(NBUIL+JPHEXT,NBUJL+JPHEXT,NBUIH+JPHEXT,NBUJH+JPHEXT, &
    
          NBUSIL,NBUSJL,NBUSIH,NBUSJH,"PHYS",IINFO_ll)
      IF ( IINFO_ll /= 1 ) THEN ! 
        IF (LBU_ICP) THEN 
          NBUIMAX = 1
        ELSE
          NBUIMAX = NBUSIH - NBUSIL +1
        END IF
        IF (LBU_JCP) THEN 
          NBUJMAX = 1
        ELSE
          NBUJMAX =  NBUSJH - NBUSJL +1
        END IF
      ELSE ! the intersection is void 
        CBUTYPE='SKIP'  ! no budget on this processor       
        NBUIMAX = 0     ! in order to allocate void arrays
        NBUJMAX = 0
      ENDIF
    ! three first dimensions of budget arrays in cart and skip cases
       IBUDIM1=NBUIMAX
       IBUDIM2=NBUJMAX
       IBUDIM3=NBUKMAX
    ! these variables are not be used 
       NBUMASK=-1
    !
    ELSEIF (CBUTYPE=='MASK') THEN          ! mask case only 
    !
      LBU_ENABLE=.TRUE.
      NBUWRNB = NINT (XBUWRI / XBULEN)  ! only after NBUWRNB budget periods, we write the
                                        ! result on the FM_FILE
      NBUTIME = 1
    
      CALL GET_DIM_EXT_ll ('B', IIU,IJU)
      ALLOCATE( LBU_MASK( IIU ,IJU, NBUMASK) )
      LBU_MASK(:,:,:)=.FALSE.
      ALLOCATE( XBUSURF( IIU, IJU, NBUMASK, NBUWRNB) )
      XBUSURF(:,:,:,:) = 0.
    !
    ! three first dimensions of budget arrays in mask case
    !  the order of the dimensions are the order expected in WRITE_DIACHRO routine:
    !  x,y,z,time,mask,processus  and in this case x and y are missing
    !  first dimension of the arrays : dimension along K
    !  second dimension of the arrays : number of the budget time period
    !  third dimension of the arrays : number of the budget masks zones
      IBUDIM1=NBUKMAX
      IBUDIM2=NBUWRNB
      IBUDIM3=NBUMASK
    ! these variables are not used in this case
      NBUIMAX=-1
      NBUJMAX=-1
    ! the beginning and the end along x and y direction : global extended domain
     ! get dimensions of the physical global domain
       CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
       NBUIL=1
       NBUIH=IIMAX_ll + 2 * JPHEXT
       NBUJL=1 
       NBUJH=IJMAX_ll + 2 * JPHEXT
       
    !
    ELSE                      ! default case
    !
      LBU_ENABLE=.FALSE.
      NBUIMAX = -1
      NBUJMAX = -1
      LBU_RU = .FALSE.
      LBU_RV = .FALSE.
      LBU_RW = .FALSE.
      LBU_RTH= .FALSE.
      LBU_RTKE= .FALSE.
      LBU_RRV= .FALSE.
      LBU_RRC= .FALSE.
      LBU_RRR= .FALSE.
      LBU_RRI= .FALSE.
      LBU_RRS= .FALSE.
      LBU_RRG= .FALSE.
      LBU_RRH= .FALSE.
      LBU_RSV= .FALSE.
    !
    ! three first dimensions of budget arrays in default case
      IBUDIM1=0
      IBUDIM2=0
      IBUDIM3=0
    !
    END IF  
    !
    !
    !-------------------------------------------------------------------------------
    !
    !*       2.    ALLOCATE MEMORY FOR BUDGET ARRAYS AND INITIALIZE
    !              ------------------------------------------------
    !
    ALLOCATE( NBUPROCNBR(JPBUMAX) )
    ALLOCATE( NBUPROCCTR(JPBUMAX) )
    ALLOCATE( CBUACTION(JPBUMAX, JPBUPROMAX) )
    ALLOCATE( CBUCOMMENT(JPBUMAX, JPBUPROMAX) )
    ALLOCATE( CBURECORD(JPBUMAX, JPBUPROMAX) )
    NBUPROCCTR(:) = 0
    NBUCTR_ACTV(:) = 0
    NBUPROCNBR(:) = 0
    CBUACTION(:,:) = 'OF' 
    CBURECORD(:,:) = ' '
    CBUCOMMENT(:,:) = ' '
    LBU_BEG =.TRUE. 
    !
    !-------------------------------------------------------------------------------
    !
    !*       3.    INITALIZE VARIABLES
    !              -------------------
    !
    IPROACTV(:,:) = 3
    IPROACTV(:,4) = 1
    IPROACTV(:,JPBUPROMAX+1) = 0
    GERROR=.FALSE.
    YWORK2(:,:) = ' '
    YEND_COMMENT(:) = ' '
    !
    !                        Budget of RU
    IF (LBU_RU) THEN
      IPROC=4
    
      IPROC=IPROC+1
    
      IF( NMODEL>1 ) IPROACTV(NBUDGET_U, IPROC) = NNESTU
    
      IPROC=IPROC+1
    
      IF( LFORCING ) IPROACTV(NBUDGET_U, IPROC)  = NFRCU
    
      IPROC=IPROC+1
    
      IF( ONUDGING ) IPROACTV(NBUDGET_U, IPROC)  = NNUDU
    
      IPROC=IPROC+1
      IF ( .NOT. LCARTESIAN ) THEN
    
      END IF
      IPROC=IPROC+1
      IF ( LCORIO ) THEN  
    
      END IF
      IPROC=IPROC+1
    
      IF ( ONUMDIFU ) IPROACTV(NBUDGET_U, IPROC) = NDIFU
    
      IPROC=IPROC+1
      IF ( OHORELAX_UVWTH .OR. OVE_RELAX ) THEN   
    
      ELSE
        IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR.                 &
         OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR.   &
         OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
    
        END IF
      END IF
      IPROC=IPROC+1
    
      IF( ODRAGTREE ) IPROACTV(NBUDGET_U, IPROC)  = NDRAGU
    
      IPROC=IPROC+1
    
      IF ( HTURB /= 'NONE' ) IPROACTV(NBUDGET_U, IPROC) = NVTURBU
    
      IPROC=IPROC+1
      IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
    
      ELSE
        IF ( HTURB /= 'NONE' ) THEN
    
        END IF
      END IF 
      IPROC=IPROC+1
    
      IF ( HSCONV == 'EDKF' ) IPROACTV(NBUDGET_U, IPROC) = NMAFLU
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      YWORK2(NBUDGET_U, 1) = 'INIF_'
      YWORK2(NBUDGET_U, 2) = 'ENDF_'
      YWORK2(NBUDGET_U, 3) = 'AVEF_'
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      YEND_COMMENT(NBUDGET_U) = 'BU_RU'
      NBUPROCNBR(NBUDGET_U) = 3
    !
      CBUACTION(NBUDGET_U, 1) = 'IG'
      CBUACTION(NBUDGET_U, 2) = 'CC'
      CBUACTION(NBUDGET_U, 3) = 'ES'
    
        CBUCOMMENT(NBUDGET_U, JJ) = ADJUSTL( ADJUSTR( YWORK2(NBUDGET_U, JJ) ) // &
                                    ADJUSTL( YEND_COMMENT(NBUDGET_U) ) )
    
      END DO
    !
    END IF
    !
    !                        Budget of RV
    IF (LBU_RV) THEN
      IPROC=4
    
      IPROC=IPROC+1 
    
      IF( NMODEL>1 ) IPROACTV(NBUDGET_V, IPROC) = NNESTV
    
      IPROC=IPROC+1 
    
      IF( LFORCING ) IPROACTV(NBUDGET_V, IPROC)  = NFRCV
    
      IPROC=IPROC+1 
    
      IF( ONUDGING ) IPROACTV(NBUDGET_V, IPROC)  = NNUDV
    
      IPROC=IPROC+1
      IF ( .NOT. LCARTESIAN ) THEN
    
      END IF
      IPROC=IPROC+1 
      IF ( LCORIO ) THEN  
    
      END IF
      IPROC=IPROC+1 
    
      IF ( ONUMDIFU ) IPROACTV(NBUDGET_V, IPROC) = NDIFV
    
      IPROC=IPROC+1 
      IF ( OHORELAX_UVWTH .OR. OVE_RELAX ) THEN   
    
      ELSE
        IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR.                 &
         OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR.   &
         OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
    
        END IF
      END IF
      IPROC=IPROC+1
    
      IF( ODRAGTREE ) IPROACTV(NBUDGET_V, IPROC)  = NDRAGV
    
      IPROC=IPROC+1
    
      IF ( HTURB /= 'NONE' ) IPROACTV(NBUDGET_V, IPROC) = NVTURBV
    
      IPROC=IPROC+1 
      IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
    
      ELSE
        IF ( HTURB /= 'NONE' ) THEN
    
        END IF
      END IF 
      IPROC=IPROC+1 
    
      IF ( HSCONV == 'EDKF' ) IPROACTV(NBUDGET_V, IPROC) = NMAFLV
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1
    
      YWORK2(NBUDGET_V, 1) = 'INIF_'
      YWORK2(NBUDGET_V, 2) = 'ENDF_'
      YWORK2(NBUDGET_V, 3) = 'AVEF_'
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1 
    
      IPROC=IPROC+1 
    
      YEND_COMMENT(NBUDGET_V) = 'BU_RV'
      NBUPROCNBR(NBUDGET_V) = 3
    !
      CBUACTION(NBUDGET_V, 1) = 'IG'
      CBUACTION(NBUDGET_V, 2) = 'CC'
      CBUACTION(NBUDGET_V, 3) = 'ES'
    
        CBUCOMMENT(NBUDGET_V, JJ) = ADJUSTL( ADJUSTR( YWORK2(NBUDGET_V, JJ) ) // &
                                    ADJUSTL( YEND_COMMENT(NBUDGET_V) ) )
    
      END DO
    !
    END IF
    !
    !                        Budget of RW
    IF (LBU_RW) THEN
      IPROC=4
    
      IPROC=IPROC+1
    
      IF( NMODEL>1 ) IPROACTV(NBUDGET_W, IPROC) = NNESTW
    
      IPROC=IPROC+1
    
      IF( LFORCING ) IPROACTV(NBUDGET_W, IPROC)  = NFRCW
    
      IPROC=IPROC+1
    
      IF( ONUDGING ) IPROACTV(NBUDGET_W, IPROC)  = NNUDW
    
      IPROC=IPROC+1
      IF ( .NOT. LCARTESIAN ) THEN
    
      END IF
      IPROC=IPROC+1
      IF ( LCORIO ) THEN  
    
      END IF
      IPROC=IPROC+1 
    
      IF ( ONUMDIFU ) IPROACTV(NBUDGET_W, IPROC) = NDIFW
    
      IPROC=IPROC+1
      IF ( OHORELAX_UVWTH .OR. OVE_RELAX ) THEN   
    
      ELSE
        IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR.                 &
         OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR.   &
         OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
    
        END IF
      END IF
      IPROC=IPROC+1
    
      IF ( HTURB /= 'NONE' ) IPROACTV(NBUDGET_W, IPROC) = NVTURBW
    
      IPROC=IPROC+1
      IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
    
      ELSE
        IF ( HTURB /= 'NONE' ) THEN
    
        END IF
      END IF 
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      YWORK2(NBUDGET_W, 1) = 'INIF_'
      YWORK2(NBUDGET_W, 2) = 'ENDF_'
      YWORK2(NBUDGET_W, 3) = 'AVEF_'
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      YEND_COMMENT(NBUDGET_W) = 'BU_RW'
      NBUPROCNBR(NBUDGET_W) = 3
    !
      CBUACTION(NBUDGET_W, 1) = 'IG'
      CBUACTION(NBUDGET_W, 2) = 'CC'
      CBUACTION(NBUDGET_W, 3) = 'ES'
    
        CBUCOMMENT(NBUDGET_W, JJ) = ADJUSTL( ADJUSTR( YWORK2(NBUDGET_W, JJ) ) // &
                                    ADJUSTL( YEND_COMMENT(NBUDGET_W) ) )
    
      END DO
    !
    END IF
    !
    !                        Budget of RTH
    IF (LBU_RTH) THEN
      IPROC=4
    
      IPROC=IPROC+1
    
      IF( NMODEL>1 ) IPROACTV(NBUDGET_TH, IPROC) = NNESTTH
    
      IPROC=IPROC+1
    
      IF( LFORCING ) IPROACTV(NBUDGET_TH, IPROC)  = NFRCTH
    
      IPROC=IPROC+1
    
      IF( L2D_ADV_FRC ) IPROACTV(NBUDGET_TH, IPROC)  = N2DADVTH
    
      IPROC=IPROC+1
    
      IF( L2D_REL_FRC ) IPROACTV(NBUDGET_TH, IPROC)  = N2DRELTH
    
      IPROC=IPROC+1
    
      IF( ONUDGING ) IPROACTV(NBUDGET_TH, IPROC)  = NNUDTH
    
      IPROC=IPROC+1
      IF ( KRR > 0 ) THEN
    
        IF(.NOT.L1D) IPROACTV(NBUDGET_TH, IPROC) = NPREFTH
    
      END IF
      IPROC=IPROC+1
    
      IF ( ONUMDIFTH ) IPROACTV(NBUDGET_TH, IPROC) = NDIFTH
    
      IPROC=IPROC+1
      IF ( OHORELAX_UVWTH .OR. OVE_RELAX ) THEN   
    
      ELSE
        IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR.                 &
         OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR.   &
         OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
    
        END IF
      END IF
      IPROC=IPROC+1
    
      IF ( HRAD /= 'NONE' ) IPROACTV(NBUDGET_TH, IPROC) = NRADTH
    
      IPROC=IPROC+1
    
      IF ( HDCONV /= 'NONE' .OR. HSCONV == 'KAFR') IPROACTV(NBUDGET_TH, IPROC) = NDCONVTH
    
      IPROC=IPROC+1
    
      IF ( HTURB /= 'NONE' ) IPROACTV(NBUDGET_TH, IPROC) = NVTURBTH
    
      IPROC=IPROC+1
      IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
    
      ELSE
        IF ( HTURB /= 'NONE' ) THEN
    
        END IF
      END IF 
      IPROC=IPROC+1
    
      IF (HTURB /= 'NONE')     IPROACTV(NBUDGET_TH, IPROC) = NDISSHTH
    
      IPROC=IPROC+1
    
      IF (HTURB /= 'NONE' .AND. ( (HCLOUD == 'KHKO') .OR.  (HCLOUD == 'C2R2'))) &
    
      IF ( HSCONV == 'EDKF' ) IPROACTV(NBUDGET_TH, IPROC) = NMAFLTH
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IF ((HCLOUD == 'KHKO')  .OR.  (HCLOUD == 'C2R2'))  IPROACTV(NBUDGET_TH, IPROC) = NNEADVTH
    
      IPROC=IPROC+1
      IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'KHKO' .AND. HCLOUD /= 'C2R2') &
    
      IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
      IF (HCLOUD == 'LIMA') THEN
    
         IF (OPTSPLIT)                                           IPROACTV(NBUDGET_TH, IPROC) = NSEDITH
    
         IF (OWARM .AND. OACTI .AND. NMOD_CCN.GE.1)              IPROACTV(NBUDGET_TH, IPROC) = NHENUTH
    
         IPROC=IPROC+1
         IF (.NOT.OPTSPLIT) THEN
    
            IF (OWARM .AND. ORAIN)                               IPROACTV(NBUDGET_TH, IPROC) = NREVATH
    
         IF (OCOLD .AND. ONUCL)                                  IPROACTV(NBUDGET_TH, IPROC) = NHINDTH
    
         IF (OCOLD .AND. ONUCL)                                  IPROACTV(NBUDGET_TH, IPROC) = NHINCTH
    
         IF (OCOLD .AND. ONUCL .AND. OHHONI .AND. NMOD_CCN.GE.1) IPROACTV(NBUDGET_TH, IPROC) = NHONHTH
    
         IPROC=IPROC+1
         IF (OPTSPLIT) THEN
    
         IF (OCOLD .AND. OWARM .AND. ONUCL)                      IPROACTV(NBUDGET_TH, IPROC) = NHONCTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ONUCL .AND. ORAIN))      IPROACTV(NBUDGET_TH, IPROC) = NHONRTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW))                  IPROACTV(NBUDGET_TH, IPROC) = NDEPSTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW))      IPROACTV(NBUDGET_TH, IPROC) = NDEPGTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM))                  IPROACTV(NBUDGET_TH, IPROC) = NIMLTTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM))                  IPROACTV(NBUDGET_TH, IPROC) = NBERFITH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW))      IPROACTV(NBUDGET_TH, IPROC) = NRIMTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW .AND. ORAIN))      IPROACTV(NBUDGET_TH, IPROC) = NACCTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW))      IPROACTV(NBUDGET_TH, IPROC) = NCFRZTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW))      IPROACTV(NBUDGET_TH, IPROC) = NWETGTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW))      IPROACTV(NBUDGET_TH, IPROC) = NDRYGTH
    
         IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW))      IPROACTV(NBUDGET_TH, IPROC) = NGMLTTH
    
         IF (.NOT.OPTSPLIT .AND. OHAIL)                          IPROACTV(NBUDGET_TH, IPROC) = NWETHTH
    
         IF (.NOT.OPTSPLIT .AND. OHAIL)                          IPROACTV(NBUDGET_TH, IPROC) = NHMLTTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
      ELSE
    
        IF (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LADJ_BEFORE) IPROACTV(NBUDGET_TH, IPROC) = NADJUTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
        IF (HCLOUD(1:3) == 'ICE' .OR. (HCLOUD == 'C2R2' .AND. (.NOT. LSUPSAT)) &
    
              .OR. ( HCLOUD == 'KHKO' .AND. (.NOT. LSUPSAT)) ) &
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NHONTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NSFRTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NDEPSTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NDEPGTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
          IF (((HCLOUD(1:3) == 'ICE') .AND. LWARM) .OR. ((HCLOUD == 'C2R2' &
             .OR. HCLOUD == 'KHKO') .AND. LRAIN) .OR. HCLOUD(1:3) == 'KES')             &
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NRIMTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NACCTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NCFRZTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NWETGTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NDRYGTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NGMLTTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD == 'ICE4') IPROACTV(NBUDGET_TH, IPROC) = NWETHTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD == 'ICE4'.AND. LRED) IPROACTV(NBUDGET_TH, IPROC) = NDRYHTH
    
          IF (HCLOUD == 'ICE4') IPROACTV(NBUDGET_TH, IPROC) = NHMLTTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NIMLTTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE') IPROACTV(NBUDGET_TH, IPROC) = NBERFITH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF (HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(NBUDGET_TH, IPROC) = NCORRTH
    
          IPROC=IPROC+1
          IF (HCLOUD(1:3) == 'ICE' .AND. .NOT. LRED .OR. (LRED .AND. LADJ_AFTER)) &
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
          IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' .OR. HCLOUD(1:3) == 'KES' .OR.   &
    
          HCLOUD == 'REVE')   IPROACTV(NBUDGET_TH, IPROC) = NCONDTH
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
          IPROC=IPROC+1
    
          IF ((HCLOUD == 'KHKO')  .OR.  (HCLOUD == 'C2R2'))&
    
      YWORK2(NBUDGET_TH, 1) = 'INIF_'
      YWORK2(NBUDGET_TH, 2) = 'ENDF_'
      YWORK2(NBUDGET_TH, 3) = 'AVEF_'
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
      IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
    
      IF (HCLOUD == 'LIMA') THEN
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
         IF (.NOT.OPTSPLIT) THEN
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
         IF (OPTSPLIT) THEN
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
      ELSE
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
         IPROC=IPROC+1