Changeset 2056

LMDZ5/branches/testing

Property svn:mergeinfo changed
/LMDZ5/trunk merged: 1998,2000-2023,2025-2029,2032,2034,2036-2049,2051-2055

LMDZ5/branches/testing/DefLists/iodef.xml

-                      r1910
+                      r2056
 <?xml version="1.0"?>
 <simulation>
-        <context id="LMDZ" calendar_type="D360" start_date="1980-01-01 00:00:00">
-                <!-- Définition des variables -->
-                <field_definition src="./iodef_fields.xml"/>
-                <!-- Définition des fichiers de sortie
-                Chaque fichier contient la liste de toutes les variables
-                et leur niveau de sortie pour ce fichier, afin de coller
-                à l'utilisation des niveaux de sortie que fait LMDZ. -->
-                <file_definition src="./iodef_file_histday.xml"/>
-                <file_definition src="./iodef_file_histhf.xml"/>
-                <file_definition src="./iodef_file_histins.xml"/>
-                <file_definition src="./iodef_file_histLES.xml"/>
-                <file_definition src="./iodef_file_histmth.xml"/>
-                <file_definition src="./iodef_file_histstn.xml"/>
-                <!-- Définition des domaines et groupes de domaines -->
-                <domain_definition>
-                        <domain id="dom_glo" data_dim="2" />
-                </domain_definition>
-                <!-- Définition des groupes d'axes verticaux
-                (LMDZ va ensuite déclarer dans chaque groupe un axe différent par fichier) -->
-                <axis_definition>
-                        <axis_group id="presnivs" standard_name="Vertical levels" unit="Pa">
-                        </axis_group>
-                        <axis_group id="Ahyb" standard_name="Ahyb comp of Hyb Cord" unit="Pa">
-                        </axis_group>
-                        <axis_group id="Bhyb" standard_name="Bhyb comp of Hyb Cord" unit="">
-                        </axis_group>
-                        <axis_group id="Alt" standard_name="Height approx for scale heigh of 8km at levels" unit="Km">
-                        </axis_group>
-                </axis_definition>
-        </context>
         <context  id="xios">
 …
                 </variable_definition>
         </context>
+        <context id="LMDZ" src="./context_lmdz.xml"/>
 </simulation>

LMDZ5/branches/testing/DefLists/iodef_dev.xml

-                      r1910
+                      r2056
 <simulation>
     <context id="LMDZ" calendar_type="D360" start_date="1980-01-01 00:00:00">
+        <!-- Définition des variables -->
+        <field_definition prec="4" operation="average" freq_op="1ts" enabled=".TRUE.">
+        <!-- Definition of model variables -->
+        <field_definition prec="4"
+                          freq_op="1ts"
+                          enabled=".TRUE.">
+            <!-- 2D variables -->
             <field_group id="fields_2D" domain_ref="dom_glo">
                 <field id="u"           long_name="Eastward Zonal Wind"                 unit="m/s" />
                 <field id="v"           long_name="Northward Meridional Wind"           unit="m/s" />
                 <field id="ps"          long_name="Surface Pressure"                    unit="m/s" />
+                <field id="ps"
+                       long_name="Surface Pressure"
+                       unit="m/s" />
             </field_group>
+            <field_group id="fields_3D" domain_ref="dom_glo">
+                <field id="temperature" long_name="Atmospheric temperature"             unit="K" />
+            <!-- 3D variables -->
+            <field_group id="fields_3D"
+                         domain_ref="dom_glo">
+                <field id="temperature"
+                       long_name="Atmospheric temperature"
+                       unit="K" />
+                <field id="temp_newton"
+                       long_name="Relaxation temperature"
+                       unit="K" />
+                <field id="u"
+                       long_name="Eastward Zonal Wind"
+                       unit="m/s" />
+                <field id="v"
+                       long_name="Northward Meridional Wind"
+                       unit="m/s" />
             </field_group>
         </field_definition>
         <!-- Définition des fichiers de sortie -->
+        <!-- Définition of output files -->
         <file_definition>
+            <file_group id="defile">
+                <file id="histins" name="Xhistins" output_freq="1ts" enabled=".TRUE.">
+            <!-- <file_group id="defile"> -->
+                <file id="histins"
+                      name="Xhistins"
+                      output_freq="12ts"
+                      enabled=".TRUE."> <!-- NB: output_freq in physics ts-->
                     <!-- VARS 2D -->
+                    <field_group operation="instant" freq_op="1ts">
+                    <field_group operation="instant"
+                                 freq_op="1ts">
                         <field field_ref="ps" />
                     </field_group>
+                    <!-- <field_group field_group_ref="fields_2D"
+                                 operation="instant" /> doesn't work ?!? -->
                     <!-- VARS 3D -->
+                    <field_group operation="instant" freq_op="1ts" axis_ref="presnivs_histins">
+                    <field_group operation="instant"
+                                 freq_op="1ts"
+                                 axis_ref="presnivs">
+                        <field field_ref="temperature" />
+                        <field field_ref="temp_newton" operation="once" />
+                        <field field_ref="u" />
+                        <field field_ref="v" />
+                    </field_group>
+                    <!-- <field_group field_group_ref="fields_3D"
+                                 operation="instant" /> doesn't work ?!? -->
+                </file>
+                <file id="diurnalave"
+                      name="Xdiurnalave"
+                      output_freq="1d"
+                      enabled=".true.">
+                    <!-- VARS 2D -->
+                    <field_group operation="average"
+                                 freq_op="1ts">
+                        <field field_ref="ps" />
+                    </field_group>
+                    <!-- VARS 3D -->
+                    <field_group operation="average"
+                                 freq_op="1ts"
+                                 axis_ref="presnivs">
                         <field field_ref="temperature" />
                         <field field_ref="u" />
                         <field field_ref="v" />
                     </field_group>
+                    </field_group>
                 </file>
             </file_group>
+            <!-- </file_group> -->
         </file_definition>
+        <!-- Définition des domaines et groupes de domaines -->
+        <!-- Definition of domains and groups of domains -->
         <domain_definition>
             <domain id="dom_glo" data_dim="2" />
         </domain_definition>
+        <!-- Définition des axes verticaux -->
+        <!-- Definition of vertical axes
+             NB: these must be defined and set in code via
+             wxios_add_vaxis -->
         <axis_definition>
+            <axis_group id="presnivs" standard_name="Vertical levels" unit="Pa">
+            <!--
+            <axis_group id="presnivs"
+                        standard_name="Pseudo-pressure of model vertical levels"
+                        unit="Pa">
             </axis_group>
+            <axis_group id="Ahyb" standard_name="Ahyb comp of Hyb Cord" unit="Pa">
+            </axis_group>
+            <axis_group id="Bhyb" standard_name="Bhyb comp of Hyb Cord" unit="">
+            </axis_group>
+            <axis_group id="Alt" standard_name="Height approx for scale heigh of 8km at levels" unit="Km">
+            </axis_group>
+            -->
+            <axis id="presnivs"
+                        standard_name="Pseudo-pressure of model vertical levels"
+                        unit="Pa">
+            </axis>
         </axis_definition>
     </context>
 …
             <variable_group id="parameters" >
                 <variable id="using_server" type="boolean">true</variable>
                 <variable id="info_level" type="int">100</variable>
+                <variable id="info_level" type="int">10</variable>
             </variable_group>
         </variable_definition>

LMDZ5/branches/testing/create_make_gcm

-                      r1999
+                      r2056
 echo "LOCAL_DIR=`echo $localdir`"
 echo 'BIBIO    = $(LIBF)/bibio'
-echo 'DYN3D_COMMON   = $(LIBF)/dyn3d_common'
 echo "FILTRE   = filtre"
 echo "PHYS  = "
-echo "DYN  = dyn "
 echo 'LIBPHY = $(LIBO)/libphy$(PHYS).a'
 echo 'DIRMAIN=dyn$(DIM)d$(FLAG_PARA)'
 …
 echo
 echo '# Les differentes librairies pour l"edition des liens:'
+echo
+echo 'dyn3d            = $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a'
+echo 'dyn3dpar      = $(LIBO)/libdyn3dpar.a $(LIBO)/lib$(FILTRE).a'
+echo 'dyn2d            = $(LIBO)/libdyn2d.a'
+echo 'dyn1d            = $(LIBO)/libdyn1d.a'
+echo 'L_DYN      = -ldyn$(DIM)d$(FLAG_PARA)'
+echo 'L_DYN      = -ldyn$(DIM)d$(FLAG_PARA) -ldyn3d_common'
 echo 'L_FILTRE   = -l$(FILTRE)'
 echo 'L_PHY = -lphy$(PHYS) '
 echo 'L_BIBIO    = -lbibio'
-echo 'L_DYN3D_COMMON    = -ldyn3d_common'
 echo 'L_ADJNT    ='
 echo 'L_COSP     = -lcosp'
 …
 echo
 echo "PROG = code"
+echo 'DYN  = dyn$(DIM)d'
 echo
 #echo 'main : chimie $(DYN) bibio phys $(OPTION_DEP) '
 echo 'main : $(DYN) bibio dyn3d_common phys $(OPTION_DEP) '
+echo 'main : $(DYN) bibio phys $(OPTION_DEP) '
 echo '  cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
 echo '  cd $(LOCAL_DIR); \'
 …
 echo '  $(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_COSP) $(L_PHY) $(L_DYN) $(L_DYN3D_COMMON) $(L_BIBIO) $(L_DYN3D_COMMON) $(L_PHY) $(L_DYN) $(L_FILTRE) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
 echo
-echo 'dyn : $(LIBO)/libdyn$(DIM)d$(FLAG_PARA).a $(FILTRE)$(DIM)d'
-echo
 echo 'phys : $(LIBPHY)'
+echo 'dyn3d : $(LIBO)/libdyn$(DIM)d$(FLAG_PARA).a $(LIBO)/lib$(FILTRE).a $(LIBO)/libdyn3d_common.a'
+echo 'dyn2d : $(LIBO)/libdyn2d.a'
+echo 'dyn1d :'
+echo
 echo
 #echo 'chimie : $(LIBO)/libchimie.a'
 echo
 echo 'bibio : $(LIBO)/libbibio.a'
-echo
-echo 'dyn3d_common : $(LIBO)/libdyn3d_common.a'
 echo
 echo 'adjnt : $(LIBO)/libadjnt.a'

LMDZ5/branches/testing/libf/bibio/wxios.F90

-                      r1910
+                      r2056
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !   str + i   =>   str_i   !!!!!!!!!!!!!!!!!!!!
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    SUBROUTINE concat(str, str2, str_str2)
-        CHARACTER(len=*), INTENT(IN) :: str, str2
-        CHARACTER(len=20), INTENT(OUT) :: str_str2
-        str_str2 = TRIM(ADJUSTL(str//"_"//TRIM(ADJUSTL(str2))))
-        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ",str,"+",str2,"=",str_str2
-    END SUBROUTINE concat
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !   36day => 36d etc     !!!!!!!!!!!!!!!!!!!!
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 …
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     SUBROUTINE wxios_init(xios_ctx_name, locom, outcom)
+    SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
         IMPLICIT NONE
         INCLUDE 'iniprint.h'
 …
       INTEGER, INTENT(IN), OPTIONAL :: locom
       INTEGER, INTENT(OUT), OPTIONAL :: outcom
+      CHARACTER(len=6), INTENT(IN), OPTIONAL :: type_ocean
 …
         g_ctx_name = xios_ctx_name
+        CALL wxios_context_init()
+        ! Si couple alors init fait dans cpl_init
+        IF (.not. PRESENT(type_ocean)) THEN
+            CALL wxios_context_init()
+        ENDIF
     END SUBROUTINE wxios_init
 …
         g_ctx = xios_ctx
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
+        IF (prt_level >= 10) THEN
+          WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
+          WRITE(lunout,*) "     now call xios_solve_inheritance()"
+        ENDIF
         !Une première analyse des héritages:
         CALL xios_solve_inheritance()
 …
     ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     SUBROUTINE wxios_add_vaxis(axisgroup_id, axis_file, axis_size, axis_value)
         IMPLICIT NONE
         INCLUDE 'iniprint.h'
         CHARACTER (len=*), INTENT(IN) :: axisgroup_id, axis_file
+    SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value)
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+        CHARACTER (len=*), INTENT(IN) :: axis_id
         INTEGER, INTENT(IN) :: axis_size
         REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
+        TYPE(xios_axisgroup) :: axgroup
+        TYPE(xios_axis) :: ax
+        CHARACTER(len=20) :: axis_id
+        !Préparation du nom de l'axe:
+        CALL concat(axisgroup_id, axis_file, axis_id)
+!        TYPE(xios_axisgroup) :: axgroup
+!        TYPE(xios_axis) :: ax
+!        CHARACTER(len=50) :: axis_id
+!        IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
+!          WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
+!          WRITE(lunout,*) "     increase it to at least ",len_trim(axisgroup_id)
+!          CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
+!        ENDIF
+!        axis_id=trim(axisgroup_id)
         !On récupère le groupe d'axes qui va bien:
         CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
+        !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
         !On ajoute l'axe correspondant à ce fichier:
         CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
+        !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
         !Et on le parametrise:
+        CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
+        !CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
+        ! Ehouarn: New way to declare axis, without axis_group:
+        CALL xios_set_axis_attr(trim(axis_id),size=axis_size,value=axis_value)
         !Vérification:
 …
             IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
         ELSE
             WRITE(*,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
+            WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
         END IF
 …
             IF (xios_is_valid_file("X"//fname)) THEN
+                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
+                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
+                IF (prt_level >= 10) THEN
+                  WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
+                  WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
+                ENDIF
             ELSE
                 WRITE(*,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
                 WRITE(*,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
+                WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
+                WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
             END IF
         ELSE
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
+                CALL xios_set_file_attr(fname, enabled=.TRUE.)
+            IF (prt_level >= 10) THEN
+              WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
+            ENDIF
+            ! Ehouarn: add an enable=.true. on top of xml definitions... why???
+            CALL xios_set_file_attr(fname, enabled=.TRUE.)
         END IF
     END SUBROUTINE wxios_add_file
 …
         CHARACTER(len=*), INTENT(IN) :: op
         CHARACTER(len=20) :: axis_id
+        CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
         CHARACTER(len=100) :: operation
         TYPE(xios_file) :: f
 …
+        !Préparation du nom de l'axe:
+        CALL concat("presnivs", fname, axis_id)
+        ! Ajout Abd pour NMC:
+        IF (fid.LE.6) THEN
+          axis_id="presnivs"
+        ELSE
+          axis_id="plev"
+        ENDIF
         !on prépare le nom de l'opération:
 …
         !On selectionne le bon groupe de champs:
         IF (fdim.EQ.2) THEN
             CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
+          CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
         ELSE
           CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
 …
             !Sinon on se contente de l'activer:
             CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
+            !NB: This will override an enable=.false. set by a user in the xml file;
+            !   then the only way to not output the field is by changing its
+            !   output level
         ENDIF
     END SUBROUTINE wxios_add_field_to_file
     SUBROUTINE wxios_update_calendar(ito)
         INTEGER, INTENT(IN) :: ito
         CALL xios_update_calendar(ito)
     END SUBROUTINE wxios_update_calendar
     SUBROUTINE wxios_write_2D(fieldname, fdata)
         CHARACTER(len=*), INTENT(IN) :: fieldname
         REAL, DIMENSION(:,:), INTENT(IN) :: fdata
         CALL xios_send_field(fieldname, fdata)
     END SUBROUTINE wxios_write_2D
     SUBROUTINE wxios_write_3D(fieldname, fdata)
         CHARACTER(len=*), INTENT(IN) :: fieldname
         REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
         CALL xios_send_field(fieldname, fdata)
     END SUBROUTINE wxios_write_3D
+!    SUBROUTINE wxios_update_calendar(ito)
+!        INTEGER, INTENT(IN) :: ito
+!        CALL xios_update_calendar(ito)
+!    END SUBROUTINE wxios_update_calendar
+!
+!    SUBROUTINE wxios_write_2D(fieldname, fdata)
+!        CHARACTER(len=*), INTENT(IN) :: fieldname
+!        REAL, DIMENSION(:,:), INTENT(IN) :: fdata
+!
+!        CALL xios_send_field(fieldname, fdata)
+!    END SUBROUTINE wxios_write_2D
+!    SUBROUTINE wxios_write_3D(fieldname, fdata)
+!        CHARACTER(len=*), INTENT(IN) :: fieldname
+!        REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
+!
+!        CALL xios_send_field(fieldname, fdata)
+!    END SUBROUTINE wxios_write_3D
     SUBROUTINE wxios_closedef()

LMDZ5/branches/testing/libf/dyn3d/calfis.F

-                      r1999
+                      r2056
       REAL unskap, pksurcp
+c
-cIM diagnostique PVteta, Amip2
-      INTEGER,PARAMETER :: ntetaSTD=3
-      REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !!
-      REAL PVteta(ngridmx,ntetaSTD)
+c
       REAL flxwfi(ngridmx,llm)  ! Flux de masse verticale sur la grille physiq
+c
 …
       ENDDO
+c
-      if (planet_type=="earth") then
-#ifdef CPP_PHYS
-! PVtheta calls tetalevel, which is in the physics
-cIM calcul PV a teta=350, 380, 405K
-      CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
-     $           ztfi,zplay,zplev,
-     $           ntetaSTD,rtetaSTD,PVteta)
-#endif
-      endif
+c
 c On change de grille, dynamique vers physiq, pour le flux de masse verticale
 …
      .             zdqfi,
      .             zdpsrf,
+cIM diagnostique PVteta, Amip2
+     .             pducov,
+     .             PVteta)
+     .             pducov)
       else if ( planet_type=="generic" ) then

LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F

-                      r1999
+                      r2056
 ! $Id$
+!
+c
+c
+!
+!
       SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
+c
+!
       USE control_mod
 #ifdef CPP_IOIPSL
 …
       IMPLICIT NONE
 c-----------------------------------------------------------------------
 c     Auteurs :   L. Fairhead , P. Le Van  .
+c
 c     Arguments :
+c
 c     tapedef   :
 c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
 c     -metres  du zoom  avec  celles lues sur le fichier start .
 c      clesphy0 :  sortie  .
+c
+!-----------------------------------------------------------------------
+!     Auteurs :   L. Fairhead , P. Le Van  .
+!
+!     Arguments :
+!
+!     tapedef   :
+!     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
+!     -metres  du zoom  avec  celles lues sur le fichier start .
+!      clesphy0 :  sortie  .
+!
        LOGICAL etatinit
        INTEGER tapedef
 …
        PARAMETER(     longcles = 20 )
        REAL clesphy0( longcles )
+c
 c   Declarations :
 c   --------------
+!
+!   Declarations :
+!   --------------
 #include "dimensions.h"
 #include "paramet.h"
 …
 ! #include "clesphys.h"
 #include "iniprint.h"
+c
+c
 c   local:
 c   ------
+!
+!
+!   local:
+!   ------
       CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
 …
       INTEGER i
       LOGICAL use_filtre_fft
+c
 c  -------------------------------------------------------------------
+c
 c       .........     Version  du 29/04/97       ..........
+c
 c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
 c      tetatemp   ajoutes  pour la dissipation   .
+c
 c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
+c
 c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
 c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
+c
 c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
 c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
 c                de limit.dat ( dic)                        ...........
 c           Sinon  etatinit = . FALSE .
+c
 c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
 c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
 c   celles passees  par run.def ,  au debut du gcm, apres l'appel a
 c    lectba .
 c   Ces parmetres definissant entre autres la grille et doivent etre
 c   pareils et coherents , sinon il y aura  divergence du gcm .
+c
 c-----------------------------------------------------------------------
 c   initialisations:
 c   ----------------
+!
+!  -------------------------------------------------------------------
+!
+!       .........     Version  du 29/04/97       ..........
+!
+!   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
+!      tetatemp   ajoutes  pour la dissipation   .
+!
+!   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
+!
+!  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
+!    Sinon , choix de fxynew  , a derivee sinusoidale  ..
+!
+!   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
+!         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
+!                de limit.dat ( dic)                        ...........
+!           Sinon  etatinit = . FALSE .
+!
+!   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
+!    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
+!   celles passees  par run.def ,  au debut du gcm, apres l'appel a
+!    lectba .
+!   Ces parmetres definissant entre autres la grille et doivent etre
+!   pareils et coherents , sinon il y aura  divergence du gcm .
+!
+!-----------------------------------------------------------------------
+!   initialisations:
+!   ----------------
 !Config  Key  = lunout
 …
       CALL getin('lunout', lunout)
       IF (lunout /= 5 .and. lunout /= 6) THEN
         OPEN(UNIT=lunout,FILE='lmdz.out',ACTION='write',
+        OPEN(UNIT=lunout,FILE='lmdz.out',ACTION='write',                     &
      &          STATUS='unknown',FORM='formatted')
       ENDIF
 …
       CALL getin('prt_level',prt_level)
 c-----------------------------------------------------------------------
 c  Parametres de controle du run:
 c-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!  Parametres de controle du run:
+!-----------------------------------------------------------------------
 !Config  Key  = planet_type
 !Config  Desc = planet type ("earth", "mars", "venus", ...)
 …
        CALL getin('dissip_period',dissip_period)
 ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
 ccc
+!cc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
+!cc
 !Config  Key  = lstardis
 …
        CALL getin('ok_guide',ok_guide)
 c    ...............................................................
+!    ...............................................................
 !Config  Key  =  read_start
 …
       ENDDO
 ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
 c     .........   (  modif  le 17/04/96 )   .........
+c
+!cc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
+!     .........   (  modif  le 17/04/96 )   .........
+!
       IF( etatinit ) GO TO 100
 …
        CALL getin('clat',clatt)
+c
+c
+!
+!
       IF( ABS(clat - clatt).GE. 0.001 )  THEN
         write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',
+        write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',     &
      &    ' est differente de celle lue sur le fichier  start '
         STOP
 …
       IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
         write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',
+        write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',       &
      &  'run.def est differente de celle lue sur le fichier  start '
         STOP
 …
       IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
         write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',
+        write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',        &
      & 'run.def est differente de celle lue sur le fichier  start '
         STOP
 …
       IF( grossismx.LT.1. )  THEN
         write(lunout,*)
+        write(lunout,*)                                                        &
      &       'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
          STOP
 …
       IF( grossismy.LT.1. )  THEN
         write(lunout,*)
+        write(lunout,*)                                                        &
      &       'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
          STOP
 …
       write(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
+c
 c    alphax et alphay sont les anciennes formulat. des grossissements
+c
+c
+!
+!    alphax et alphay sont les anciennes formulat. des grossissements
+!
+!
 !Config  Key  = fxyhypb
 …
          IF( fxyhypbb )     THEN
             write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
             write(lunout,*)' *** fxyhypb lu sur le fichier start est ',
      *       'F alors  qu il est  T  sur  run.def  ***'
+            write(lunout,*)' *** fxyhypb lu sur le fichier start est ',     &
+     &       'F alors  qu il est  T  sur  run.def  ***'
               STOP
          ENDIF
 …
          IF( .NOT.fxyhypbb )   THEN
             write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
             write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',
      *        'T alors  qu il est  F  sur  run.def  ****  '
+            write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',     &
+     &        'T alors  qu il est  F  sur  run.def  ****  '
               STOP
          ENDIF
       ENDIF
+c
+!
 !Config  Key  = dzoomx
 !Config  Desc = extension en longitude
 …
       IF( fxyhypb )  THEN
        IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
         write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',
      *  'run.def est differente de celle lue sur le fichier  start '
+        write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',         &
+     &  'run.def est differente de celle lue sur le fichier  start '
         STOP
        ENDIF
 …
       IF( fxyhypb )  THEN
        IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
         write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',
      * 'run.def est differente de celle lue sur le fichier  start '
+        write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',          &
+     & 'run.def est differente de celle lue sur le fichier  start '
         STOP
        ENDIF
 …
       IF( fxyhypb )  THEN
        IF( ABS(taux - tauxx).GE. 0.001 )  THEN
         write(lunout,*)'conf_gcm: La valeur de taux passee par ',
      * 'run.def est differente de celle lue sur le fichier  start '
+        write(lunout,*)'conf_gcm: La valeur de taux passee par ',           &
+     & 'run.def est differente de celle lue sur le fichier  start '
         STOP
        ENDIF
 …
       IF( fxyhypb )  THEN
        IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
         write(lunout,*)'conf_gcm: La valeur de tauy passee par ',
      * 'run.def est differente de celle lue sur le fichier  start '
+        write(lunout,*)'conf_gcm: La valeur de tauy passee par ',           &
+     & 'run.def est differente de celle lue sur le fichier  start '
         STOP
        ENDIF
       ENDIF
 cc
+!c
       IF( .NOT.fxyhypb  )  THEN
 …
           IF( ysinuss )     THEN
             write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
             write(lunout,*)' *** ysinus lu sur le fichier start est F',
      *       ' alors  qu il est  T  sur  run.def  ***'
+            write(lunout,*)' *** ysinus lu sur le fichier start est F',     &
+     &       ' alors  qu il est  T  sur  run.def  ***'
             STOP
           ENDIF
 …
           IF( .NOT.ysinuss )   THEN
             write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
             write(lunout,*)' *** ysinus lu sur le fichier start est T',
      *        ' alors  qu il est  F  sur  run.def  ****  '
+            write(lunout,*)' *** ysinus lu sur le fichier start est T',     &
+     &        ' alors  qu il est  F  sur  run.def  ****  '
               STOP
           ENDIF
         ENDIF
       ENDIF ! of IF( .NOT.fxyhypb  )
+c
+!
 !Config  Key  = offline
 !Config  Desc = Nouvelle eau liquide
 …
       RETURN
 c   ...............................................
+c
+!   ...............................................
+!
    CONTINUE
 !Config  Key  = clon
 …
       IF( grossismx.LT.1. )  THEN
+        write(lunout,*)
+     &   'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
+        write(lunout,*)'conf_gcm: ***ATTENTION !! grossismx < 1 . *** '
          STOP
       ELSE
 …
       IF( grossismy.LT.1. )  THEN
+        write(lunout,*)
+     &  'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
+        write(lunout,*) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** '
          STOP
       ELSE
 …
       write(lunout,*)'conf_gcm: alphax alphay ',alphax,alphay
+c
 c    alphax et alphay sont les anciennes formulat. des grossissements
+c
+c
+!
+!    alphax et alphay sont les anciennes formulat. des grossissements
+!
+!
 !Config  Key  = fxyhypb
 …
        ysinus = .TRUE.
        CALL getin('ysinus',ysinus)
+c
+!
 !Config  Key  = offline
 !Config  Desc = Nouvelle eau liquide
 …
       vert_prof_dissip = merge(1, 0, ok_strato .and. llm==39)
       CALL getin('vert_prof_dissip', vert_prof_dissip)
       call assert(vert_prof_dissip == 0 .or. vert_prof_dissip ==  1,
      $     "bad value for vert_prof_dissip")
+      call assert(vert_prof_dissip == 0 .or. vert_prof_dissip ==  1,        &
+     &     "bad value for vert_prof_dissip")
 !Config  Key  = ok_gradsfile
 …
       write(lunout,*)' #########################################'
       write(lunout,*)' Configuration des parametres de cel0'
+      write(lunout,*)' Configuration des parametres de cel0'                &
      &             //'_limit: '
       write(lunout,*)' planet_type = ', planet_type
 …
       write(lunout,*)' ok_limit = ', ok_limit
       write(lunout,*)' ok_etat0 = ', ok_etat0
+c
+!
       RETURN
       END

LMDZ5/branches/testing/libf/dyn3d/gcm.F

-                      r1999
+                      r2056
       REAL ps(ip1jmp1)                       ! pression  au sol
       REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
-      REAL pks(ip1jmp1)                      ! exner au  sol
-      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
-      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
       REAL masse(ip1jmp1,llm)                ! masse d'air
       REAL phis(ip1jmp1)                     ! geopotentiel au sol
 …
       data call_iniphys/.true./
-      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
 c+jld variables test conservation energie
 c      REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
 …
+      day_end = day_ini + nday
+      if (nday>=0) then
+         day_end = day_ini + nday
+      else
+         day_end = day_ini - nday/day_step
+      endif
       WRITE(lunout,300)day_ini,day_end
   FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)

LMDZ5/branches/testing/libf/dyn3d/guide_mod.F90

-                      r2024
+                      r2056
   SUBROUTINE guide_interp(psi,teta)
+  use exner_hyb_m, only: exner_hyb
+  use exner_milieu_m, only: exner_milieu
   IMPLICIT NONE
 …
   REAL, DIMENSION (iip1,jjm,llm)     :: pbary
   ! Variables pour fonction Exner (P milieu couche)
+  REAL, DIMENSION (iip1,jjp1,llm)    :: pk, pkf
+  REAL, DIMENSION (iip1,jjp1,llm)    :: alpha, beta
+  REAL, DIMENSION (iip1,jjp1,llm)    :: pk
   REAL, DIMENSION (iip1,jjp1)        :: pks
   REAL                               :: prefkap,unskap
 …
     CALL pression( ip1jmp1, ap, bp, psi, p )
     if (pressure_exner) then
       CALL exner_hyb(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
+      CALL exner_hyb(ip1jmp1,psi,p,pks,pk)
     else
       CALL exner_milieu(ip1jmp1,psi,p,beta,pks,pk,pkf)
+      CALL exner_milieu(ip1jmp1,psi,p,pks,pk)
     endif
 !    ....  Calcul de pls , pression au milieu des couches ,en Pascals

LMDZ5/branches/testing/libf/dyn3d/iniacademic.F90

-                      r1910
+                      r2056
 #endif
   USE Write_Field
+  use exner_hyb_m, only: exner_hyb
+  use exner_milieu_m, only: exner_milieu
   !   Author:    Frederic Hourdin      original: 15/01/93
 …
   REAL pks(ip1jmp1)                      ! exner au  sol
   REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
-  REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
   REAL phi(ip1jmp1,llm)                  ! geopotentiel
   REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
 …
   integer idum
   REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
+  REAL zdtvr
   character(len=*),parameter :: modname="iniacademic"
 …
         CALL pression ( ip1jmp1, ap, bp, ps, p       )
         if (pressure_exner) then
           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
         else
           call exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
+          CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
+        else
+          call exner_milieu(ip1jmp1,ps,p,pks,pk)
         endif
         CALL massdair(p,masse)

LMDZ5/branches/testing/libf/dyn3d/leapfrog.F

-                      r1999
+                      r2056
      &                       iecri, ip_ebil_dyn, ok_dynzon, ok_dyn_ins,
      &                       periodav, ok_dyn_ave, output_grads_dyn
+      use exner_hyb_m, only: exner_hyb
+      use exner_milieu_m, only: exner_milieu
       IMPLICIT NONE
 …
       character*10 string10
-      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
       REAL :: flxw(ip1jmp1,llm)  ! flux de masse verticale
 …
+      itaufin   = nday*day_step
+      if (nday>=0) then
+         itaufin   = nday*day_step
+      else
+         itaufin   = -nday
+      endif
       itaufinp1 = itaufin +1
       itau = 0
 …
       CALL pression ( ip1jmp1, ap, bp, ps, p       )
       if (pressure_exner) then
         CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+        CALL exner_hyb( ip1jmp1, ps, p, pks, pk, pkf )
       else
         CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
+        CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
       endif
 …
          CALL pression (  ip1jmp1, ap, bp, ps,  p      )
          if (pressure_exner) then
            CALL exner_hyb(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
+           CALL exner_hyb(  ip1jmp1, ps, p,pks, pk, pkf )
          else
            CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
+           CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
          endif
+! Appel a geopot ajoute le 2014/05/08 pour garantir la convergence numerique
+! avec dyn3dmem
+         CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
 !           rdaym_ini  = itau * dtvr / daysec
 …
           CALL massdair(p,masse)
           if (pressure_exner) then
             CALL exner_hyb(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
+            CALL exner_hyb(ip1jmp1,ps,p,pks,pk,pkf)
           else
             CALL exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
+            CALL exner_milieu(ip1jmp1,ps,p,pks,pk,pkf)
           endif
 …
         CALL pression ( ip1jmp1, ap, bp, ps, p                  )
         if (pressure_exner) then
           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+          CALL exner_hyb( ip1jmp1, ps, p, pks, pk, pkf )
         else
           CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
+          CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
         endif
         CALL massdair(p,masse)

LMDZ5/branches/testing/libf/dyn3d_common/disvert.F90

-                      r1999
+                      r2056
 ! $Id$
+SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig,scaleheight)
+  ! Auteur : P. Le Van
+SUBROUTINE disvert()
+#ifdef CPP_IOIPSL
+  use ioipsl, only: getin
+#else
+  USE ioipsl_getincom, only: getin
+#endif
   use new_unit_m, only: new_unit
-  use ioipsl, only: getin
   use assert_m, only: assert
 …
   include "dimensions.h"
   include "paramet.h"
+  include "comvert.h"
+  include "comconst.h"
   include "iniprint.h"
   include "logic.h"
+  ! s = sigma ** kappa : coordonnee verticale
+  ! dsig(l) : epaisseur de la couche l ds la coord. s
+  ! sig(l) : sigma a l'interface des couches l et l-1
+  ! ds(l) : distance entre les couches l et l-1 en coord.s
+  real,intent(in) :: pa, preff
+  real,intent(out) :: ap(llmp1) ! in Pa
+  real, intent(out):: bp(llmp1)
+  real,intent(out) :: dpres(llm), nivsigs(llm), nivsig(llmp1)
+  real,intent(out) :: presnivs(llm)
+  real,intent(out) :: scaleheight
+!-------------------------------------------------------------------------------
+! Purpose: Vertical distribution functions for LMDZ.
+!          Triggered by the levels number llm.
+!-------------------------------------------------------------------------------
+! Read    in "comvert.h":
+! pa                         !--- PURE PRESSURE COORDINATE FOR P<pa (in Pascals)
+! preff                      !--- REFERENCE PRESSURE                 (101325 Pa)
+! Written in "comvert.h":
+! ap(llm+1), bp(llm+1)       !--- Ap, Bp HYBRID COEFFICIENTS AT INTERFACES
+! aps(llm),  bps(llm)        !--- Ap, Bp HYBRID COEFFICIENTS AT MID-LAYERS
+! dpres(llm)                 !--- PRESSURE DIFFERENCE FOR EACH LAYER
+! presnivs(llm)              !--- PRESSURE AT EACH MID-LAYER
+! scaleheight                !--- VERTICAL SCALE HEIGHT            (Earth: 8kms)
+! nivsig(llm+1)              !--- SIGMA INDEX OF EACH LAYER INTERFACE
+! nivsigs(llm)               !--- SIGMA INDEX OF EACH MID-LAYER
+!-------------------------------------------------------------------------------
+! Local variables:
   REAL sig(llm+1), dsig(llm)
+  real zk, zkm1, dzk1, dzk2, k0, k1
+  REAL sig0(llm+1), zz(llm+1)
+  REAL zk, zkm1, dzk1, dzk2, z, k0, k1
   INTEGER l, unit
   REAL dsigmin
+  REAL vert_scale,vert_dzmin,vert_dzlow,vert_z0low,vert_dzmid,vert_z0mid,vert_h_mid,vert_dzhig,vert_z0hig,vert_h_hig
   REAL alpha, beta, deltaz
   REAL x
   character(len=*),parameter :: modname="disvert"
   character(len=6):: vert_sampling
+  character(len=24):: vert_sampling
   ! (allowed values are "param", "tropo", "strato" and "read")
   !-----------------------------------------------------------------------
   print *, "Call sequence information: disvert"
+  WRITE(lunout,*) TRIM(modname)//" starts"
   ! default scaleheight is 8km for earth
 …
   vert_sampling = merge("strato", "tropo ", ok_strato) ! default value
   call getin('vert_sampling', vert_sampling)
   print *, 'vert_sampling = ' // vert_sampling
+  WRITE(lunout,*) TRIM(modname)//' vert_sampling = ' // vert_sampling
   if (llm==39 .and. vert_sampling=="strato") then
      dsigmin=0.3 ! Vieille option par défaut pour CMIP5
 …
      ap(1)=0.
      ap(2: llm + 1) = pa * (sig(2: llm + 1) - bp(2: llm + 1))
+  case("strato_correct")
+!==================================================================
+! Fredho 2014/05/18, Saint-Louis du Senegal
+! Cette version de la discretisation strato est corrige au niveau
+! du passage des sig aux ap, bp
+! la version precedente donne un coude dans l'epaisseur des couches
+! vers la tropopause
+!==================================================================
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+        dsig(l) =(dsigmin + 7. * SIN(x)**2) &
+             *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig0(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig0(l) = sig0(l+1) + dsig(l)
+     ENDDO
+     sig=racinesig(sig0)
+     bp(1)=1.
+     bp(2:llm)=EXP(1.-1./sig(2: llm)**2)
+     bp(llmp1)=0.
+     ap(1)=0.
+     ap(2:llm)=pa*(sig(2:llm)-bp(2:llm))
+     ap(llm+1)=0.
+  CASE("strato_custom0")
+!=======================================================
+! Version Transitoire
+    ! custumize strato distribution with specific alpha & beta values and function
+    ! depending on llm (experimental and temporary)!
+    SELECT CASE (llm)
+      CASE(55)
+        alpha=0.45
+        beta=4.0
+      CASE(63)
+        alpha=0.45
+        beta=5.0
+      CASE(71)
+        alpha=3.05
+        beta=65.
+      CASE(79)
+        alpha=3.20
+        ! alpha=2.05 ! FLOTT 79 (PLANTE)
+        beta=70.
+    END SELECT
+    ! Or used values provided by user in def file:
+    CALL getin("strato_alpha",alpha)
+    CALL getin("strato_beta",beta)
+    ! Build geometrical distribution
+    scaleheight=7.
+    zz(1)=0.
+    IF (llm==55.OR.llm==63) THEN
+      DO l=1,llm
+        z=zz(l)/scaleheight
+        zz(l+1)=zz(l)+0.03+z*1.5*(1.-TANH(z-0.5))+alpha*(1.+TANH(z-1.5))     &
+                            +5.0*EXP((l-llm)/beta)
+      ENDDO
+    ELSEIF (llm==71) THEN !.OR.llm==79) THEN      ! FLOTT 79 (PLANTE)
+      DO l=1,llm
+        z=zz(l)
+        zz(l+1)=zz(l)+0.02+0.88*TANH(z/2.5)+alpha*(1.+TANH((z-beta)/15.))
+      ENDDO
+    ELSEIF (llm==79) THEN
+      DO l=1,llm
+        z=zz(l)
+        zz(l+1)=zz(l)+0.02+0.80*TANH(z/3.8)+alpha*(1+TANH((z-beta)/17.))     &
+                            +0.03*TANH(z/.25)
+      ENDDO
+    ENDIF ! of IF (llm==55.OR.llm==63) ...
+    ! Build sigma distribution
+    sig0=EXP(-zz(:)/scaleheight)
+    sig0(llm+1)=0.
+!    sig=ridders(sig0)
+    sig=racinesig(sig0)
+    ! Compute ap() and bp()
+    bp(1)=1.
+    bp(2:llm)=EXP(1.-1./sig(2:llm)**2)
+    bp(llm+1)=0.
+    ap=pa*(sig-bp)
+  CASE("strato_custom")
+!===================================================================
+! David Cugnet, François Lott, Lionel Guez, Ehouoarn Millour, Fredho
+! 2014/05
+! custumize strato distribution
+! Al the parameter are given in km assuming a given scalehigh
+    vert_scale=7.     ! scale hight
+    vert_dzmin=0.02   ! width of first layer
+    vert_dzlow=1.     ! dz in the low atmosphere
+    vert_z0low=8.     ! height at which resolution recches dzlow
+    vert_dzmid=3.     ! dz in the mid atmsophere
+    vert_z0mid=70.    ! height at which resolution recches dzmid
+    vert_h_mid=20.    ! width of the transition
+    vert_dzhig=11.    ! dz in the high atmsophere
+    vert_z0hig=80.    ! height at which resolution recches dz
+    vert_h_hig=20.    ! width of the transition
+!===================================================================
+    call getin('vert_scale',vert_scale)
+    call getin('vert_dzmin',vert_dzmin)
+    call getin('vert_dzlow',vert_dzlow)
+    call getin('vert_z0low',vert_z0low)
+    CALL getin('vert_dzmid',vert_dzmid)
+    CALL getin('vert_z0mid',vert_z0mid)
+    call getin('vert_h_mid',vert_h_mid)
+    call getin('vert_dzhig',vert_dzhig)
+    call getin('vert_z0hig',vert_z0hig)
+    call getin('vert_h_hig',vert_h_hig)
+    scaleheight=vert_scale ! for consistency with further computations
+    ! Build geometrical distribution
+    zz(1)=0.
+    DO l=1,llm
+       z=zz(l)
+       zz(l+1)=zz(l)+vert_dzmin+vert_dzlow*TANH(z/vert_z0low)+                &
+&      (vert_dzmid-vert_dzlow)* &
+&           (TANH((z-vert_z0mid)/vert_h_mid)-TANH((-vert_z0mid)/vert_h_mid)) &
+&     +(vert_dzhig-vert_dzmid-vert_dzlow)*                                  &
+&           (TANH((z-vert_z0hig)/vert_h_hig)-TANH((-vert_z0hig)/vert_h_hig))
+    ENDDO
+!===================================================================
+! Comment added Fredho 2014/05/18, Saint-Louis, Senegal
+! From approximate z to ap, bp, so that p=ap+bp*p0 and p/p0=exp(-z/H)
+! sig0 is p/p0
+! sig is an intermediate distribution introduce to estimate bp
+! 1.   sig0=exp(-z/H)
+! 2.   inversion of sig0=(1-pa/p0)*sig+(1-pa/p0)*exp(1-1/sig**2)
+! 3.   bp=exp(1-1/sig**2)
+! 4.   ap deduced from  the combination of 2 and 3 so that sig0=ap/p0+bp
+!===================================================================
+    sig0=EXP(-zz(:)/vert_scale)
+    sig0(llm+1)=0.
+    sig=racinesig(sig0)
+    bp(1)=1.
+    bp(2:llm)=EXP(1.-1./sig(2:llm)**2)
+    bp(llm+1)=0.
+    ap=pa*(sig-bp)
   case("read")
      ! Read "ap" and "bp". First line is skipped (title line). "ap"
 …
   write(lunout, *) presnivs
+CONTAINS
+!-------------------------------------------------------------------------------
+!
+FUNCTION ridders(sig) RESULT(sg)
+!
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Purpose: Search for s solving (Pa/Preff)*s+(1-Pa/Preff)*EXP(1-1./s**2)=sg
+! Notes:   Uses Ridders' method, quite robust. Initial bracketing: 0<=sg<=1.
+! Reference: Ridders, C. F. J. "A New Algorithm for Computing a Single Root of a
+!       Real Continuous Function" IEEE Trans. Circuits Systems 26, 979-980, 1979
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: sig(:)
+  REAL              :: sg(SIZE(sig))
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: it, ns, maxit
+  REAL :: c1, c2, x1, x2, x3, x4, f1, f2, f3, f4, s, xx, distrib
+!-------------------------------------------------------------------------------
+  ns=SIZE(sig); maxit=9999
+  c1=Pa/Preff; c2=1.-c1
+  DO l=1,ns
+    xx=HUGE(1.)
+    x1=0.0; f1=distrib(x1,c1,c2,sig(l))
+    x2=1.0; f2=distrib(x2,c1,c2,sig(l))
+    DO it=1,maxit
+      x3=0.5*(x1+x2); f3=distrib(x3,c1,c2,sig(l))
+      s=SQRT(f3**2-f1*f2);                 IF(s==0.) EXIT
+      x4=x3+(x3-x1)*(SIGN(1.,f1-f2)*f3/s); IF(ABS(10.*LOG(x4-xx))<=1E-5) EXIT
+      xx=x4; f4=distrib(x4,c1,c2,sig(l));  IF(f4==0.) EXIT
+      IF(SIGN(f3,f4)/=f3) THEN;      x1=x3; f1=f3; x2=xx; f2=f4
+      ELSE IF(SIGN(f1,f4)/=f1) THEN; x2=xx; f2=f4
+      ELSE IF(SIGN(f2,f4)/=f2) THEN; x1=xx; f1=f4
+      ELSE; CALL abort_gcm("ridders",'Algorithm failed (which is odd...')
+      END IF
+      IF(ABS(10.*LOG(ABS(x2-x1)))<=1E-5) EXIT       !--- ERROR ON SIG <= 0.01m
+    END DO
+    IF(it==maxit+1) WRITE(lunout,'(a,i3)')'WARNING in ridder: failed to converg&
+     &e for level ',l
+    sg(l)=xx
+  END DO
+  sg(1)=1.; sg(ns)=0.
+END FUNCTION ridders
+FUNCTION racinesig(sig) RESULT(sg)
+!
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Fredho 2014/05/18
+! Purpose: Search for s solving (Pa/Preff)*sg+(1-Pa/Preff)*EXP(1-1./sg**2)=s
+! Notes:   Uses Newton Raphson search
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: sig(:)
+  REAL              :: sg(SIZE(sig))
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: it, ns, maxit
+  REAL :: c1, c2, x1, x2, x3, x4, f1, f2, f3, f4, s, xx, distrib
+!-------------------------------------------------------------------------------
+  ns=SIZE(sig); maxit=100
+  c1=Pa/Preff; c2=1.-c1
+  DO l=2,ns-1
+    sg(l)=sig(l)
+    DO it=1,maxit
+       f1=exp(1-1./sg(l)**2)*(1.-c1)
+       sg(l)=sg(l)-(c1*sg(l)+f1-sig(l))/(c1+2*f1*sg(l)**(-3))
+    ENDDO
+!   print*,'SSSSIG ',sig(l),sg(l),c1*sg(l)+exp(1-1./sg(l)**2)*(1.-c1)
+  ENDDO
+  sg(1)=1.; sg(ns)=0.
+END FUNCTION racinesig
 END SUBROUTINE disvert
+!-------------------------------------------------------------------------------
+FUNCTION distrib(x,c1,c2,x0) RESULT(res)
+!
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN) :: x, c1, c2, x0
+  REAL             :: res
+!-------------------------------------------------------------------------------
+  res=c1*x+c2*EXP(1-1/(x**2))-x0
+END FUNCTION distrib

LMDZ5/branches/testing/libf/dyn3d_common/iniconst.F90

r1999	r2056
73	73	if (disvert_type==1) then
74	74	! standard case for Earth (automatic generation of levels)
75		call disvert(~~pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig, scaleheight~~)
	75	call disvert()
76	76	else if (disvert_type==2) then
77	77	! standard case for planets (levels generated using z2sig.def file)

LMDZ5/branches/testing/libf/dyn3d_common/q_sat.F

-                      r1999
+                      r2056
 ! $Header$
+!
+c
+c
+!
+!
       subroutine q_sat(np,temp,pres,qsat)
+c
+!
       IMPLICIT none
 c======================================================================
 c Autheur(s): Z.X. Li (LMD/CNRS)
 c  reecriture vectorisee par F. Hourdin.
 c Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
 c======================================================================
 c Arguments:
 c kelvin---input-R: temperature en Kelvin
 c millibar--input-R: pression en mb
+c
 c q_sat----output-R: vapeur d'eau saturante en kg/kg
 c======================================================================
+c
+!======================================================================
+! Autheur(s): Z.X. Li (LMD/CNRS)
+!  reecriture vectorisee par F. Hourdin.
+! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
+!======================================================================
+! Arguments:
+! kelvin---input-R: temperature en Kelvin
+! millibar--input-R: pression en mb
+!
+! q_sat----output-R: vapeur d'eau saturante en kg/kg
+!======================================================================
+!
       integer np
       REAL temp(np),pres(np),qsat(np)
+c
+!
       REAL r2es
       PARAMETER (r2es=611.14 *18.0153/28.9644)
+c
+!
       REAL r3les, r3ies, r3es
       PARAMETER (R3LES=17.269)
       PARAMETER (R3IES=21.875)
+c
+!
       REAL r4les, r4ies, r4es
       PARAMETER (R4LES=35.86)
       PARAMETER (R4IES=7.66)
+c
+!
       REAL rtt
       PARAMETER (rtt=273.16)
+c
+!
       REAL retv
       PARAMETER (retv=28.9644/18.0153 - 1.0)
 …
       real zqsat
       integer ip
+c
 C     ------------------------------------------------------------------
+c
+c
+!
+!     ------------------------------------------------------------------
+!
+!
       do ip=1,np
 c      write(*,*)'kelvin,millibar=',kelvin,millibar
 c       write(*,*)'temp,pres=',temp(ip),pres(ip)
+c
+!      write(*,*)'kelvin,millibar=',kelvin,millibar
+!       write(*,*)'temp,pres=',temp(ip),pres(ip)
+!
          IF (temp(ip) .LE. rtt) THEN
             r3es = r3ies
 …
             r4es = r4les
          ENDIF
+c
+!
          zqsat=r2es/pres(ip)*EXP(r3es*(temp(ip)-rtt)/(temp(ip)-r4es))
          zqsat=MIN(0.5,ZQSAT)
          zqsat=zqsat/(1.-retv *zqsat)
+c
+!
          qsat(ip)= zqsat
 c      write(*,*)'qsat=',qsat(ip)
+!      write(*,*)'qsat=',qsat(ip)
       enddo
+c
+!
       RETURN
       END

LMDZ5/branches/testing/libf/dyn3dmem/calfis_loc.F

-                      r1999
+                      r2056
       REAL unskap, pksurcp
+c
-cIM diagnostique PVteta, Amip2
-      INTEGER,PARAMETER :: ntetaSTD=3
-      REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !!
-      REAL PVteta(klon,ntetaSTD)
       REAL SSUM
 …
       klon=klon_mpi
-      PVteta(:,:)=0.
+c
       IF ( firstcal )  THEN
 …
       endif
-      IF (is_sequential.and.(planet_type=="earth")) THEN
-#ifdef CPP_PHYS
-! PVtheta calls tetalevel, which is in the physics
-cIM calcul PV a teta=350, 380, 405K
-        CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
-     $           ztfi,zplay,zplev,
-     $           ntetaSTD,rtetaSTD,PVteta)
+c
-#endif
-      ENDIF
 c On change de grille, dynamique vers physiq, pour le flux de masse verticale
 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
 …
      .             zdqfi_omp,
      .             zdpsrf_omp,
+cIM diagnostique PVteta, Amip2
+     .             pducov,
+     .             PVteta)
+     .             pducov)
       else if ( planet_type=="generic" ) then

LMDZ5/branches/testing/libf/dyn3dmem/call_calfis_mod.F90

-                      r1999
+                      r2056
     REAL,POINTER,SAVE :: p(:,:)
-    REAL,POINTER,SAVE :: alpha(:,:)
-    REAL,POINTER,SAVE :: beta(:,:)
     REAL,POINTER,SAVE :: pks(:)
     REAL,POINTER,SAVE :: pk(:,:)
 …
     CALL allocate_u(flxw,llm,d)
     CALL allocate_u(p,llmp1,d)
-    CALL allocate_u(alpha,llm,d)
-    CALL allocate_u(beta,llm,d)
     CALL allocate_u(pks,d)
     CALL allocate_u(pk,llm,d)
 …
                          phis_dyn,q_dyn,flxw_dyn)
   USE dimensions_mod
+  use exner_hyb_loc_m, only: exner_hyb_loc
+  use exner_milieu_loc_m, only: exner_milieu_loc
   USE parallel_lmdz
   USE times
 …
   !$OMP BARRIER
     CALL exner_hyb_loc(  ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+    CALL exner_hyb_loc(  ip1jmp1, ps, p, pks, pk, pkf )
   !$OMP BARRIER
     CALL geopot_loc  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
 …
 !$OMP BARRIER
     if (pressure_exner) then
       CALL exner_hyb_loc(ijnb_u,ps,p,alpha,beta,pks,pk,pkf)
+      CALL exner_hyb_loc(ijnb_u,ps,p,pks,pk,pkf)
     else
       CALL exner_milieu_loc(ijnb_u,ps,p,beta,pks,pk,pkf)
+      CALL exner_milieu_loc(ijnb_u,ps,p,pks,pk,pkf)
     endif
 !$OMP BARRIER

LMDZ5/branches/testing/libf/dyn3dmem/gcm.F

-                      r1999
+                      r2056
       REAL,ALLOCATABLE,SAVE  :: ps(:)         ! pression  au sol
 c      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
-c      REAL pks(ip1jmp1)                      ! exner au  sol
-c      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
-c      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
       REAL,ALLOCATABLE,SAVE  :: masse(:,:)    ! masse d'air
       REAL,ALLOCATABLE,SAVE  :: phis(:)       ! geopotentiel au sol
 …
       data call_iniphys/.true./
-c      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
 c+jld variables test conservation energie
 c      REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
 …
+      day_end = day_ini + nday
+      if (nday>=0) then
+         day_end = day_ini + nday
+      else
+         day_end = day_ini - nday/day_step
+      endif
       WRITE(lunout,300)day_ini,day_end
   FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)

LMDZ5/branches/testing/libf/dyn3dmem/guide_loc_mod.F90

-                      r1910
+                      r2056
 !=======================================================================
   SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
+    use exner_hyb_loc_m, only: exner_hyb_loc
+    use exner_milieu_loc_m, only: exner_milieu_loc
     USE parallel_lmdz
     USE control_mod
 …
     REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: f_addv ! var aux: champ de guidage
     ! Variables pour fonction Exner (P milieu couche)
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: pk, pkf
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: alpha, beta
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: pk
     REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks
     REAL                               :: unskap
 …
     INTEGER       :: i,j,l
+    INTEGER,EXTERNAL :: OMP_GET_THREAD_NUM
 !$OMP MASTER
 …
 !$OMP BARRIER
      PRINT *,'---> on rentre dans guide_main'
+!    PRINT *,'---> on rentre dans guide_main'
 !    CALL AllGather_Field(ucov,ip1jmp1,llm)
 !    CALL AllGather_Field(vcov,ip1jm,llm)
 …
         ALLOCATE(f_addv(ijb_v:ije_v,llm) )
         ALLOCATE(pk(iip1,jjb_u:jje_u,llm)  )
-        ALLOCATE(pkf(iip1,jjb_u:jje_u,llm)  )
-        ALLOCATE(alpha(iip1,jjb_u:jje_u,llm)  )
-        ALLOCATE(beta(iip1,jjb_u:jje_u,llm)  )
         ALLOCATE(pks(iip1,jjb_u:jje_u)  )
         ALLOCATE(p(ijb_u:ije_u,llmp1) )
 …
         IF (ini_anal) THEN
             CALL guide_interp(ps,teta)
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
             DO l=1,llm
               IF (guide_u) ucov(ijbu:ijeu,l)=ugui2(ijbu:ijeu,l)
 …
             ENDIF
             RETURN
-        ENDIF
-! Verification structure guidage
-        IF (guide_u) THEN
-!+tard            CALL writefield_u('unat',unat1)
-!            CALL writefield_u('ucov',ucov)
-        ENDIF
-        IF (guide_T) THEN
-!+tard            CALL writefield_p('tnat',tnat1)
-!            CALL writefield_u('teta',teta)
         ENDIF
 …
     f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav)
     IF (f_out) THEN
+!       Calcul niveaux pression milieu de couches
+        CALL pression_loc( ijnb_u, ap, bp, ps, p )
+        if (pressure_exner) then
+          CALL exner_hyb_loc(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
+        else
+          CALL exner_milieu_loc(ip1jmp1,ps,p,beta,pks,pk,pkf)
+        endif
+!$OMP BARRIER
+!$OMP BARRIER
+      CALL pression_loc(ijnb_u,ap,bp,ps,p)
+!$OMP BARRIER
+      if (pressure_exner) then
+      CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk)
+      else
+        CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk )
+      endif
+!$OMP BARRIER
         unskap=1./kappa
+!$OMP DO
+        DO l = 1, llm
+            DO j=jjbu,jjeu
+                DO i =1, iip1
+                    p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
+                ENDDO
+            ENDDO
+        ENDDO
+!$OMP MASTER
+        CALL guide_out("P",jjp1,llm,p,1.)
+!$OMP END MASTER
+!$OMP BARRIER
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+            DO j=jjbu,jjeu
+                DO i =1, iip1
+                    p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
+                ENDDO
+            ENDDO
+        ENDDO
+!!$OMP MASTER
+!     DO l=1,llm,5
+!         print*,'avant dump2d l=',l,mpi_rank,OMP_GET_THREAD_NUM()
+!         print*,'avant dump2d l=',l,mpi_rank
+!         CALL dump2d(iip1,jjnb_u,p(:,l),'ppp   ')
+!      ENDDO
+!!$OMP END MASTER
+!!$OMP BARRIER
+        CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.)
     ENDIF
     if (guide_u) then
         if (guide_add) then
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
            f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)
           ENDDO
         else
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
            f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)-ucov(ijbu:ijeu,l)
 …
         if (guide_zon) CALL guide_zonave_u(1,llm,f_addu)
         CALL guide_addfield_u(llm,f_addu,alpha_u)
+!        CALL WriteField_u('f_addu',f_addu)
+!        CALL WriteField_u('alpha_u',alpha_u)
+!$OMP MASTER
+        IF (f_out) CALL guide_out("U",jjp1,llm,f_addu(:,:),factt)
+!$OMP END MASTER
+!$OMP BARRIER
+!$OMP DO
+!       IF (f_out) CALL guide_out("ua",jjp1,llm,ugui1(ijb_u:ije_u,:),factt)
+        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:),factt)
+        IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt)
+        IF (f_out) CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:),factt)
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         DO l=1,llm
           ucov(ijbu:ijeu,l)=ucov(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
 …
     if (guide_T) then
         if (guide_add) then
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
             f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)
           ENDDO
         else
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
            f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)-teta(ijbu:ijeu,l)
 …
         if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
         CALL guide_addfield_u(llm,f_addu,alpha_T)
+!$OMP MASTER
+        IF (f_out) CALL guide_out("T",jjp1,llm,f_addu(:,:),factt)
+!$OMP END MASTER
+!$OMP BARRIER
+!$OMP DO
+        IF (f_out) CALL guide_out("teta",jjp1,llm,f_addu(:,:)/factt,factt)
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         DO l=1,llm
           teta(ijbu:ijeu,l)=teta(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
 …
         if (guide_zon) CALL guide_zonave_u(2,1,f_addu(ijb_u:ije_u,1))
         CALL guide_addfield_u(1,f_addu(ijb_u:ije_u,1),alpha_P)
+!$OMP MASTER
+        IF (f_out) CALL guide_out("SP",jjp1,1,f_addu(1:ip1jmp1,1),factt)
+!$OMP END MASTER
+!$OMP BARRIER
+!       IF (f_out) CALL guide_out("ps",jjp1,1,f_addu(ijb_u:ije_u,1)/factt,factt)
 !$OMP MASTER
         ps(ijbu:ijeu)=ps(ijbu:ijeu)+f_addu(ijbu:ijeu,1)
 …
     if (guide_Q) then
         if (guide_add) then
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
             f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)
           ENDDO
         else
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
             f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)-q(ijbu:ijeu,l)
 …
         if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
         CALL guide_addfield_u(llm,f_addu,alpha_Q)
+!$OMP MASTER
+        IF (f_out) CALL guide_out("Q",jjp1,llm,f_addu(:,:),factt)
+!$OMP END MASTER
+!$OMP BARRIER
+!$OMP DO
+        IF (f_out) CALL guide_out("q",jjp1,llm,f_addu(:,:)/factt,factt)
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         DO l=1,llm
           q(ijbu:ijeu,l)=q(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
 …
     if (guide_v) then
         if (guide_add) then
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
              f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)
 …
         else
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
             f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)-vcov(ijbv:ijev,l)
 …
         endif
-!        CALL WriteField_v('f_addv',f_addv)
         if (guide_zon) CALL guide_zonave_v(2,jjm,llm,f_addv(ijb_v:ije_v,:))
-!        CALL WriteField_v('f_addv',f_addv)
         CALL guide_addfield_v(llm,f_addv(ijb_v:ije_v,:),alpha_v)
+!        CALL WriteField_v('f_addv',f_addv)
+!        CALL WriteField_v('alpha_v',alpha_v)
+!$OMP MASTER
+        IF (f_out) CALL guide_out("V",jjm,llm,f_addv(1:ip1jm,:),factt)
+!$OMP END MASTER
+!$OMP BARRIER
+!        CALL WriteField_v('f_addv',f_addv)
+!$OMP DO
+        IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt)
+        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:),factt)
+        IF (f_out) CALL guide_out("vcov",jjm,llm,f_addv(:,:)/factt,factt)
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         DO l=1,llm
           vcov(ijbv:ijev,l)=vcov(ijbv:ijev,l)+f_addv(ijbv:ijev,l)
 …
     endif
-!    CALL WriteField_u('ucov_guide',ucov)
-!    CALL WriteField_v('vcov_guide',vcov)
-!    CALL WriteField_u('teta_guide',teta)
-!    CALL WriteField_u('masse_guide',masse)
   END SUBROUTINE guide_main
 …
     INTEGER :: l
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,vsize
       field(ijbu:ijeu,l)=alpha(ijbu:ijeu)*field(ijbu:ijeu,l)*alpha_pcor(l)
 …
     INTEGER :: l
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,vsize
       field(ijbv:ijev,l)=alpha(ijbv:ijev)*field(ijbv:ijev,l)*alpha_pcor(l)
 …
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
       DO l=1,vsize
         fieldm(:,l)=0.
 …
     ENDIF
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
       DO l=1,vsize
       ! Compute zonal average
 …
 !=======================================================================
   SUBROUTINE guide_interp(psi,teta)
+    use exner_hyb_loc_m, only: exner_hyb_loc
+    use exner_milieu_loc_m, only: exner_milieu_loc
   USE parallel_lmdz
   USE mod_hallo
 …
   REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: pbary
   ! Variables pour fonction Exner (P milieu couche)
+  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pk, pkf
+  REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: alpha, beta
+  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pk
   REAL ,ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks
   REAL                               :: unskap
 …
       ALLOCATE(pbary(iip1,jjb_v:jje_v,llm) )
       ALLOCATE(pk(iip1,jjb_u:jje_u,llm) )
-      ALLOCATE(pkf(iip1,jjb_u:jje_u,llm)  )
-      ALLOCATE(alpha(iip1,jjb_u:jje_u,llm) )
-      ALLOCATE(beta(iip1,jjb_u:jje_u,llm) )
       ALLOCATE(pks (iip1,jjb_u:jje_u) )
       ALLOCATE(qsat(ijb_u:ije_u,llm) )
 …
 !    ....  Calcul de pls , pression au milieu des couches ,en Pascals
     IF (guide_plevs.EQ.1) THEN
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         DO l=1,llm
             DO j=jjbu,jjeu
                 DO i =1, iip1
                     pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2.
                 ENDDO
             ENDDO
+                ENDDO
+            ENDDO
         ENDDO
     ELSE
         CALL pression_loc( ijnb_u, ap, bp, psi, p )
         if (disvert_type==1) then
           CALL exner_hyb_loc(ijnb_u,psi,p,alpha,beta,pks,pk,pkf)
+        CALL pression_loc( ijnb_u, ap, bp, psi, p )
+        if (disvert_type==1) then
+          CALL exner_hyb_loc(ijnb_u,psi,p,pks,pk)
         else ! we assume that we are in the disvert_type==2 case
           CALL exner_milieu_loc(ijnb_u,psi,p,beta,pks,pk,pkf)
+          CALL exner_milieu_loc(ijnb_u,psi,p,pks,pk)
         endif
         unskap=1./kappa
 !$OMP BARRIER
 !$OMP DO
         DO l = 1, llm
             DO j=jjbu,jjeu
                 DO i =1, iip1
                     pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
                 ENDDO
             ENDDO
         ENDDO
+        unskap=1./kappa
+!$OMP BARRIER
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+   DO l = 1, llm
+       DO j=jjbu,jjeu
+        DO i =1, iip1
+            pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
+        ENDDO
+       ENDDO
+   ENDDO
     ENDIF
 !   calcul des pressions pour les grilles u et v
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     do l=1,llm
         do j=jjbu,jjeu
 …
     call massbar_loc(pext, pbarx, pbary )
 !$OMP BARRIER
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     do l=1,llm
         do j=jjbu,jjeu
 …
         enddo
     enddo
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     do l=1,llm
         do j=jjbv,jjev
 …
 !$OMP BARRIER
         ! Conversion en variables GCM
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         do l=1,llm
             do j=jjbu,jjeu
 …
         ! On suppose qu'on a la bonne variable dans le fichier de guidage:
         ! Hum.Rel si guide_hr, Hum.Spec. sinon.
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         do l=1,llm
             do j=jjbu,jjeu
 …
         enddo
         IF (guide_hr) THEN
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           do l=1,llm
             CALL q_sat(iip1*jjnu,teta(:,jjbu:jjeu,l)*pk(:,jjbu:jjeu,l)/cpp,       &
 …
         ! Conversion en variables GCM
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         do l=1,llm
             do j=jjbu,jjeu
 …
 !$OMP BARRIER
         ! Conversion en variables GCM
 !$OMP DO
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         do l=1,llm
             do j=jjbv,jjev
 …
      endif
 !  Temperature
      if (guide_T) then
 …
              if (ncidpl.eq.-99) ncidpl=ncidu
          endif
 ! Vent meridien
          if (guide_v) then
 …
      endif
 !  Temperature
      if (guide_T) then
 …
          IF (invert_y) THEN
 !           PRINT*,"Invertion impossible actuellement"
 !           CALL abort_gcm(modname,abort_message,1)
 …
 !=======================================================================
   SUBROUTINE guide_out(varname,hsize,vsize,field,factt)
+  SUBROUTINE guide_out(varname,hsize,vsize,field_loc,factt)
     USE parallel_lmdz
+    USE mod_hallo, ONLY : gather_field_u, gather_field_v
     IMPLICIT NONE
 …
     ! Variables entree
     CHARACTER, INTENT(IN)                          :: varname
+    CHARACTER*(*), INTENT(IN)                      :: varname
     INTEGER,   INTENT (IN)                         :: hsize,vsize
+    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
+    REAL, INTENT (IN)                              :: factt
+!   REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field_loc
+    REAL, DIMENSION (:,:), INTENT(IN) :: field_loc
+    REAL factt
     ! Variables locales
 …
     INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
     INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
+    INTEGER       :: vid_au,vid_av
     INTEGER, DIMENSION (3) :: dim3
     INTEGER, DIMENSION (4) :: dim4,count,start
+    INTEGER                :: ierr, varid
+    CALL gather_field(field,iip1*hsize,vsize,0)
+    IF (mpi_rank /= 0) RETURN
+    print *,'Guide: output timestep',timestep,'var ',varname
+    INTEGER                :: ierr, varid,l
+    REAL zu(ip1jmp1),zv(ip1jm)
+    REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo
+!$OMP MASTER
+    ALLOCATE(field_glo(iip1,hsize,vsize))
+!$OMP END MASTER
+!$OMP BARRIER
+    print*,'gvide_out apres allocation ',hsize,vsize
+    IF (hsize==jjp1) THEN
+        CALL gather_field_u(field_loc,field_glo,vsize)
+    ELSE IF (hsize==jjm) THEN
+       CALL gather_field_v(field_loc,field_glo, vsize)
+    ENDIF
+    print*,'guide_out apres gather '
+    CALL Gather_field_u(alpha_u,zu,1)
+    CALL Gather_field_v(alpha_v,zv,1)
+    IF (mpi_rank >  0) THEN
+!$OMP MASTER
+       DEALLOCATE(field_glo)
+!$OMP END MASTER
+!$OMP BARRIER
+       RETURN
+    ENDIF
+!$OMP MASTER
     IF (timestep.EQ.0) THEN
 ! ----------------------------------------------
 …
         ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
         ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
+        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
+        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
         ierr=NF_ENDDEF(nid)
 …
         ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
         ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
+        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,zu)
+        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,zv)
 #else
         ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
 …
         ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
         ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
+        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
+        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
 #endif
 ! --------------------------------------------------------------------
 …
 ! Pressure (GCM)
         dim4=(/id_lonv,id_latu,id_lev,id_tim/)
         ierr = NF_DEF_VAR(nid,"P",NF_FLOAT,4,dim4,varid)
+        ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid)
 ! Surface pressure (guidage)
         IF (guide_P) THEN
 …
         IF (guide_u) THEN
             dim4=(/id_lonu,id_latu,id_lev,id_tim/)
+            ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)
+            ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)
             ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
         ENDIF
 …
         IF (guide_v) THEN
             dim4=(/id_lonv,id_latv,id_lev,id_tim/)
+            ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)
+            ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)
             ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
         ENDIF
 …
     ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
+    IF (varname=="SP") timestep=timestep+1
+    ierr = NF_INQ_VARID(nid,varname,varid)
     SELECT CASE (varname)
+    CASE ("P")
+        timestep=timestep+1
+        ierr = NF_INQ_VARID(nid,"P",varid)
+    CASE ("SP","ps")
         start=(/1,1,1,timestep/)
         count=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
+#else
+        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
+#endif
+    CASE ("SP")
+        ierr = NF_INQ_VARID(nid,"ps",varid)
+        start=(/1,1,timestep,0/)
+        count=(/iip1,jjp1,1,0/)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
+#else
+        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
+#endif
+    CASE ("U")
+        ierr = NF_INQ_VARID(nid,"ucov",varid)
+    CASE ("v","va","vcov")
+        start=(/1,1,1,timestep/)
+        count=(/iip1,jjm,llm,1/)
+    CASE DEFAULT
         start=(/1,1,1,timestep/)
         count=(/iip1,jjp1,llm,1/)
+    END SELECT
+!$OMP END MASTER
+!$OMP BARRIER
+    SELECT CASE (varname)
+    CASE("u","ua")
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l=1,llm
+            field_glo(:,2:jjm,l)=field_glo(:,2:jjm,l)/cu(:,2:jjm)
+            field_glo(:,1,l)=0. ; field_glo(:,jjp1,l)=0.
+        ENDDO
+    CASE("v","va")
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l=1,llm
+           field_glo(:,:,l)=field_glo(:,:,l)/cv(:,:)
+        ENDDO
+    END SELECT
+!    if (varname=="ua") then
+!    call dump2d(iip1,jjp1,field_glo,'ua gui1 1ere couche ')
+!    call dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ')
+!    endif
+!$OMP MASTER
 #ifdef NC_DOUBLE
         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
+    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field_glo)
 #else
         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
+    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field_glo)
 #endif
+    CASE ("V")
+        ierr = NF_INQ_VARID(nid,"vcov",varid)
+        start=(/1,1,1,timestep/)
+        count=(/iip1,jjm,llm,1/)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
+#else
+        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
+#endif
+    CASE ("T")
+        ierr = NF_INQ_VARID(nid,"teta",varid)
+        start=(/1,1,1,timestep/)
+        count=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
+#else
+        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
+#endif
+    CASE ("Q")
+        ierr = NF_INQ_VARID(nid,"q",varid)
+        start=(/1,1,1,timestep/)
+        count=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
+#else
+        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
+#endif
+    END SELECT
     ierr = NF_CLOSE(nid)
+       DEALLOCATE(field_glo)
+!$OMP END MASTER
+!$OMP BARRIER
+    RETURN
   END SUBROUTINE guide_out
 …
   end subroutine correctbid
+!====================================================================
+! Ascii debug output. Could be reactivated
+!====================================================================
+subroutine dump2du(var,varname)
+use parallel_lmdz
+use mod_hallo
+implicit none
+include 'dimensions.h'
+include 'paramet.h'
+      CHARACTER (len=*) :: varname
+real, dimension(ijb_u:ije_u) :: var
+real, dimension(ip1jmp1) :: var_glob
+    RETURN
+    call barrier
+    CALL Gather_field_u(var,var_glob,1)
+    call barrier
+    if (mpi_rank==0) then
+       call dump2d(iip1,jjp1,var_glob,varname)
+    endif
+    call barrier
+    return
+    end subroutine dump2du
+!====================================================================
+! Ascii debug output. Could be reactivated
+!====================================================================
+subroutine dumpall
+     implicit none
+     include "dimensions.h"
+     include "paramet.h"
+     include "comgeom.h"
+     call barrier
+     call dump2du(alpha_u(ijb_u:ije_u),'  alpha_u couche 1')
+     call dump2du(unat2(:,jjbu:jjeu,nlevnc),'  unat2 couche nlevnc')
+     call dump2du(ugui1(ijb_u:ije_u,1)*sqrt(unscu2(ijb_u:ije_u)),'  ugui1 couche 1')
+     return
+end subroutine dumpall
 !===========================================================================
 END MODULE guide_loc_mod

LMDZ5/branches/testing/libf/dyn3dmem/iniacademic_loc.F90

-                      r1910
+                      r2056
 SUBROUTINE iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
+  use exner_hyb_m, only: exner_hyb
+  use exner_milieu_m, only: exner_milieu
   USE filtreg_mod
   USE infotrac, ONLY : nqtot
 …
   REAL pks(ip1jmp1)                      ! exner au  sol
   REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
-  REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
   REAL phi(ip1jmp1,llm)                  ! geopotentiel
   REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
 …
   REAL zdtvr
-  real,allocatable :: alpha(:,:),beta(:,:)
   character(len=*),parameter :: modname="iniacademic"
 …
        allocate(masse_glo(ip1jmp1,llm))
        allocate(phis_glo(ip1jmp1))
-       allocate(alpha(ip1jmp1,llm))
-       allocate(beta(ip1jmp1,llm))
         ! surface pressure
 …
         CALL pression ( ip1jmp1, ap, bp, ps_glo, p       )
         if (pressure_exner) then
           CALL exner_hyb( ip1jmp1, ps_glo, p,alpha,beta, pks, pk, pkf )
+          CALL exner_hyb( ip1jmp1, ps_glo, p, pks, pk )
         else
           call exner_milieu(ip1jmp1,ps_glo,p,beta,pks,pk,pkf)
+          call exner_milieu(ip1jmp1,ps_glo,p,pks,pk)
         endif
         CALL massdair(p,masse_glo)
 …
         deallocate(ps_glo)
         deallocate(phis_glo)
-        deallocate(alpha)
-        deallocate(beta)
      ENDIF ! of IF (.NOT. read_start)
   endif academic_case

LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F

-                      r1999
+                      r2056
        USE call_calfis_mod, ONLY : call_calfis
        USE leapfrog_mod
+       use exner_hyb_loc_m, only: exner_hyb_loc
+       use exner_milieu_loc_m, only: exner_milieu_loc
       IMPLICIT NONE
 …
       character*10 string10
-!      REAL,SAVE,ALLOCATABLE :: alpha(:,:),beta(:,:)
 !      REAL,SAVE,ALLOCATABLE :: flxw(:,:) ! flux de masse verticale
 …
       lafin=.false.
+      itaufin   = nday*day_step
+      if (nday>=0) then
+         itaufin   = nday*day_step
+      else
+         itaufin   = -nday
+      endif
       itaufinp1 = itaufin +1
 …
 !      ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
 !      ALLOCATE(finvmaold(ijb_u:ije_u,llm))
-!      ALLOCATE(alpha(ijb_u:ije_u,llm),beta(ijb_u:ije_u,llm))
 !      ALLOCATE(flxw(ijb_u:ije_u,llm))
 !      ALLOCATE(ecin(ijb_u:ije_u,llm),ecin0(ijb_u:ije_u,llm))
 …
 c$OMP END MASTER
       if (pressure_exner) then
       CALL exner_hyb_loc( ijnb_u, ps, p,alpha,beta, pks, pk, pkf)
+      CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf)
       else
         CALL exner_milieu_loc( ijnb_u, ps, p, beta, pks, pk, pkf )
+        CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf )
       endif
 c-----------------------------------------------------------------------
 …
 ! c$OMP BARRIER
 !          CALL exner_hyb_loc(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
+!          CALL exner_hyb_loc(  ip1jmp1, ps, p,pks, pk, pkf )
 ! c$OMP BARRIER
 !            jD_cur = jD_ref + day_ini - day_ref
 …
 c$OMP BARRIER
         if (pressure_exner) then
         CALL exner_hyb_loc( ijnb_u, ps, p,alpha,beta, pks, pk, pkf )
+        CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf )
         else
           CALL exner_milieu_loc( ijnb_u, ps, p, beta, pks, pk, pkf )
+          CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf )
         endif
 c$OMP BARRIER

LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_mod.F90

-                      r1999
+                      r2056
   REAL,POINTER,SAVE :: dq(:,:,:)
   REAL,POINTER,SAVE :: finvmaold(:,:)
-  REAL,POINTER,SAVE :: alpha(:,:)
-  REAL,POINTER,SAVE :: beta(:,:)
   REAL,POINTER,SAVE :: flxw(:,:)
   REAL,POINTER,SAVE :: unat(:,:)
 …
     CALL allocate_u(dq,llm,nqtot,d)
     CALL allocate_u(finvmaold,llm,d)
-    CALL allocate_u(alpha,llm,d)
-    CALL allocate_u(beta,llm,d)
     CALL allocate_u(flxw,llm,d)
     CALL allocate_u(unat,llm,d)
 …
     CALL switch_u(dq,distrib_caldyn,dist)
     CALL switch_u(finvmaold,distrib_caldyn,dist)
-    CALL switch_u(alpha,distrib_caldyn,dist)
-    CALL switch_u(beta,distrib_caldyn,dist)
     CALL switch_u(flxw,distrib_caldyn,dist)
     CALL switch_u(unat,distrib_caldyn,dist)

LMDZ5/branches/testing/libf/dyn3dmem/mod_const_mpi.F90

-                      r1999
+                      r2056
     USE mod_prism
 #endif
+#ifdef CPP_XIOS
+    USE wxios, only: wxios_init
+#endif
     IMPLICIT NONE
 #ifdef CPP_MPI
 …
 #ifdef CPP_COUPLE
 !$OMP MASTER
+       CALL prism_init_comp_proto (comp_id, 'lmdz.x', ierr)
+#ifdef CPP_XIOS
+      CALL wxios_init("LMDZ", outcom=COMM_LMDZ, type_ocean=type_ocean)
+#else
+       CALL prism_init_comp_proto (comp_id, 'LMDZ', ierr)
        CALL prism_get_localcomm_proto(COMM_LMDZ,ierr)
+#endif
 !$OMP END MASTER
 #endif

LMDZ5/branches/testing/libf/dyn3dmem/parallel_lmdz.F90

-                      r1999
+                      r2056
       if (type_ocean == 'couple') then
+#ifdef CPP_XIOS
+    !Fermeture propre de XIOS
+      CALL wxios_close()
+#else
 #ifdef CPP_COUPLE
          call prism_terminate_proto(ierr)
 …
          endif
 #endif
+#endif
       else
 #ifdef CPP_XIOS

LMDZ5/branches/testing/libf/dyn3dpar/calfis_p.F

-                      r1999
+                      r2056
       REAL unskap, pksurcp
+c
-cIM diagnostique PVteta, Amip2
-      INTEGER,PARAMETER :: ntetaSTD=3
-      REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !!
-      REAL PVteta(klon,ntetaSTD)
       REAL SSUM
 …
       klon=klon_mpi
-      PVteta(:,:)=0.
+c
       IF ( firstcal )  THEN
 …
       endif
-      IF (is_sequential.and.(planet_type=="earth")) THEN
-#ifdef CPP_PHYS
-! PVtheta calls tetalevel, which is in the physics
-cIM calcul PV a teta=350, 380, 405K
-        CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
-     $           ztfi,zplay,zplev,
-     $           ntetaSTD,rtetaSTD,PVteta)
+c
-#endif
-      ENDIF
 c On change de grille, dynamique vers physiq, pour le flux de masse verticale
       CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi)
 …
      .             zdqfi_omp,
      .             zdpsrf_omp,
+cIM diagnostique PVteta, Amip2
+     .             pducov,
+     .             PVteta)
+     .             pducov)
       else if ( planet_type=="generic" ) then

LMDZ5/branches/testing/libf/dyn3dpar/gcm.F

-                      r1999
+                      r2056
       REAL ps(ip1jmp1)                       ! pression  au sol
 c      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
-c      REAL pks(ip1jmp1)                      ! exner au  sol
-c      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
-c      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
       REAL masse(ip1jmp1,llm)                ! masse d'air
       REAL phis(ip1jmp1)                     ! geopotentiel au sol
 …
       data call_iniphys/.true./
-c      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
 c+jld variables test conservation energie
 c      REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
 …
+      day_end = day_ini + nday
+      if (nday>=0) then
+         day_end = day_ini + nday
+      else
+         day_end = day_ini - nday/day_step
+      endif
       WRITE(lunout,300)day_ini,day_end
   FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)

LMDZ5/branches/testing/libf/dyn3dpar/guide_p_mod.F90

Property svn:keywords set to Id

-                      r2024
+                      r2056
 !=======================================================================
   SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
+    use exner_hyb_p_m, only: exner_hyb_p
+    use exner_milieu_p_m, only: exner_milieu_p
     USE parallel_lmdz
     USE control_mod
 …
     REAL, DIMENSION (ip1jmp1,llm) :: f_add ! var aux: champ de guidage
     ! Variables pour fonction Exner (P milieu couche)
+    REAL, DIMENSION (iip1,jjp1,llm)    :: pk, pkf
+    REAL, DIMENSION (iip1,jjp1,llm)    :: alpha, beta
+    REAL, DIMENSION (iip1,jjp1,llm)    :: pk
     REAL, DIMENSION (iip1,jjp1)        :: pks
     REAL                               :: unskap
 …
         CALL pression_p( ip1jmp1, ap, bp, ps, p )
         if (pressure_exner) then
           CALL exner_hyb_p(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
+          CALL exner_hyb_p(ip1jmp1,ps,p,pks,pk)
         else
           CALL exner_milieu_p(ip1jmp1,ps,p,beta,pks,pk,pkf)
+          CALL exner_milieu_p(ip1jmp1,ps,p,pks,pk)
         endif
         unskap=1./kappa
 …
 !=======================================================================
   SUBROUTINE guide_interp(psi,teta)
+    use exner_hyb_p_m, only: exner_hyb_p
+    use exner_milieu_p_m, only: exner_milieu_p
   USE parallel_lmdz
   USE mod_hallo
 …
   REAL, DIMENSION (iip1,jjm,llm)     :: pbary
   ! Variables pour fonction Exner (P milieu couche)
+  REAL, DIMENSION (iip1,jjp1,llm)    :: pk, pkf
+  REAL, DIMENSION (iip1,jjp1,llm)    :: alpha, beta
+  REAL, DIMENSION (iip1,jjp1,llm)    :: pk
   REAL, DIMENSION (iip1,jjp1)        :: pks
   REAL                               :: unskap
 …
         CALL pression_p( ip1jmp1, ap, bp, psi, p )
         if (pressure_exner) then
           CALL exner_hyb_p(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
+          CALL exner_hyb_p(ip1jmp1,psi,p,pks,pk)
         else
           CALL exner_milieu_p(ip1jmp1,psi,p,beta,pks,pk,pkf)
+          CALL exner_milieu_p(ip1jmp1,psi,p,pks,pk)
         endif
         unskap=1./kappa

LMDZ5/branches/testing/libf/dyn3dpar/iniacademic.F90

-                      r1910
+                      r2056
 SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
+  use exner_hyb_m, only: exner_hyb
+  use exner_milieu_m, only: exner_milieu
   USE filtreg_mod
   USE infotrac, ONLY : nqtot
 …
   REAL pks(ip1jmp1)                      ! exner au  sol
   REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
-  REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
   REAL phi(ip1jmp1,llm)                  ! geopotentiel
   REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
 …
   integer idum
   REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
+  REAL zdtvr
   character(len=*),parameter :: modname="iniacademic"
 …
         CALL pression ( ip1jmp1, ap, bp, ps, p       )
         if (pressure_exner) then
           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
         else
           call exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
+          CALL exner_hyb( ip1jmp1, ps, p, pks, pk )
+        else
+          call exner_milieu(ip1jmp1,ps,p,pks,pk)
         endif
         CALL massdair(p,masse)

LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F

-                      r1999
+                      r2056
      &                    time_0)
+      use exner_hyb_m, only: exner_hyb
+      use exner_milieu_m, only: exner_milieu
+      use exner_hyb_p_m, only: exner_hyb_p
+      use exner_milieu_p_m, only: exner_milieu_p
        USE misc_mod
        USE parallel_lmdz
 …
       character*10 string10
-      REAL,SAVE :: alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
       REAL,SAVE :: flxw(ip1jmp1,llm) ! flux de masse verticale
 …
       lafin=.false.
+      itaufin   = nday*day_step
+      if (nday>=0) then
+         itaufin   = nday*day_step
+      else
+         itaufin   = -nday
+      endif
       itaufinp1 = itaufin +1
 …
       CALL pression ( ip1jmp1, ap, bp, ps, p       )
       if (pressure_exner) then
         CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+        CALL exner_hyb( ip1jmp1, ps, p, pks, pk, pkf )
       else
         CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
+        CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
       endif
 c$OMP END MASTER
 …
 c$OMP BARRIER
          if (pressure_exner) then
            CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
+           CALL exner_hyb_p(  ip1jmp1, ps, p,pks, pk, pkf )
          else
            CALL exner_milieu_p( ip1jmp1, ps, p, beta, pks, pk, pkf )
+           CALL exner_milieu_p( ip1jmp1, ps, p, pks, pk, pkf )
          endif
+! Appel a geopot ajoute le 2014/05/08 pour garantir la convergence numerique
+! avec dyn3dmem
+      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
 c$OMP BARRIER
            jD_cur = jD_ref + day_ini - day_ref
 …
 c$OMP BARRIER
           if (pressure_exner) then
             CALL exner_hyb_p(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
+            CALL exner_hyb_p(ip1jmp1,ps,p,pks,pk,pkf)
           else
             CALL exner_milieu_p(ip1jmp1,ps,p,beta,pks,pk,pkf)
+            CALL exner_milieu_p(ip1jmp1,ps,p,pks,pk,pkf)
           endif
 c$OMP BARRIER
 …
 c$OMP BARRIER
         if (pressure_exner) then
           CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+          CALL exner_hyb_p( ip1jmp1, ps, p, pks, pk, pkf )
         else
           CALL exner_milieu_p( ip1jmp1, ps, p, beta, pks, pk, pkf )
+          CALL exner_milieu_p( ip1jmp1, ps, p, pks, pk, pkf )
         endif
 c$OMP BARRIER

LMDZ5/branches/testing/libf/dyn3dpar/mod_const_mpi.F90

-                      r1999
+                      r2056
     USE mod_prism
 #endif
+#ifdef CPP_XIOS
+    USE wxios, only: wxios_init
+#endif
     IMPLICIT NONE
 #ifdef CPP_MPI
 …
 #ifdef CPP_COUPLE
 !$OMP MASTER
+       CALL prism_init_comp_proto (comp_id, 'lmdz.x', ierr)
+#ifdef CPP_XIOS
+      CALL wxios_init("LMDZ", outcom=COMM_LMDZ, type_ocean=type_ocean)
+#else
+       CALL prism_init_comp_proto (comp_id, 'LMDZ', ierr)
        CALL prism_get_localcomm_proto(COMM_LMDZ,ierr)
+#endif
 !$OMP END MASTER
 #endif

LMDZ5/branches/testing/libf/dyn3dpar/parallel_lmdz.F90

-                      r1999
+                      r2056
       if (type_ocean == 'couple') then
+#ifdef CPP_XIOS
+    !Fermeture propre de XIOS
+      CALL wxios_close()
+#else
 #ifdef CPP_COUPLE
          call prism_terminate_proto(ierr)
 …
          endif
 #endif
+#endif
       else
 #ifdef CPP_XIOS

LMDZ5/branches/testing/libf/phydev/iophy.F90

-                      r1910
+                      r2056
   USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
                                 jj_nb, klon_mpi
   USE wxios, only: wxios_write_2D
+  USE xios, only: xios_send_field
 …
     CALL grid1Dto2D_mpi(buffer_omp,Field2d)
     CALL wxios_write_2D(field_name, Field2d)
+    CALL xios_send_field(field_name, Field2d)
 !$OMP END MASTER
 …
   USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
                                 jj_nb, klon_mpi
   USE wxios, only: wxios_write_3D
+  USE xios, only: xios_send_field
 …
     CALL grid1Dto2D_mpi(buffer_omp,field3d)
     CALL wxios_write_3D(field_name, Field3d(:,:,1:klev))
+    CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
 !$OMP END MASTER

LMDZ5/branches/testing/libf/phydev/physiq.F90

-                      r1910
+                      r2056
      &            flxmass_w, &
      &            d_u, d_v, d_t, d_qx, d_ps &
+     &            , dudyn &
+     &            , PVteta)
+     &            , dudyn)
       USE dimphy, only : klon,klev
 …
 #ifdef CPP_XIOS
+      USE xios, ONLY: xios_update_calendar
       USE wxios, only: wxios_add_vaxis, wxios_set_timestep, wxios_closedef, &
                        wxios_update_calendar, histwrite_phy
+                       histwrite_phy
 #endif
 …
       real,intent(out) :: d_ps(klon) ! physics tendency on surface pressure
       real,intent(in) :: dudyn(iim+1,jjmp1,klev) ! Not used
-!FH! REAL PVteta(klon,nbteta)
-!      REAL PVteta(klon,1)
-      real,intent(in) :: PVteta(klon,3) ! Not used ; should match definition
-                                        ! in calfis.F
 integer,save :: itau=0 ! counter to count number of calls to physics
 …
 #ifdef CPP_XIOS
 !XIOS
+    ! Déclaration de l'axe vertical du fichier:
+    CALL wxios_add_vaxis("presnivs", "histins", klev, presnivs)
+    !Déclaration du pas de temps:
+    ! Declare available vertical axes to be used in output files:
+    !CALL wxios_add_vaxis("presnivs", "dummy-not-used", klev, presnivs)
+    CALL wxios_add_vaxis("presnivs", klev, presnivs)
+    ! Declare time step length (in s):
     CALL wxios_set_timestep(dtime)
     !Finalisation du contexte:
+    !Finalize the context:
     CALL wxios_closedef()
 #endif
 …
 !$OMP MASTER
     !Increment XIOS time
     CALL wxios_update_calendar(itau)
+    CALL xios_update_calendar(itau)
 !$OMP END MASTER
 !$OMP BARRIER
+    !Send fields to XIOS:
+    !Send fields to XIOS: (NB these fields must also be defined as
+    ! <field id="..." /> in iodef.xml to be correctly used
     CALL histwrite_phy("temperature",t)
+    CALL histwrite_phy("temp_newton",temp_newton)
     CALL histwrite_phy("u",u)
     CALL histwrite_phy("v",v)

LMDZ5/branches/testing/libf/phylmd/YOETHF.h

-                      r1910
+                      r2056
+!
 ! $Header$
+! $Id$
+!
 !  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
 …
       REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES
       REAL RVTMP2, RHOH2O
+      REAL R5ALVCP,R5ALSCP,RALVDCP,RALSDCP,RALFDCP,RTWAT,RTBER,RTBERCU
+      REAL RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,RKOOP2
       COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES,    &
+     &               RVTMP2, RHOH2O
+     &               RVTMP2, RHOH2O,                                    &
+     &               R5ALVCP,R5ALSCP,RALVDCP,RALSDCP,                   &
+     &               RALFDCP,RTWAT,RTBER,RTBERCU,                       &
+     &               RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,&
+     &               RKOOP2
 !$OMP THREADPRIVATE(/YOETHF/)

LMDZ5/branches/testing/libf/phylmd/add_pbl_tend.F90

-                      r1999
+                      r2056
 SUBROUTINE add_pbl_tend(zdu, zdv, zdt, zdq, zdql, text)
+SUBROUTINE add_pbl_tend(zdu, zdv, zdt, zdq, zdql, paprs, text)
   ! ======================================================================
   ! Ajoute les tendances de couche limite, soit determinees par la
 …
   REAL zdt(klon, klev), zdq(klon, klev), zdql(klon, klev)
   CHARACTER *(*) text
+  REAL paprs(klon,klev+1)
   ! Local :
 …
     PRINT *, ' add_pbl_tend, zzdt ', zzdt
     PRINT *, ' add_pbl_tend, zzdq ', zzdq
     CALL add_phys_tend(zdu, zdv, zzdt, zzdq, zdql, text)
+    CALL add_phys_tend(zdu, zdv, zzdt, zzdq, zdql, paprs, text)
   ELSE
     CALL add_phys_tend(zdu, zdv, zdt, zdq, zdql, text)
+    CALL add_phys_tend(zdu, zdv, zdt, zdq, zdql, paprs, text)
   END IF

LMDZ5/branches/testing/libf/phylmd/add_phys_tend.F90

-                      r1910
+                      r2056
 ! $Id$
+!
 SUBROUTINE add_phys_tend (zdu,zdv,zdt,zdq,zdql,text)
+SUBROUTINE add_phys_tend (zdu,zdv,zdt,zdq,zdql,paprs,text)
 !======================================================================
 ! Ajoute les tendances des variables physiques aux variables
 …
 use phys_state_var_mod
 IMPLICIT none
+#include "iniprint.h"
+  include "iniprint.h"
+  include "YOMCST.h"
+  include "clesphys.h"
 ! Arguments :
 …
 REAL zdu(klon,klev),zdv(klon,klev)
 REAL zdt(klon,klev),zdq(klon,klev),zdql(klon,klev)
+REAL paprs(klon,klev+1)
 CHARACTER*(*) text
 …
 !--------
 REAL zt,zq
+REAL zq_int, zqp_int, zq_new
+REAL zqp(klev)
 INTEGER i, k,j
 …
 INTEGER kadrs(klon*klev)
 INTEGER kqadrs(klon*klev)
+LOGICAL done(klon)
 integer debug_level
 …
 !=====================================================================================
 IF (jqbad .GT. 0) THEN
+      done(:) = .false.                         !jyg
       DO j = 1, jqbad
+         i=jqadrs(j)
+         if(prt_level.ge.debug_level) THEN
+          print*,'WARNING  : EAU POUR LE POINT i rlon rlat =',i,rlon(i),rlat(i),text
+          print*,'l    T     dT       Q     dQ    '
+         endif
+         DO k = 1, klev
+           zq=q_seri(i,k)+zdq(i,k)
+           if (zq.lt.1.e-15) then
+              if (q_seri(i,k).lt.1.e-15) then
+               if(prt_level.ge.debug_level) THEN
+                print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
+               endif
+               q_seri(i,k)=1.e-15
+               zdq(i,k)=(1.e-15-q_seri(i,k))
+        i=jqadrs(j)
+          if(prt_level.ge.debug_level) THEN
+           print*,'WARNING  : EAU POUR LE POINT i rlon rlat =',i,rlon(i),rlat(i),text
+           print*,'l    T     dT       Q     dQ    '
+           DO k = 1, klev
+              write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
+           ENDDO
+          endif
+          IF (ok_conserv_q) THEN
+!jyg<20140228 Corrections pour conservation de l'eau
+            IF (.NOT.done(i)) THEN                  !jyg
+              DO k = 1, klev
+                zqp(k) = max(q_seri(i,k),1.e-15)
+              ENDDO
+              zq_int  = 0.
+              zqp_int = 0.
+              DO k = 1, klev
+                zq_int  = zq_int  + q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/Rg
+                zqp_int = zqp_int + zqp(k)     *(paprs(i,k)-paprs(i,k+1))/Rg
+              ENDDO
+              if(prt_level.ge.debug_level) THEN
+               print*,' cas q_seri<1.e-15 i k zq_int zqp_int zq_int/zqp_int :', &
+                                    i, kqadrs(j), zq_int, zqp_int, zq_int/zqp_int
               endif
+           endif
+!           zq=q_seri(i,k)+zdq(i,k)
+!           if (zq.lt.1.e-15) then
+!              zdq(i,k)=(1.e-15-q_seri(i,k))
+!           endif
+         ENDDO
+      ENDDO
+              DO k = 1, klev
+                zq_new = zqp(k)*zq_int/zqp_int
+                zdq(i,k) = zdq(i,k) + zq_new - q_seri(i,k)
+                q_seri(i,k) = zq_new
+              ENDDO
+              done(i) = .true.
+            ENDIF !(.NOT.done(i))
+          ELSE
+!jyg>
+            DO k = 1, klev
+              zq=q_seri(i,k)+zdq(i,k)
+              if (zq.lt.1.e-15) then
+                 if (q_seri(i,k).lt.1.e-15) then
+                  if(prt_level.ge.debug_level) THEN
+                   print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
+                  endif
+                  q_seri(i,k)=1.e-15
+                  zdq(i,k)=(1.e-15-q_seri(i,k))
+                 endif
+              endif
+!              zq=q_seri(i,k)+zdq(i,k)
+!              if (zq.lt.1.e-15) then
+!                 zdq(i,k)=(1.e-15-q_seri(i,k))
+!              endif
+            ENDDO
+!jyg<20140228
+          ENDIF   !  (ok_conserv_q)
+!jyg>
+      ENDDO ! j = 1, jqbad
 ENDIF
+!

LMDZ5/branches/testing/libf/phylmd/aero_mod.F90

-                      r1910
+                      r2056
+!
 MODULE aero_mod
   ! Declaration des indices pour les aerosols
+! Declaration des indices pour les aerosols
+  ! Total number of aerosols
 !  INTEGER, PARAMETER :: naero_tot = 10
+!--STRAT AER
+! 1/ Total number of aerosols for which an aerosol optical depth is provided
+!--strat aerosols are only prescribed naero_tot = 10 ==> 11
   INTEGER, PARAMETER :: naero_tot = 11
   ! Identification number used in aeropt_2bands and aeropt_5wv
   ! corresponding to naero_tot
+! Identification number used in aeropt_2bands and aeropt_5wv
+! corresponding to naero_tot
   INTEGER, PARAMETER :: id_ASBCM    = 1
   INTEGER, PARAMETER :: id_ASPOMM   = 2
 …
   INTEGER, PARAMETER :: id_AIBCM    = 9
   INTEGER, PARAMETER :: id_AIPOMM   = 10
+!--STRAT AER
+  INTEGER, PARAMETER :: id_strat   = 11
+  INTEGER, PARAMETER :: id_STRAT   = 11
+! Corresponding names for the aerosols
+  CHARACTER(len=7),DIMENSION(naero_tot), PARAMETER :: name_aero_tau=(/&
+       "ASBCM  ", &
+       "ASPOMM ", &
+       "SO4    ", &
+       "CSSO4M ", &
+       "SSSSM  ", &
+       "CSSSM  ", &
+       "ASSSM  ", &
+       "CIDUSTM", &
+       "AIBCM  ", &
+       "AIPOMM ", &
+       "STRAT  " /)
+  ! Total number of aerosols actually used in LMDZ
+  ! 1 =  ASBCM
+  ! 2 =  ASPOMM
+  ! 3 =  ASSO4M ( = SO4)
+  ! 4 =  CSSO4M
+  ! 5 =  SSSSM
+  ! 6 =  CSSSM
+  ! 7 =  ASSSM
+  ! 8 =  CIDUSTM
+  ! 9 =  AIBCM
+  !10 =  AIPOMM
+!--STRAT AER
+  !11 = aerosols stratos
+!  INTEGER, PARAMETER :: naero_spc = 10
+  INTEGER, PARAMETER :: naero_spc = 11
+! 2/ Total number of aerosols for which an aerosol mass is provided
+  ! Corresponding names for the aerosols
+  INTEGER, PARAMETER :: naero_spc = 10
+! Corresponding names for the aerosols
   CHARACTER(len=7),DIMENSION(naero_spc), PARAMETER :: name_aero=(/&
        "ASBCM  ", &
 …
        "CIDUSTM", &
        "AIBCM  ", &
+!       "AIPOMM " /)
+       "AIPOMM ", &
+       "STRAT  " /)
+       "AIPOMM " /)
   ! Number of aerosol groups
+! 3/ Number of aerosol groups
+  INTEGER, PARAMETER :: naero_grp = 9
   ! 1 = ZERO
   ! 2 = AER total
 …
   ! 8 = SS
   ! 9 = NO3
-  INTEGER, PARAMETER :: naero_grp = 9
   ! Number of  wavelengths
+! Number of  wavelengths
   INTEGER, PARAMETER :: nwave = 5
   ! Number of modes spectral bands
+! Number of modes spectral bands
   INTEGER, parameter :: nbands = 2
+  INTEGER, parameter :: nbands_rrtm = 6
 END MODULE aero_mod

LMDZ5/branches/testing/libf/phylmd/aeropt_2bands.F90

-                      r1910
+                      r2056
     ENDDO  ! nb_aer
+  DO m=1,nb_aer
+!correction bug OB
+!  DO m=1,nb_aer
+  DO m=1,naero_tot
     IF (.NOT. used_aer(m)) THEN
       tau_ae(:,:,m,:)=0.

LMDZ5/branches/testing/libf/phylmd/clesphys.h

-                      r1999
+                      r2056
        LOGICAL :: ok_strato
        LOGICAL :: ok_hines, ok_gwd_rando
+       LOGICAL :: ok_conserv_q
        COMMON/clesphys/                                                 &
 …
      &     , ok_lic_melt,           aer_type                            &
      &     , iflag_rrtm, ok_strato,ok_hines                             &
+     &     , iflag_ice_thermo, ok_gwd_rando, NSW
+     &     , iflag_ice_thermo, ok_gwd_rando, NSW                        &
+     &     , ok_conserv_q
        save /clesphys/

LMDZ5/branches/testing/libf/phylmd/coefcdrag.F90

-                      r1910
+                      r2056
       include "YOMCST.h"
       include "YOETHF.h"
+      INCLUDE "clesphys.h"
 ! Quelques constantes :
       REAL, parameter :: RKAR=0.40, CB=5.0, CC=5.0, CD=5.0, cepdu2=(0.1)**2
 …
                  (1.+ RETV * max(q(i),0.0))))
        ztsolv(i) = ts(i)
+       ztvd(i) = t(i) * (psol(i)/pref(i))**RKAPPA
+!       ztvd(i) = t(i) * (psol(i)/pref(i))**RKAPPA
+       ztvd(i) = (t(i)+zdphi(i)/RCPD/(1.+RVTMP2*q(i))) &
+          *(1.+RETV*q(i))
        trm0(i) = 1. + RETV * max(qsurf(i),0.0)
        trm1(i) = 1. + RETV * max(q(i),0.0)
        ztsolv(i) = ztsolv(i) * trm0(i)
        ztvd(i) = ztvd(i) * trm1(i)
+!       ztvd(i) = ztvd(i) * trm1(i)
        zri1(i) = zdphi(i)*(ztvd(i)-ztsolv(i))/(zdu2(i)*ztvd(i))
+!
 …
            zcfm1(i) = cdran(i) * friv(i)
            frih(i) = max(1./ (1.+3.*CB*zri1(i)*zscf(i)), 0.1 )
+           zcfh1(i) = cdran(i) * frih(i)
+!           zcfh1(i) = cdran(i) * frih(i)
+           zcfh1(i) = f_cdrag_ter*cdran(i) * frih(i)
+           IF(nsrf.EQ.is_oce) zcfh1(i)=f_cdrag_oce*cdran(i)*frih(i)
            cdram(i) = zcfm1(i)
            cdrah(i) = zcfh1(i)
 …
                  *(1.0+zdphi(i)/(RG*rugos(i)))))
            zcfm2(i) = cdran(i)*max((1.-2.0*CB*zri1(i)*zucf(i)),0.1)
+           zcfh2(i) = cdran(i)*max((1.-3.0*CB*zri1(i)*zucf(i)),0.1)
+!           zcfh2(i) = cdran(i)*max((1.-3.0*CB*zri1(i)*zucf(i)),0.1)
+           zcfh2(i) = f_cdrag_ter*cdran(i)*max((1.-3.0*CB*zri1(i)*zucf(i)),0.1)
            cdram(i) = zcfm2(i)
            cdrah(i) = zcfh2(i)
 …
          zcr(i) = (0.0016/(cdran(i)*SQRT(zdu2(i))))*ABS(ztvd(i)-ztsolv(i)) &
                **(1./3.)
+         IF (nsrf.EQ.is_oce) cdrah(i) = cdran(i)*(1.0+zcr(i)**1.25) &
+!         IF (nsrf.EQ.is_oce) cdrah(i) = cdran(i)*(1.0+zcr(i)**1.25) &
+!                  **(1./1.25)
+         IF (nsrf.EQ.is_oce) cdrah(i)=f_cdrag_oce*cdran(i)*(1.0+zcr(i)**1.25) &
                   **(1./1.25)
        ENDIF

LMDZ5/branches/testing/libf/phylmd/concvl.F90

-                      r1999
+                      r2056
+SUBROUTINE concvl(iflag_clos, dtime, paprs, pplay, t, q, t_wake, q_wake, &
+    s_wake, u, v, tra, ntra, ale, alp, sig1, w01, d_t, d_q, d_u, d_v, d_tra, &
+    rain, snow, kbas, ktop, sigd, cbmf, plcl, plfc, wbeff, upwd, dnwd, &
+    dnwdbis, ma, mip, vprecip, cape, cin, tvp, tconv, iflag, pbase, bbase, &
+    dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, & ! RomP
+                                                                      ! >>>
+  ! !     .             da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
+    da, phi, mp, phi2, d1a, dam, sij, clw, elij, & ! RomP
+    dd_t, dd_q, lalim_conv, wght_th, & ! RomP
+    evap, ep, epmlmmm, eplamm, &   ! RomP
+    wdtraina, wdtrainm) ! RomP
+  ! RomP <<<
+  ! **************************************************************
+  ! *
+  ! CONCVL                                                      *
+  ! *
+  ! *
+  ! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
+  ! modified by :                                               *
+  ! **************************************************************
+SUBROUTINE concvl(iflag_clos, &
+                  dtime, paprs, pplay, &
+                  t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
+                  Ale, Alp, sig1, w01, &
+                  d_t, d_q, d_u, d_v, d_tra, &
+                  rain, snow, kbas, ktop, sigd, &
+                  cbmf, plcl, plfc, wbeff, upwd, dnwd, dnwdbis, &
+                  Ma, mip, Vprecip, &
+                  cape, cin, tvp, Tconv, iflag, &
+                  pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, &
+                  qcondc, wd, pmflxr, pmflxs, &
+!RomP >>>
+!!     .             da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
+                  da, phi, mp, phi2, d1a, dam, sij, clw, elij, &     ! RomP
+                  dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
+                  evap, ep, epmlmMm, eplaMm, &                       ! RomP
+                  wdtrainA, wdtrainM, wght)                          ! RomP+RL
+!RomP <<<
+! **************************************************************
+! *
+! CONCVL                                                      *
+! *
+! *
+! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
+! modified by :                                               *
+! **************************************************************
 …
   USE infotrac, ONLY: nbtr
   IMPLICIT NONE
+  ! ======================================================================
+  ! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
+  ! Objet: schema de convection de Emanuel (1991) interface
+  ! ======================================================================
+  ! Arguments:
+  ! dtime--input-R-pas d'integration (s)
+  ! s-------input-R-la valeur "s" pour chaque couche
+  ! sigs----input-R-la valeur "sigma" de chaque couche
+  ! sig-----input-R-la valeur de "sigma" pour chaque niveau
+  ! psolpa--input-R-la pression au sol (en Pa)
+  ! pskapa--input-R-exponentiel kappa de psolpa
+  ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
+  ! q-------input-R-vapeur d'eau (en kg/kg)
+  ! work*: input et output: deux variables de travail,
+  ! on peut les mettre a 0 au debut
+  ! ALE-----input-R-energie disponible pour soulevement
+  ! ALP-----input-R-puissance disponible pour soulevement
+  ! d_h-----output-R-increment de l'enthalpie potentielle (h)
+  ! d_q-----output-R-increment de la vapeur d'eau
+  ! rain----output-R-la pluie (mm/s)
+  ! snow----output-R-la neige (mm/s)
+  ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
+  ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
+  ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
+  ! Ma------output-R-adiabatic ascent mass flux (kg/m2/s)
+  ! mip-----output-R-mass flux shed by adiabatic ascent (kg/m2/s)
+  ! Vprecip-output-R-vertical profile of precipitations (kg/m2/s)
+  ! Tconv---output-R-environment temperature seen by convective scheme (K)
+  ! Cape----output-R-CAPE (J/kg)
+  ! Cin ----output-R-CIN  (J/kg)
+  ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
+  ! adiabatiquement a partir du niveau 1 (K)
+  ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
+  ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
+  ! dd_t-----output-R-increment de la temperature du aux descentes
+  ! precipitantes
+  ! dd_q-----output-R-increment de la vapeur d'eau du aux desc precip
+  ! ======================================================================
+! ======================================================================
+! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
+! Objet: schema de convection de Emanuel (1991) interface
+! ======================================================================
+! Arguments:
+! dtime--input-R-pas d'integration (s)
+! s-------input-R-la vAleur "s" pour chaque couche
+! sigs----input-R-la vAleur "sigma" de chaque couche
+! sig-----input-R-la vAleur de "sigma" pour chaque niveau
+! psolpa--input-R-la pression au sol (en Pa)
+! pskapa--input-R-exponentiel kappa de psolpa
+! h-------input-R-enthAlpie potentielle (Cp*T/P**kappa)
+! q-------input-R-vapeur d'eau (en kg/kg)
+! work*: input et output: deux variables de travail,
+! on peut les mettre a 0 au debut
+! ALE--------input-R-energie disponible pour soulevement
+! ALP--------input-R-puissance disponible pour soulevement
+! d_h--------output-R-increment de l'enthAlpie potentielle (h)
+! d_q--------output-R-increment de la vapeur d'eau
+! rain-------output-R-la pluie (mm/s)
+! snow-------output-R-la neige (mm/s)
+! upwd-------output-R-saturated updraft mass flux (kg/m**2/s)
+! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s)
+! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s)
+! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s)
+! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s)
+! Vprecip----output-R-vertical profile of precipitations (kg/m2/s)
+! Tconv------output-R-environment temperature seen by convective scheme (K)
+! Cape-------output-R-CAPE (J/kg)
+! Cin -------output-R-CIN  (J/kg)
+! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee
+! adiabatiquement a partir du niveau 1 (K)
+! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa)
+! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace
+! dd_t-------output-R-increment de la temperature du aux descentes precipitantes
+! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip
+! lalim_conv-
+! wght_th----
+! evap-------output-R
+! ep---------output-R
+! epmlmMm----output-R
+! eplaMm-----output-R
+! wdtrainA---output-R
+! wdtrainM---output-R
+! wght-------output-R
+! ======================================================================
 …
   REAL sig1(klon, klev), w01(klon, klev), ptop2(klon)
   REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
   REAL ale(klon), alp(klon)
+  REAL Ale(klon), Alp(klon)
   REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, klev)
 …
   REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
+  ! !       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)     !jyg
+  REAL ma(klon, klev), mip(klon, klev), vprecip(klon, klev+1) !jyg
+!!       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)     !jyg
+  REAL Ma(klon, klev), mip(klon, klev), Vprecip(klon, klev+1)      !jyg
+  REAL wght(klon, klev)                                            !RL
   REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
   ! RomP >>>
+! RomP >>>
   REAL phi2(klon, klev, klev)
   REAL d1a(klon, klev), dam(klon, klev)
   REAL sij(klon, klev, klev), clw(klon, klev), elij(klon, klev, klev)
   REAL wdtraina(klon, klev), wdtrainm(klon, klev)
+  REAL wdtrainA(klon, klev), wdtrainM(klon, klev)
   REAL evap(klon, klev), ep(klon, klev)
   REAL epmlmmm(klon, klev, klev), eplamm(klon, klev)
   ! RomP <<<
+  REAL epmlmMm(klon, klev, klev), eplaMm(klon, klev)
+! RomP <<<
   REAL cape(klon), cin(klon), tvp(klon, klev)
   REAL tconv(klon, klev)
   ! CR:test: on passe lentr et alim_star des thermiques
+  REAL Tconv(klon, klev)
+!CR:test: on passe lentr et alim_star des thermiques
   INTEGER lalim_conv(klon)
   REAL wght_th(klon, klev)
 …
   REAL em_sig2feed ! sigma at upper bound of feeding layer
   REAL em_wght(klev) ! weight density determining the feeding mixture
   ! on enleve le save
   ! SAVE em_sig1feed,em_sig2feed,em_wght
+!on enleve le save
+! SAVE em_sig1feed,em_sig2feed,em_wght
   INTEGER iflag(klon)
 …
   REAL zx_t, zdelta, zx_qs, zcor
   ! INTEGER iflag_mix
   ! SAVE iflag_mix
+!   INTEGER iflag_mix
+!   SAVE iflag_mix
   INTEGER noff, minorig
   INTEGER i, k, itra
   REAL qs(klon, klev), qs_wake(klon, klev)
   REAL cbmf(klon), plcl(klon), plfc(klon), wbeff(klon)
   ! LF       SAVE cbmf
   ! IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
   ! cc$OMP THREADPRIVATE(cbmf)!
+!LF          SAVE cbmf
+!IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
+!!!$OMP THREADPRIVATE(cbmf)!
   REAL cbmflast(klon)
   INTEGER ifrst
   SAVE ifrst
   DATA ifrst/0/
   !$OMP THREADPRIVATE(ifrst)
   ! Variables supplementaires liees au bilan d'energie
   ! Real paire(klon)
   ! LF      Real ql(klon,klev)
   ! Save paire
   ! LF      Save ql
   ! LF      Real t1(klon,klev),q1(klon,klev)
   ! LF      Save t1,q1
   ! Data paire /1./
+!$OMP THREADPRIVATE(ifrst)
+! Variables supplementaires liees au bilan d'energie
+! Real paire(klon)
+!LF      Real ql(klon,klev)
+! Save paire
+!LF      Save ql
+!LF      Real t1(klon,klev),q1(klon,klev)
+!LF      Save t1,q1
+! Data paire /1./
   REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :)
   !$OMP THREADPRIVATE(ql, q1, t1)
   ! Variables liees au bilan d'energie et d'enthalpi
+!$OMP THREADPRIVATE(ql, q1, t1)
+! Variables liees au bilan d'energie et d'enthAlpi
   REAL ztsol(klon)
   REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, h_qs_tot, qw_tot, ql_tot, &
     qs_tot, ec_tot
   SAVE h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, h_qs_tot, qw_tot, ql_tot, &
     qs_tot, ec_tot
   !$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
   !$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
   REAL d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
   REAL d_h_vcol_phy
   REAL fs_bound, fq_bound
   SAVE d_h_vcol_phy
   !$OMP THREADPRIVATE(d_h_vcol_phy)
   REAL zero_v(klon)
+  REAL        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
+              h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
+  SAVE        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
+              h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
+!$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
+!$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
+  REAL        d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
+  REAL        d_h_vcol_phy
+  REAL        fs_bound, fq_bound
+  SAVE        d_h_vcol_phy
+!$OMP THREADPRIVATE(d_h_vcol_phy)
+  REAL        zero_v(klon)
   CHARACTER *15 ztit
   INTEGER ip_ebil ! PRINT level for energy conserv. diag.
   SAVE ip_ebil
   DATA ip_ebil/2/
   !$OMP THREADPRIVATE(ip_ebil)
   INTEGER if_ebil ! level for energy conserv. dignostics
   SAVE if_ebil
   DATA if_ebil/2/
   !$OMP THREADPRIVATE(if_ebil)
   ! +jld ec_conser
+  INTEGER     ip_ebil ! PRINT level for energy conserv. diag.
+  SAVE        ip_ebil
+  DATA        ip_ebil/2/
+!$OMP THREADPRIVATE(ip_ebil)
+  INTEGER     if_ebil ! level for energy conserv. dignostics
+  SAVE        if_ebil
+  DATA        if_ebil/2/
+!$OMP THREADPRIVATE(if_ebil)
+!+jld ec_conser
   REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique
   REAL zrcpd
   ! -jld ec_conser
   ! LF
+!-jld ec_conser
+!LF
   INTEGER nloc
   LOGICAL, SAVE :: first = .TRUE.
   !$OMP THREADPRIVATE(first)
   INTEGER, SAVE :: itap, igout
   !$OMP THREADPRIVATE(itap, igout)
+  LOGICAL, SAVE            :: first = .TRUE.
+!$OMP THREADPRIVATE(first)
+  INTEGER, SAVE            :: itap, igout
+!$OMP THREADPRIVATE(itap, igout)
   include "YOMCST.h"
 …
   IF (first) THEN
     ! Allocate some variables LF 04/2008
     ! IM/JYG allocate(cbmf(klon))
+! Allocate some variables LF 04/2008
+!IM/JYG allocate(cbmf(klon))
     ALLOCATE (ql(klon,klev))
     ALLOCATE (t1(klon,klev))
 …
     igout = klon/2 + 1/klon
   END IF
   ! Incrementer le compteur de la physique
+! Incrementer le compteur de la physique
   itap = itap + 1
   ! Copy T into Tconv
+! Copy T into Tconv
   DO k = 1, klev
     DO i = 1, klon
       tconv(i, k) = t(i, k)
+      Tconv(i, k) = t(i, k)
     END DO
   END DO
 …
   END IF
   ! ym
+! ym
   snow(:) = 0
   ! IF (ifrst .EQ. 0) THEN
   ! ifrst = 1
+! IF (ifrst .EQ. 0) THEN
+! ifrst = 1
   IF (first) THEN
     first = .FALSE.
     ! ===========================================================================
     ! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
     ! ===========================================================================
+! ===========================================================================
+! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
+! ===========================================================================
     IF (iflag_con==3) THEN
       ! CALL cv3_inicp()
+!      CALL cv3_inicp()
       CALL cv3_inip()
     END IF
+    ! ===========================================================================
+    ! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
+    ! ===========================================================================
+    ! c$$$         open (56,file='supcrit.data')
+    ! c$$$         read (56,*) Supcrit1, Supcrit2
+    ! c$$$         close (56)
+    IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, &
+      supcrit2
+    ! ===========================================================================
+    ! Initialisation pour les bilans d'eau et d'energie
+    ! ===========================================================================
+! ===========================================================================
+! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
+! ===========================================================================
+! c$$$         open (56,file='supcrit.data')
+! c$$$         read (56,*) Supcrit1, Supcrit2
+! c$$$         close (56)
+    IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2
+! ===========================================================================
+! Initialisation pour les bilans d'eau et d'energie
+! ===========================================================================
     IF (if_ebil>=1) d_h_vcol_phy = 0.
     DO i = 1, klon
       cbmf(i) = 0.
       ! !          plcl(i) = 0.
+!!          plcl(i) = 0.
       sigd(i) = 0.
     END DO
   END IF !(ifrst .EQ. 0)
   ! Initialisation a chaque pas de temps
+! Initialisation a chaque pas de temps
   plfc(:) = 0.
   wbeff(:) = 100.
 …
   ! Feeding layer
+! Feeding layer
   em_sig1feed = 1.
   em_sig2feed = 0.97
   ! em_sig2feed = 0.8
   ! Relative Weight densities
+! em_sig2feed = 0.8
+! Relative Weight densities
   DO k = 1, klev
     em_wght(k) = 1.
   END DO
   ! CRtest: couche alim des tehrmiques ponderee par a*
   ! DO i = 1, klon
   ! do k=1,lalim_conv(i)
   ! em_wght(k)=wght_th(i,k)
   ! print*,'em_wght=',em_wght(k),wght_th(i,k)
   ! end do
   ! END DO
+!CRtest: couche alim des tehrmiques ponderee par a*
+! DO i = 1, klon
+! do k=1,lalim_conv(i)
+! em_wght(k)=wght_th(i,k)
+! print*,'em_wght=',em_wght(k),wght_th(i,k)
+! end do
+! END DO
   IF (iflag_con==4) THEN
 …
       END DO
     END DO
+  ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la
+    ! convergence numerique)
+  ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
     DO k = 1, klev
       DO i = 1, klon
 …
   END IF ! iflag_con
   ! ------------------------------------------------------------------
   ! Main driver for convection:
   ! iflag_con=3 -> nvlle version de KE (JYG)
   ! iflag_con = 30  -> equivalent to convect3
   ! iflag_con = 4  -> equivalent to convect1/2
+! ------------------------------------------------------------------
+! Main driver for convection:
+!                   iflag_con=3 -> nvlle version de KE (JYG)
+!                   iflag_con = 30  -> equivAlent to convect3
+!                   iflag_con = 4  -> equivAlent to convect1/2
   IF (iflag_con==30) THEN
+    ! print *, '-> cv_driver'      !jyg
+    CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, t, q, qs, u, v, tra, &
+      em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain, vprecip, cbmf, &
+      sig1, w01, &                 !jyg
+      kbas, ktop, dtime, ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, da, phi, &
+      mp, phi2, d1a, dam, sij, clw, elij, & !RomP
+      evap, ep, epmlmmm, eplamm, & !RomP
+      wdtraina, wdtrainm) !RomP
+    ! print *, 'cv_driver ->'      !jyg
+    DO i = 1, klon
+      cbmf(i) = ma(i, kbas(i))
+    END DO
+! print *, '-> cv_driver'      !jyg
+    CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, &
+                   t, q, qs, u, v, tra, &
+                   em_p, em_ph, iflag, &
+                   d_t, d_q, d_u, d_v, d_tra, rain, &
+                   Vprecip, cbmf, sig1, w01, & !jyg
+                   kbas, ktop, &
+                   dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, &
+                   da, phi, mp, phi2, d1a, dam, sij, clw, elij, &       !RomP
+                   evap, ep, epmlmMm, eplaMm, &                         !RomP
+                   wdtrainA, wdtrainM)                                  !RomP
+!           print *, 'cv_driver ->'      !jyg
+    DO i = 1, klon
+      cbmf(i) = Ma(i, kbas(i))
+    END DO
+!RL
+    wght(:, :) = 0.
+    DO i = 1, klon
+      wght(i, 1) = 1.
+    END DO
+!RL
   ELSE
     ! LF   necessary for gathered fields
+!LF   necessary for gathered fields
     nloc = klon
+    CALL cva_driver(klon, klev, klev+1, ntra, nloc, iflag_con, iflag_mix, &
+      iflag_ice_thermo, iflag_clos, dtime, t, q, qs, t_wake, q_wake, qs_wake, &
+      s_wake, u, v, tra, em_p, em_ph, ale, alp, em_sig1feed, em_sig2feed, &
+      em_wght, iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, cbmf, &
+      plcl, plfc, wbeff, sig1, w01, ptop2, sigd, ma, mip, vprecip, upwd, &
+      dnwd, dnwdbis, qcondc, wd, cape, cin, tvp, dd_t, dd_q, plim1, plim2, &
+      asupmax, supmax0, asupmaxmin, lalim_conv, & ! AC!+!RomP+jyg
+      da, phi, mp, phi2, d1a, dam, sij, clw, elij, & ! RomP
+      evap, ep, epmlmmm, eplamm, & ! RomP
+      wdtraina, wdtrainm) ! RomP
+    ! AC!+!RomP+jyg
+    CALL cva_driver(klon, klev, klev+1, ntra, nloc, &
+                    iflag_con, iflag_mix, iflag_ice_thermo, &
+                    iflag_clos, ok_conserv_q, dtime, &
+                    t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
+                    em_p, em_ph, &
+                    Ale, Alp, &
+                    em_sig1feed, em_sig2feed, em_wght, &
+                    iflag, d_t, d_q, d_u, d_v, d_tra, rain, kbas, ktop, &
+                    cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
+                    Ma, mip, Vprecip, upwd, dnwd, dnwdbis, qcondc, wd, &
+                    cape, cin, tvp, &
+                    dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
+                    asupmaxmin, lalim_conv, &
+!AC!+!RomP+jyg
+!!                   da,phi,mp,phi2,d1a,dam,sij,clw,elij, &               ! RomP
+!!                   evap,ep,epmlmMm,eplaMm,                              ! RomP
+                    da, phi, mp, phi2, d1a, dam, sij, wght, &           ! RomP+RL
+                    clw, elij, evap, ep, epmlmMm, eplaMm, &             ! RomP+RL
+                    wdtrainA, wdtrainM)                                 ! RomP
+!AC!+!RomP+jyg
   END IF
   ! ------------------------------------------------------------------
   IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff ' &
     , cbmf(1), plcl(1), plfc(1), wbeff(1)
+! ------------------------------------------------------------------
+  IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff ', &
+                                         cbmf(1), plcl(1), plfc(1), wbeff(1)
   DO i = 1, klon
 …
       DO k = 1, klev
         DO i = 1, klon
+          d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
+!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
+          d_tra(i, k, itra) = 0.
         END DO
       END DO
 …
   END IF
   ! !AC!
+!!AC!
   IF (iflag_con==3) THEN
     DO itra = 1, ntra
       DO k = 1, klev
         DO i = 1, klon
+          d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
+!RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
+          d_tra(i, k, itra) = 0.
         END DO
       END DO
     END DO
   END IF
   ! !AC!
+!!AC!
   DO k = 1, klev
 …
     END DO
   END DO
   ! !jyg
   ! --Separation neige/pluie (pour diagnostics)       !jyg
   DO k = 1, klev !jyg
     DO i = 1, klon !jyg
       IF (t1(i,k)<rtt) THEN !jyg
         pmflxs(i, k) = vprecip(i, k) !jyg
       ELSE !jyg
         pmflxr(i, k) = vprecip(i, k) !jyg
       END IF !jyg
     END DO !jyg
   END DO !jyg
   ! c      IF (if_ebil.ge.2) THEN
   ! c        ztit='after convect'
   ! c        CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
   ! c     e      , t1,q1,ql,qs,u,v,paprs,pplay
   ! c     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
   ! c         call diagphy(paire,ztit,ip_ebil
   ! c     e      , zero_v, zero_v, zero_v, zero_v, zero_v
   ! c     e      , zero_v, rain, zero_v, ztsol
   ! c     e      , d_h_vcol, d_qt, d_ec
   ! c     s      , fs_bound, fq_bound )
   ! c      END IF
   ! les traceurs ne sont pas mis dans cette version de convect4:
+!                                                   !jyg
+! --Separation neige/pluie (pour diagnostics)       !jyg
+  DO k = 1, klev                                    !jyg
+    DO i = 1, klon                                  !jyg
+      IF (t1(i,k)<rtt) THEN                         !jyg
+        pmflxs(i, k) = Vprecip(i, k)                !jyg
+      ELSE                                          !jyg
+        pmflxr(i, k) = Vprecip(i, k)                !jyg
+      END IF                                        !jyg
+    END DO                                          !jyg
+  END DO                                            !jyg
+! c      IF (if_ebil.ge.2) THEN
+! c        ztit='after convect'
+! c        CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
+! c     e      , t1,q1,ql,qs,u,v,paprs,pplay
+! c     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+! c         call diagphy(paire,ztit,ip_ebil
+! c     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+! c     e      , zero_v, rain, zero_v, ztsol
+! c     e      , d_h_vcol, d_qt, d_ec
+! c     s      , fs_bound, fq_bound )
+! c      END IF
+! les traceurs ne sont pas mis dans cette version de convect4:
   IF (iflag_con==4) THEN
     DO itra = 1, ntra
 …
     END DO
   END IF
   ! print*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
+! print*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
   DO k = 1, klev
 …
   IF (prt_level>=20) THEN
     DO k = 1, klev
+      ! print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout
+      ! .,k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k),
       ! .d_q_con(igout,k),dql0(igout,k)
+      ! print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q'
+      ! .,itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout),
       ! . t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
+      ! print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip'
+      ! .,itap,rain_con(igout),snow_con(igout),ema_work1(igout,k),
       ! .ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
+      ! print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv '
+      ! .,itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout),
       ! .tvp(igout,k),Tconv(igout,k)
+      ! print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc'
+      ! .,itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout),
       ! .dplcldr(igout),qcondc(igout,k)
+      ! print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1'
+      ! .,itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k)
       ! .,pmflxs(igout,k+1)
+      ! print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth',
+      ! .itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k),
       ! . fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
+! print*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, &
+!         k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), &
+!         d_q_con(igout,k),dql0(igout,k)
+! print*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', &
+!         itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), &
+!         t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
+! print*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', &
+!         itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), &
+!         ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
+! print*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', &
+!         itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), &
+!         tvp(igout,k),Tconv(igout,k)
+! print*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', &
+!         itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), &
+!         dplcldr(igout),qcondc(igout,k)
+! print*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', &
+!         itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), &
+!         pmflxs(igout,k+1)
+! print*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', &
+!         itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), &
+!         fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
     END DO
   END IF !(prt_level.EQ.20) THEN

LMDZ5/branches/testing/libf/phylmd/conf_phys_m.F90

-                      r1999
+                      r2056
     real,save :: seuil_inversion_omp
+    integer,SAVE :: iflag_thermals_ed_omp,iflag_thermals_optflux_omp
+    integer,SAVE :: iflag_thermals_ed_omp,iflag_thermals_optflux_omp,iflag_thermals_closure_omp
+    real, SAVE :: fact_thermals_ed_dz_omp
     integer,SAVE :: iflag_thermals_omp,nsplit_thermals_omp
     real,save :: tau_thermals_omp,alp_bl_k_omp
 …
     INTEGER,SAVE :: iflag_pdf_omp
     INTEGER,SAVE :: iflag_ice_thermo_omp
+    INTEGER,SAVE :: iflag_t_glace_omp
     REAL,SAVE :: rad_froid_omp, rad_chau1_omp, rad_chau2_omp
     REAL,SAVE :: t_glace_min_omp, t_glace_max_omp
+    REAL,SAVE :: exposant_glace_omp
     REAL,SAVE :: rei_min_omp, rei_max_omp
     REAL,SAVE :: inertie_sol_omp,inertie_sno_omp,inertie_ice_omp
 …
     INTEGER, SAVE :: nbapp_rad_omp, iflag_con_omp
     INTEGER, SAVE :: iflag_ener_conserv_omp
+    LOGICAL, SAVE :: ok_conserv_q_omp
     INTEGER, SAVE :: iflag_fisrtilp_qsat_omp
     LOGICAL,SAVE :: ok_strato_omp
 …
     iflag_ener_conserv_omp = -1
     CALL getin('iflag_ener_conserv',iflag_ener_conserv_omp)
+    !Config  Key  = ok_conserv_q
+    !Config  Desc = Switch des corrections de conservation de l'eau
+    !Config  Def  = y
+    !Config  Help = Switch des corrections de conservation de l'eau
+    !Config         y -> corrections activees
+    !Config         n -> conformite avec versions anterieures au 1/4/2014
+    ok_conserv_q_omp = .FALSE.
+    CALL getin('ok_conserv_q',ok_conserv_q_omp)
     !Config  Key  = iflag_fisrtilp_qsat
 …
+    !
+    !Config Key  = exposant_glace
+    !Config Desc =
+    !Config Def  = 2.
+    !Config Help =
+    !
+    exposant_glace_omp = 1.
+    call getin('exposant_glace',exposant_glace_omp)
+    !
+    !Config Key  = iflag_t_glace
+    !Config Desc =
+    !Config Def  = 0
+    !Config Help =
+    !
+    iflag_t_glace_omp = 0
+    call getin('iflag_t_glace',iflag_t_glace_omp)
+    !
     !Config Key  = iflag_ice_thermo
     !Config Desc =
 …
     call getin('iflag_thermals',iflag_thermals_omp)
+    !
+    !Config Key  = iflag_thermals_ed
+    !Config Desc =
+    !Config Def  = 0
+    !Config Help =
+    !
+    fact_thermals_ed_dz_omp = 0.1
+    call getin('fact_thermals_ed_dz',fact_thermals_ed_dz_omp)
+    !
+    !
     !Config Key  = iflag_thermals_ed
 …
     iflag_thermals_optflux_omp = 0
     call getin('iflag_thermals_optflux',iflag_thermals_optflux_omp)
+    !
+    !Config Key  = iflag_thermals_closure
+    !Config Desc =
+    !Config Def  = 0
+    !Config Help =
+    !
+    iflag_thermals_closure_omp = 1
+    call getin('iflag_thermals_closure',iflag_thermals_closure_omp)
+    !
+    !
+    !
+    !
 …
     iflag_con = iflag_con_omp
     iflag_ener_conserv = iflag_ener_conserv_omp
+    ok_conserv_q = ok_conserv_q_omp
     iflag_fisrtilp_qsat = iflag_fisrtilp_qsat_omp
 …
     t_glace_min = t_glace_min_omp
     t_glace_max = t_glace_max_omp
+    exposant_glace = exposant_glace_omp
+    iflag_t_glace = iflag_t_glace_omp
     iflag_ice_thermo = iflag_ice_thermo_omp
     rei_min = rei_min_omp
 …
     iflag_thermals = iflag_thermals_omp
     iflag_thermals_ed = iflag_thermals_ed_omp
+    fact_thermals_ed_dz = fact_thermals_ed_dz_omp
     iflag_thermals_optflux = iflag_thermals_optflux_omp
+    iflag_thermals_closure = iflag_thermals_closure_omp
     nsplit_thermals = nsplit_thermals_omp
     tau_thermals = tau_thermals_omp
 …
     write(lunout,*)'iflag_con=',iflag_con
     write(lunout,*)'iflag_ener_conserv=',iflag_ener_conserv
+    write(lunout,*)'ok_conserv_q=',ok_conserv_q
     write(lunout,*)'iflag_fisrtilp_qsat=',iflag_fisrtilp_qsat
     write(lunout,*)' epmax = ', epmax
 …
     write(lunout,*)' t_glace_min = ',t_glace_min
     write(lunout,*)' t_glace_max = ',t_glace_max
+    write(lunout,*)' exposant_glace = ',exposant_glace
+    write(lunout,*)' iflag_t_glace = ',iflag_t_glace
     write(lunout,*)' iflag_ice_thermo = ',iflag_ice_thermo
     write(lunout,*)' rei_min = ',rei_min
 …
     write(lunout,*)' iflag_thermals = ', iflag_thermals
     write(lunout,*)' iflag_thermals_ed = ', iflag_thermals_ed
+    write(lunout,*)' fact_thermals_ed_dz = ', fact_thermals_ed_dz
     write(lunout,*)' iflag_thermals_optflux = ', iflag_thermals_optflux
+    write(lunout,*)' iflag_thermals_closure = ', iflag_thermals_closure
     write(lunout,*)' iflag_clos = ', iflag_clos
     write(lunout,*)' type_run = ',type_run

LMDZ5/branches/testing/libf/phylmd/cv3_routines.F90

-                      r1999
+                      r2056
   IMPLICIT NONE
   ! ------------------------------------------------------------
   ! Set parameters for convectL for iflag_con = 3
   ! ------------------------------------------------------------
   ! ***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE ***
   ! ***      PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO     ***
   ! ***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP. ***
   ! ***            EFFICIENCY IS ASSUMED TO BE UNITY            ***
   ! ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
   ! ***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE ***
   ! ***                        OF CLOUD                         ***
   ! [TAU: CHARACTERISTIC TIMESCALE USED TO COMPUTE ALPHA & BETA]
   ! ***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF ***
   ! ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
   ! ***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY) ***
   ! ***           (BETA MUST BE LESS THAN OR EQUAL TO 1)        ***
   ! ***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE ***
   ! ***                 APPROACH TO QUASI-EQUILIBRIUM           ***
   ! ***                     IT MUST BE LESS THAN 0              ***
+!------------------------------------------------------------
+!Set parameters for convectL for iflag_con = 3
+!------------------------------------------------------------
+!***  PBCRIT IS THE CRITICAL CLOUD DEPTH (MB) BENEATH WHICH THE ***
+!***      PRECIPITATION EFFICIENCY IS ASSUMED TO BE ZERO     ***
+!***  PTCRIT IS THE CLOUD DEPTH (MB) ABOVE WHICH THE PRECIP. ***
+!***            EFFICIENCY IS ASSUMED TO BE UNITY            ***
+!***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
+!***  SPFAC IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE ***
+!***                        OF CLOUD                         ***
+![TAU: CHARACTERISTIC TIMESCALE USED TO COMPUTE ALPHA & BETA]
+!***    ALPHA AND BETA ARE PARAMETERS THAT CONTROL THE RATE OF ***
+!***                 APPROACH TO QUASI-EQUILIBRIUM           ***
+!***    (THEIR STANDARD VALUES ARE 1.0 AND 0.96, RESPECTIVELY) ***
+!***           (BETA MUST BE LESS THAN OR EQUAL TO 1)        ***
+!***    DTCRIT IS THE CRITICAL BUOYANCY (K) USED TO ADJUST THE ***
+!***                 APPROACH TO QUASI-EQUILIBRIUM           ***
+!***                     IT MUST BE LESS THAN 0              ***
   include "cv3param.h"
 …
   LOGICAL, SAVE :: first = .TRUE.
   !$OMP THREADPRIVATE(first)
   ! noff: integer limit for convection (nd-noff)
   ! minorig: First level of convection
   ! -- limit levels for convection:
+!$OMP THREADPRIVATE(first)
+!glb  noff: integer limit for convection (nd-noff)
+! minorig: First level of convection
+! -- limit levels for convection:
   noff = 1
 …
   IF (first) THEN
     ! -- "microphysical" parameters:
+! -- "microphysical" parameters:
     sigdz = 0.01
     spfac = 0.15
     pbcrit = 150.0
     ptcrit = 500.0
     ! IM beg: ajout fis. reglage ep
+! IM beg: ajout fis. reglage ep
     flag_epkeorig = 1
     elcrit = 0.0003
     tlcrit = -55.0
     ! IM lu dans physiq.def via conf_phys.F90     epmax  = 0.993
+! IM lu dans physiq.def via conf_phys.F90     epmax  = 0.993
     omtrain = 45.0 ! used also for snow (no disctinction rain/snow)
     ! -- misc:
+! -- misc:
     dtovsh = -0.2 ! dT for overshoot
     dpbase = -40. ! definition cloud base (400m above LCL)
     ! cc      dttrig = 5.   ! (loose) condition for triggering
+! cc      dttrig = 5.   ! (loose) condition for triggering
     dttrig = 10. ! (loose) condition for triggering
     flag_wb = 1
     wbmax = 6. ! (m/s) adiab updraught speed at LFC (used in cv3p1_closure)
     ! -- rate of approach to quasi-equilibrium:
+! -- rate of approach to quasi-equilibrium:
     dtcrit = -2.0
     tau = 8000.
     ! -- interface cloud parameterization:
+! -- interface cloud parameterization:
     delta = 0.01 ! cld
     ! -- interface with boundary-layer (gust factor): (sb)
+! -- interface with boundary-layer (gust factor): (sb)
     betad = 10.0 ! original value (from convect 4.3)
+    OPEN (99, FILE='conv_param.data', STATUS='old', FORM='formatted', &
+      ERR=9999)
+    OPEN (99, FILE='conv_param.data', STATUS='old', FORM='formatted', ERR=9999)
     READ (99, *, END=9998) dpbase
     READ (99, *, END=9998) pbcrit
 …
     WRITE (*, *) 'wbmax =', wbmax
     ! IM Lecture du fichier ep_param.data
+! IM Lecture du fichier ep_param.data
     OPEN (79, FILE='ep_param.data', STATUS='old', FORM='formatted', ERR=7999)
     READ (79, *, END=7998) flag_epkeorig
 …
     WRITE (*, *) 'elcrit=', elcrit
     WRITE (*, *) 'tlcrit=', tlcrit
     ! IM end: ajout fis. reglage ep
+! IM end: ajout fis. reglage ep
     first = .FALSE.
+  END IF
+  END IF ! (first)
+! print*,'tau=',tau
   beta = 1.0 - delt/tau
   alpha1 = 1.5E-3
   ! jyg    Correction bug alpha
+!JYG    Correction bug alpha
   alpha1 = alpha1*1.5
   alpha = alpha1*delt/tau
   ! jyg    Bug
   ! cc increase alpha to compensate W decrease:
   ! c      alpha  = alpha*1.5
+!JYG    Bug
+! cc increase alpha to compensate W decrease:
+! c      alpha  = alpha*1.5
   RETURN
 END SUBROUTINE cv3_param
 SUBROUTINE cv3_prelim(len, nd, ndp1, t, q, p, ph, lv, lf, cpn, tv, gz, h, hm, &
     th)
+SUBROUTINE cv3_prelim(len, nd, ndp1, t, q, p, ph, &
+                      lv, lf, cpn, tv, gz, h, hm, th)
   IMPLICIT NONE
   ! =====================================================================
   ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
   ! "ori": from convect4.3 (vectorized)
   ! "convect3": to be exactly consistent with convect3
   ! =====================================================================
   ! inputs:
+! =====================================================================
+! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
+! "ori": from convect4.3 (vectorized)
+! "convect3": to be exactly consistent with convect3
+! =====================================================================
+! inputs:
   INTEGER len, nd, ndp1
   REAL t(len, nd), q(len, nd), p(len, nd), ph(len, ndp1)
   ! outputs:
+! outputs:
   REAL lv(len, nd), lf(len, nd), cpn(len, nd), tv(len, nd)
   REAL gz(len, nd), h(len, nd), hm(len, nd)
   REAL th(len, nd)
   ! local variables:
+! local variables:
   INTEGER k, i
   REAL rdcp
 …
   ! ori      do 110 k=1,nlp
   ! abderr     do 110 k=1,nl ! convect3
+! ori      do 110 k=1,nlp
+! abderr     do 110 k=1,nl ! convect3
   DO k = 1, nlp
     DO i = 1, len
       ! debug          lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
+! debug          lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
       lv(i, k) = lv0 - clmcpv*(t(i,k)-273.15)
       lf(i, k) = lf0 - clmci*(t(i,k)-273.15)
       cpn(i, k) = cpd*(1.0-q(i,k)) + cpv*q(i, k)
       cpx(i, k) = cpd*(1.0-q(i,k)) + cl*q(i, k)
       ! ori          tv(i,k)=t(i,k)*(1.0+q(i,k)*epsim1)
+! ori          tv(i,k)=t(i,k)*(1.0+q(i,k)*epsim1)
       tv(i, k) = t(i, k)*(1.0+q(i,k)/eps-q(i,k))
       rdcp = (rrd*(1.-q(i,k))+q(i,k)*rrv)/cpn(i, k)
 …
   END DO
   ! gz = phi at the full levels (same as p).
+! gz = phi at the full levels (same as p).
   DO i = 1, len
     gz(i, 1) = 0.0
   END DO
   ! ori      do 140 k=2,nlp
+! ori      do 140 k=2,nlp
   DO k = 2, nl ! convect3
     DO i = 1, len
       tvx = t(i, k)*(1.+q(i,k)/eps-q(i,k)) !convect3
       tvy = t(i, k-1)*(1.+q(i,k-1)/eps-q(i,k-1)) !convect3
       gz(i, k) = gz(i, k-1) + 0.5*rrd*(tvx+tvy) & !convect3
         *(p(i,k-1)-p(i,k))/ph(i, k) !convect3
       ! c        print *,' gz(',k,')',gz(i,k),' tvx',tvx,' tvy ',tvy
       ! ori         gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
       ! ori    &         *(p(i,k-1)-p(i,k))/ph(i,k)
     END DO
   END DO
   ! h  = phi + cpT (dry static energy).
   ! hm = phi + cp(T-Tbase)+Lq
   ! ori      do 170 k=1,nlp
+      tvx = t(i, k)*(1.+q(i,k)/eps-q(i,k))         !convect3
+      tvy = t(i, k-1)*(1.+q(i,k-1)/eps-q(i,k-1))   !convect3
+      gz(i, k) = gz(i, k-1) + 0.5*rrd*(tvx+tvy)* & !convect3
+                 (p(i,k-1)-p(i,k))/ph(i, k)        !convect3
+! c        print *,' gz(',k,')',gz(i,k),' tvx',tvx,' tvy ',tvy
+! ori         gz(i,k)=gz(i,k-1)+hrd*(tv(i,k-1)+tv(i,k))
+! ori    &         *(p(i,k-1)-p(i,k))/ph(i,k)
+    END DO
+  END DO
+! h  = phi + cpT (dry static energy).
+! hm = phi + cp(T-Tbase)+Lq
+! ori      do 170 k=1,nlp
   DO k = 1, nl ! convect3
     DO i = 1, len
 …
 END SUBROUTINE cv3_prelim
+SUBROUTINE cv3_feed(len, nd, t, q, u, v, p, ph, hm, gz, p1feed, p2feed, wght, &
+    wghti, tnk, thnk, qnk, qsnk, unk, vnk, cpnk, hnk, nk, icb, icbmax, iflag, &
+    gznk, plcl)
+SUBROUTINE cv3_feed(len, nd, ok_conserv_q, &
+                    t, q, u, v, p, ph, hm, gz, &
+                    p1feed, p2feed, wght, &
+                    wghti, tnk, thnk, qnk, qsnk, unk, vnk, &
+                    cpnk, hnk, nk, icb, icbmax, iflag, gznk, plcl)
   IMPLICIT NONE
   ! ================================================================
   ! Purpose: CONVECTIVE FEED
   ! Main differences with cv_feed:
   ! - ph added in input
   ! - here, nk(i)=minorig
   ! - icb defined differently (plcl compared with ph instead of p)
   ! Main differences with convect3:
   ! - we do not compute dplcldt and dplcldr of CLIFT anymore
   ! - values iflag different (but tests identical)
   ! - A,B explicitely defined (!...)
   ! ================================================================
+! ================================================================
+! Purpose: CONVECTIVE FEED
+! Main differences with cv_feed:
+! - ph added in input
+! - here, nk(i)=minorig
+! - icb defined differently (plcl compared with ph instead of p)
+! Main differences with convect3:
+! - we do not compute dplcldt and dplcldr of CLIFT anymore
+! - values iflag different (but tests identical)
+! - A,B explicitely defined (!...)
+! ================================================================
   include "cv3param.h"
   include "cvthermo.h"
   ! inputs:
+!inputs:
   INTEGER len, nd
+  LOGICAL ok_conserv_q
   REAL t(len, nd), q(len, nd), p(len, nd)
   REAL u(len, nd), v(len, nd)
 …
   REAL ph(len, nd+1)
   REAL p1feed(len)
   ! ,  wght(len)
+! ,  wght(len)
   REAL wght(nd)
   ! input-output
+!input-output
   REAL p2feed(len)
   ! outputs:
+!outputs:
   INTEGER iflag(len), nk(len), icb(len), icbmax
   ! real   wghti(len)
+!   real   wghti(len)
   REAL wghti(len, nd)
   REAL tnk(len), thnk(len), qnk(len), qsnk(len)
 …
   REAL plcl(len)
   ! local variables:
+!local variables:
   INTEGER i, k, iter, niter
   INTEGER ihmin(len)
 …
   REAL pup(len), plo(len), pfeed(len)
   REAL plclup(len), plcllo(len), plclfeed(len)
+  REAL pfeedmin(len)
   REAL posit(len)
   LOGICAL nocond(len)
+  ! -------------------------------------------------------------------
+  ! --- Origin level of ascending parcels for convect3:
+  ! -------------------------------------------------------------------
+!jyg20140217<
+  INTEGER iostat
+  LOGICAL, SAVE :: first
+  LOGICAL, SAVE :: ok_new_feed
+  REAL, SAVE :: dp_lcl_feed
+!$OMP THREADPRIVATE (first,ok_new_feed,dp_lcl_feed)
+  DATA first/.TRUE./
+  DATA dp_lcl_feed/2./
+  IF (first) THEN
+!$OMP MASTER
+    ok_new_feed = ok_conserv_q
+    OPEN (98, FILE='cv3feed_param.data', STATUS='old', FORM='formatted', IOSTAT=iostat)
+    IF (iostat==0) THEN
+      READ (98, *, END=998) ok_new_feed
+   CONTINUE
+      CLOSE (98)
+    END IF
+    PRINT *, ' ok_new_feed: ', ok_new_feed
+    first = .FALSE.
+!$OMP END MASTER
+  END IF
+!jyg>
+! -------------------------------------------------------------------
+! --- Origin level of ascending parcels for convect3:
+! -------------------------------------------------------------------
   DO i = 1, len
 …
   END DO
   ! -------------------------------------------------------------------
   ! --- Adjust feeding layer thickness so that lifting up to the top of
   ! --- the feeding layer does not induce condensation (i.e. so that
   ! --- plcl < p2feed).
   ! --- Method : iterative secant method.
   ! -------------------------------------------------------------------
   ! 1- First bracketing of the solution : ph(nk+1), p2feed
   ! 1.a- LCL associated to p2feed
+! -------------------------------------------------------------------
+! --- Adjust feeding layer thickness so that lifting up to the top of
+! --- the feeding layer does not induce condensation (i.e. so that
+! --- plcl < p2feed).
+! --- Method : iterative secant method.
+! -------------------------------------------------------------------
+! 1- First bracketing of the solution : ph(nk+1), p2feed
+! 1.a- LCL associated with p2feed
   DO i = 1, len
     pup(i) = p2feed(i)
   END DO
+  CALL cv3_vertmix(len, nd, iflag, p1feed, pup, p, ph, t, q, u, v, wght, &
+    wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
+  ! 1.b- LCL associated to ph(nk+1)
+  CALL cv3_vertmix(len, nd, iflag, p1feed, pup, p, ph, &
+                   t, q, u, v, wght, &
+                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclup)
+! 1.b- LCL associated with ph(nk+1)
   DO i = 1, len
     plo(i) = ph(i, nk(i)+1)
   END DO
+  CALL cv3_vertmix(len, nd, iflag, p1feed, plo, p, ph, t, q, u, v, wght, &
+    wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+  ! 2- Iterations
+  CALL cv3_vertmix(len, nd, iflag, p1feed, plo, p, ph, &
+                   t, q, u, v, wght, &
+                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plcllo)
+! 2- Iterations
   niter = 5
   DO iter = 1, niter
 …
         pfeed(i) = pup(i)
       ELSE
+        pfeed(i) = (pup(i)*(plo(i)-plcllo(i))+plo(i)*(plclup(i)-pup(i)))/ &
+          (plo(i)-plcllo(i)+plclup(i)-pup(i))
+!JYG20140217<
+        IF (ok_new_feed) THEN
+          pfeed(i) = (pup(i)*(plo(i)-plcllo(i)-dp_lcl_feed)+  &
+                      plo(i)*(plclup(i)-pup(i)+dp_lcl_feed))/ &
+                     (plo(i)-plcllo(i)+plclup(i)-pup(i))
+        ELSE
+          pfeed(i) = (pup(i)*(plo(i)-plcllo(i))+  &
+                      plo(i)*(plclup(i)-pup(i)))/ &
+                     (plo(i)-plcllo(i)+plclup(i)-pup(i))
+        END IF
+!JYG>
       END IF
     END DO
+    CALL cv3_vertmix(len, nd, iflag, p1feed, pfeed, p, ph, t, q, u, v, wght, &
+      wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+!jyg20140217<
+! For the last iteration, make sure that the top of the feeding layer
+! and LCL are not in the same layer:
+    IF (ok_new_feed) THEN
+      IF (iter==niter) THEN
+        DO k = minorig, nd
+          DO i = 1, len
+            IF (ph(i,k)>=plclfeed(i)) pfeedmin(i) = ph(i, k)
+          END DO
+        END DO
+        DO i = 1, len
+          pfeed(i) = max(pfeedmin(i), pfeed(i))
+        END DO
+      END IF
+    END IF
+!jyg>
+    CALL cv3_vertmix(len, nd, iflag, p1feed, pfeed, p, ph, &
+                   t, q, u, v, wght, &
+                   wghti, nk, tnk, thnk, qnk, qsnk, unk, vnk, plclfeed)
+!jyg20140217<
+    IF (ok_new_feed) THEN
+      DO i = 1, len
+        posit(i) = (sign(1.,plclfeed(i)-pfeed(i)+dp_lcl_feed)+1.)*0.5
+        IF (plclfeed(i)-pfeed(i)+dp_lcl_feed==0.) posit(i) = 1.
+      END DO
+    ELSE
+      DO i = 1, len
+        posit(i) = (sign(1.,plclfeed(i)-pfeed(i))+1.)*0.5
+        IF (plclfeed(i)==pfeed(i)) posit(i) = 1.
+      END DO
+    END IF
+!jyg>
     DO i = 1, len
+      posit(i) = (sign(1.,plclfeed(i)-pfeed(i))+1.)*0.5
+      IF (plclfeed(i)==pfeed(i)) posit(i) = 1.
+      ! - posit = 1 when lcl is below top of feeding layer (plclfeed>pfeed)
+      ! -               => pup=pfeed
+      ! - posit = 0 when lcl is above top of feeding layer (plclfeed<pfeed)
+      ! -               => plo=pfeed
+! - posit = 1 when lcl is below top of feeding layer (plclfeed>pfeed)
+! -               => pup=pfeed
+! - posit = 0 when lcl is above top of feeding layer (plclfeed<pfeed)
+! -               => plo=pfeed
       pup(i) = posit(i)*pfeed(i) + (1.-posit(i))*pup(i)
       plo(i) = (1.-posit(i))*pfeed(i) + posit(i)*plo(i)
 …
   END DO
   ! -------------------------------------------------------------------
   ! --- Check whether parcel level temperature and specific humidity
   ! --- are reasonable
   ! -------------------------------------------------------------------
+! -------------------------------------------------------------------
+! --- Check whether parcel level temperature and specific humidity
+! --- are reasonable
+! -------------------------------------------------------------------
   DO i = 1, len
     IF (((tnk(i)<250.0) .OR. (qnk(i)<=0.0)) .AND. (iflag(i)==0)) iflag(i) = 7
   END DO
   ! -------------------------------------------------------------------
   ! --- Calculate first level above lcl (=icb)
   ! -------------------------------------------------------------------
   ! @      do 270 i=1,len
   ! @       icb(i)=nlm
   ! @ 270  continue
   ! @c
   ! @      do 290 k=minorig,nl
   ! @        do 280 i=1,len
   ! @          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
   ! @     &    icb(i)=min(icb(i),k)
   ! @ 280    continue
   ! @ 290  continue
   ! @c
   ! @      do 300 i=1,len
   ! @        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
   ! @ 300  continue
+! -------------------------------------------------------------------
+! --- Calculate first level above lcl (=icb)
+! -------------------------------------------------------------------
+!@      do 270 i=1,len
+!@       icb(i)=nlm
+!@ 270  continue
+!@c
+!@      do 290 k=minorig,nl
+!@        do 280 i=1,len
+!@          if((k.ge.(nk(i)+1)).and.(p(i,k).lt.plcl(i)))
+!@     &    icb(i)=min(icb(i),k)
+!@ 280    continue
+!@ 290  continue
+!@c
+!@      do 300 i=1,len
+!@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+!@ 300  continue
   DO i = 1, len
 …
   END DO
   ! la modification consiste a comparer plcl a ph et non a p:
   ! icb est defini par :  ph(icb)<plcl<ph(icb-1)
   ! @      do 290 k=minorig,nl
+! la modification consiste a comparer plcl a ph et non a p:
+! icb est defini par :  ph(icb)<plcl<ph(icb-1)
+!@      do 290 k=minorig,nl
   DO k = 3, nl - 1 ! modif pour que icb soit sup/egal a 2
     DO i = 1, len
 …
   ! print*,'icb dans cv3_feed '
   ! write(*,'(64i2)') icb(2:len-1)
   ! call dump2d(64,43,'plcl dans cv3_feed ',plcl(2:len-1))
+! print*,'icb dans cv3_feed '
+! write(*,'(64i2)') icb(2:len-1)
+! call dump2d(64,43,'plcl dans cv3_feed ',plcl(2:len-1))
   DO i = 1, len
     ! @        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
+!@        if((icb(i).ge.nlm).and.(iflag(i).eq.0))iflag(i)=9
     IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9
   END DO
 …
   END DO
   ! Compute icbmax.
+! Compute icbmax.
   icbmax = 2
   DO i = 1, len
     ! !        icbmax=max(icbmax,icb(i))
     IF (iflag(i)<7) icbmax = max(icbmax, icb(i)) ! sb Jun7th02
+!!        icbmax=max(icbmax,icb(i))
+    IF (iflag(i)<7) icbmax = max(icbmax, icb(i))     ! sb Jun7th02
   END DO
 …
 SUBROUTINE cv3_undilute1(len, nd, t, qs, gz, plcl, p, icb, tnk, qnk, gznk, &
     tp, tvp, clw, icbs)
+                         tp, tvp, clw, icbs)
   IMPLICIT NONE
   ! ----------------------------------------------------------------
   ! Equivalent de TLIFT entre NK et ICB+1 inclus
   ! Differences with convect4:
   ! - specify plcl in input
   ! - icbs is the first level above LCL (may differ from icb)
   ! - in the iterations, used x(icbs) instead x(icb)
   ! - many minor differences in the iterations
   ! - tvp is computed in only one time
   ! - icbs: first level above Plcl (IMIN de TLIFT) in output
   ! - if icbs=icb, compute also tp(icb+1),tvp(icb+1) & clw(icb+1)
   ! ----------------------------------------------------------------
+! ----------------------------------------------------------------
+! Equivalent de TLIFT entre NK et ICB+1 inclus
+! Differences with convect4:
+!    - specify plcl in input
+!    - icbs is the first level above LCL (may differ from icb)
+!    - in the iterations, used x(icbs) instead x(icb)
+!    - many minor differences in the iterations
+!    - tvp is computed in only one time
+!    - icbs: first level above Plcl (IMIN de TLIFT) in output
+!    - if icbs=icb, compute also tp(icb+1),tvp(icb+1) & clw(icb+1)
+! ----------------------------------------------------------------
   include "cvthermo.h"
   include "cv3param.h"
   ! inputs:
+! inputs:
   INTEGER len, nd
   INTEGER icb(len)
 …
   REAL plcl(len) ! convect3
   ! outputs:
+! outputs:
   REAL tp(len, nd), tvp(len, nd), clw(len, nd)
   ! local variables:
+! local variables:
   INTEGER i, k
   INTEGER icb1(len), icbs(len), icbsmax2 ! convect3
 …
   REAL cpinv(len) ! convect3
   ! -------------------------------------------------------------------
   ! --- Calculates the lifted parcel virtual temperature at nk,
   ! --- the actual temperature, and the adiabatic
   ! --- liquid water content. The procedure is to solve the equation.
   ! cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
   ! -------------------------------------------------------------------
   ! ***  Calculate certain parcel quantities, including static energy   ***
+! -------------------------------------------------------------------
+! --- Calculates the lifted parcel virtual temperature at nk,
+! --- the actual temperature, and the adiabatic
+! --- liquid water content. The procedure is to solve the equation.
+!     cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
+! -------------------------------------------------------------------
+! ***  Calculate certain parcel quantities, including static energy   ***
   DO i = 1, len
+    ah0(i) = (cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i) + qnk(i)*(lv0-clmcpv*(tnk(i)- &
+.15)) + gznk(i)
+    ah0(i) = (cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i) + qnk(i)*(lv0-clmcpv*(tnk(i)-273.15)) + gznk(i)
     cpp(i) = cpd*(1.-qnk(i)) + qnk(i)*cpv
     cpinv(i) = 1./cpp(i)
   END DO
+  ! ***   Calculate lifted parcel quantities below cloud base   ***
+! ***   Calculate lifted parcel quantities below cloud base   ***
+  DO i = 1, len                                           !convect3
+    icb1(i) = max(icb(i), 2)                              !convect3
+    icb1(i) = min(icb(i), nl)                             !convect3
+! if icb is below LCL, start loop at ICB+1:
+! (icbs est le premier niveau au-dessus du LCL)
+    icbs(i) = icb1(i)                                     !convect3
+    IF (plcl(i)<p(i,icb1(i))) THEN
+      icbs(i) = min(icbs(i)+1, nl)                        !convect3
+    END IF
+  END DO                                                  !convect3
   DO i = 1, len !convect3
+    icb1(i) = max(icb(i), 2) !convect3
+    icb1(i) = min(icb(i), nl) !convect3
+    ! if icb is below LCL, start loop at ICB+1:
+    ! (icbs est le premier niveau au-dessus du LCL)
+    icbs(i) = icb1(i) !convect3
+    IF (plcl(i)<p(i,icb1(i))) THEN
+      icbs(i) = min(icbs(i)+1, nl) !convect3
+    END IF
+    ticb(i) = t(i, icbs(i))                               !convect3
+    gzicb(i) = gz(i, icbs(i))                             !convect3
+    qsicb(i) = qs(i, icbs(i))                             !convect3
   END DO !convect3
+  DO i = 1, len !convect3
+    ticb(i) = t(i, icbs(i)) !convect3
+    gzicb(i) = gz(i, icbs(i)) !convect3
+    qsicb(i) = qs(i, icbs(i)) !convect3
+  END DO !convect3
+  ! Re-compute icbsmax (icbsmax2):        !convect3
+  ! !convect3
+  icbsmax2 = 2 !convect3
+  DO i = 1, len !convect3
+    icbsmax2 = max(icbsmax2, icbs(i)) !convect3
+  END DO !convect3
+  ! initialization outputs:
+  DO k = 1, icbsmax2 ! convect3
+    DO i = 1, len ! convect3
+      tp(i, k) = 0.0 ! convect3
+      tvp(i, k) = 0.0 ! convect3
+      clw(i, k) = 0.0 ! convect3
+    END DO ! convect3
+  END DO ! convect3
+  ! tp and tvp below cloud base:
+! Re-compute icbsmax (icbsmax2):                          !convect3
+!                                                         !convect3
+  icbsmax2 = 2                                            !convect3
+  DO i = 1, len                                           !convect3
+    icbsmax2 = max(icbsmax2, icbs(i))                     !convect3
+  END DO                                                  !convect3
+! initialization outputs:
+  DO k = 1, icbsmax2                                      ! convect3
+    DO i = 1, len                                         ! convect3
+      tp(i, k) = 0.0                                      ! convect3
+      tvp(i, k) = 0.0                                     ! convect3
+      clw(i, k) = 0.0                                     ! convect3
+    END DO                                                ! convect3
+  END DO                                                  ! convect3
+! tp and tvp below cloud base:
   DO k = minorig, icbsmax2 - 1
     DO i = 1, len
       tp(i, k) = tnk(i) - (gz(i,k)-gznk(i))*cpinv(i)
       tvp(i, k) = tp(i, k)*(1.+qnk(i)/eps-qnk(i)) !whole thing (convect3)
     END DO
   END DO
   ! ***  Find lifted parcel quantities above cloud base    ***
+      tvp(i, k) = tp(i, k)*(1.+qnk(i)/eps-qnk(i))        !whole thing (convect3)
+    END DO
+  END DO
+! ***  Find lifted parcel quantities above cloud base    ***
   DO i = 1, len
     tg = ticb(i)
     ! ori         qg=qs(i,icb(i))
+! ori         qg=qs(i,icb(i))
     qg = qsicb(i) ! convect3
     ! debug         alv=lv0-clmcpv*(ticb(i)-t0)
+! debug         alv=lv0-clmcpv*(ticb(i)-t0)
     alv = lv0 - clmcpv*(ticb(i)-273.15)
     ! First iteration.
     ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
     s = cpd*(1.-qnk(i)) + cl*qnk(i) & ! convect3
       +alv*alv*qg/(rrv*ticb(i)*ticb(i)) ! convect3
+! First iteration.
+! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+    s = cpd*(1.-qnk(i)) + cl*qnk(i) + &                   ! convect3
+        alv*alv*qg/(rrv*ticb(i)*ticb(i))                  ! convect3
     s = 1./s
     ! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
     ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gzicb(i) ! convect3
     tg = tg + s*(ah0(i)-ahg)
     ! ori          tg=max(tg,35.0)
     ! debug          tc=tg-t0
+! ori          tg=max(tg,35.0)
+! debug          tc=tg-t0
     tc = tg - 273.15
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
     ! ori          if(tc.ge.0.0)then
+! ori          if(tc.ge.0.0)then
     es = 6.112*exp(17.67*tc/denom)
     ! ori          else
     ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
     ! ori          endif
     ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+! ori          else
+! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+! ori          endif
+! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
     qg = eps*es/(p(i,icbs(i))-es*(1.-eps))
     ! Second iteration.
     ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
     ! ori          s=1./s
     ! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+! Second iteration.
+! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+! ori          s=1./s
+! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
     ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gzicb(i) ! convect3
     tg = tg + s*(ah0(i)-ahg)
     ! ori          tg=max(tg,35.0)
     ! debug          tc=tg-t0
+! ori          tg=max(tg,35.0)
+! debug          tc=tg-t0
     tc = tg - 273.15
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
     ! ori          if(tc.ge.0.0)then
+    denom = max(denom, 1.0)                               ! convect3
+! ori          if(tc.ge.0.0)then
     es = 6.112*exp(17.67*tc/denom)
     ! ori          else
     ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
     ! ori          end if
     ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+! ori          else
+! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+! ori          end if
+! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
     qg = eps*es/(p(i,icbs(i))-es*(1.-eps))
     alv = lv0 - clmcpv*(ticb(i)-273.15)
     ! ori c approximation here:
     ! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
     ! ori     &   -gz(i,icb(i))-alv*qg)/cpd
     ! convect3: no approximation:
+! ori c approximation here:
+! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
+! ori     &   -gz(i,icb(i))-alv*qg)/cpd
+! convect3: no approximation:
     tp(i, icbs(i)) = (ah0(i)-gz(i,icbs(i))-alv*qg)/(cpd+(cl-cpd)*qnk(i))
     ! ori         clw(i,icb(i))=qnk(i)-qg
     ! ori         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
+! ori         clw(i,icb(i))=qnk(i)-qg
+! ori         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
     clw(i, icbs(i)) = qnk(i) - qg
     clw(i, icbs(i)) = max(0.0, clw(i,icbs(i)))
     rg = qg/(1.-qnk(i))
     ! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
     ! convect3: (qg utilise au lieu du vrai mixing ratio rg)
     tvp(i, icbs(i)) = tp(i, icbs(i))*(1.+qg/eps-qnk(i)) !whole thing
   END DO
   ! ori      do 380 k=minorig,icbsmax2
   ! ori       do 370 i=1,len
   ! ori         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
   ! ori 370   continue
   ! ori 380  continue
   ! -- The following is only for convect3:
   ! * icbs is the first level above the LCL:
   ! if plcl<p(icb), then icbs=icb+1
   ! if plcl>p(icb), then icbs=icb
   ! * the routine above computes tvp from minorig to icbs (included).
   ! * to compute buoybase (in cv3_trigger.F), both tvp(icb) and tvp(icb+1)
   ! must be known. This is the case if icbs=icb+1, but not if icbs=icb.
   ! * therefore, in the case icbs=icb, we compute tvp at level icb+1
   ! (tvp at other levels will be computed in cv3_undilute2.F)
+! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
+! convect3: (qg utilise au lieu du vrai mixing ratio rg)
+    tvp(i, icbs(i)) = tp(i, icbs(i))*(1.+qg/eps-qnk(i))   !whole thing
+  END DO
+! ori      do 380 k=minorig,icbsmax2
+! ori       do 370 i=1,len
+! ori         tvp(i,k)=tvp(i,k)-tp(i,k)*qnk(i)
+! ori 370   continue
+! ori 380  continue
+! -- The following is only for convect3:
+! * icbs is the first level above the LCL:
+! if plcl<p(icb), then icbs=icb+1
+! if plcl>p(icb), then icbs=icb
+! * the routine above computes tvp from minorig to icbs (included).
+! * to compute buoybase (in cv3_trigger.F), both tvp(icb) and tvp(icb+1)
+! must be known. This is the case if icbs=icb+1, but not if icbs=icb.
+! * therefore, in the case icbs=icb, we compute tvp at level icb+1
+! (tvp at other levels will be computed in cv3_undilute2.F)
 …
     tg = ticb(i)
     qg = qsicb(i) ! convect3
     ! debug         alv=lv0-clmcpv*(ticb(i)-t0)
+! debug         alv=lv0-clmcpv*(ticb(i)-t0)
     alv = lv0 - clmcpv*(ticb(i)-273.15)
     ! First iteration.
     ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
     s = cpd*(1.-qnk(i)) + cl*qnk(i) & ! convect3
       +alv*alv*qg/(rrv*ticb(i)*ticb(i)) ! convect3
+! First iteration.
+! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+    s = cpd*(1.-qnk(i)) + cl*qnk(i) &                         ! convect3
+      +alv*alv*qg/(rrv*ticb(i)*ticb(i))                       ! convect3
     s = 1./s
     ! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
     ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gzicb(i) ! convect3
+! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+    ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gzicb(i)     ! convect3
     tg = tg + s*(ah0(i)-ahg)
     ! ori          tg=max(tg,35.0)
     ! debug          tc=tg-t0
+! ori          tg=max(tg,35.0)
+! debug          tc=tg-t0
     tc = tg - 273.15
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
     ! ori          if(tc.ge.0.0)then
+    denom = max(denom, 1.0)                                   ! convect3
+! ori          if(tc.ge.0.0)then
     es = 6.112*exp(17.67*tc/denom)
     ! ori          else
     ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
     ! ori          endif
     ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+! ori          else
+! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+! ori          endif
+! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
     qg = eps*es/(p(i,icb(i)+1)-es*(1.-eps))
     ! Second iteration.
     ! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
     ! ori          s=1./s
     ! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
     ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gzicb(i) ! convect3
+! Second iteration.
+! ori          s=cpd+alv*alv*qg/(rrv*ticb(i)*ticb(i))
+! ori          s=1./s
+! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*ticb(i)+alv*qg+gzicb(i)
+    ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gzicb(i)     ! convect3
     tg = tg + s*(ah0(i)-ahg)
     ! ori          tg=max(tg,35.0)
     ! debug          tc=tg-t0
+! ori          tg=max(tg,35.0)
+! debug          tc=tg-t0
     tc = tg - 273.15
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
     ! ori          if(tc.ge.0.0)then
+    denom = max(denom, 1.0)                                   ! convect3
+! ori          if(tc.ge.0.0)then
     es = 6.112*exp(17.67*tc/denom)
     ! ori          else
     ! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
     ! ori          end if
     ! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
+! ori          else
+! ori           es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+! ori          end if
+! ori          qg=eps*es/(p(i,icb(i))-es*(1.-eps))
     qg = eps*es/(p(i,icb(i)+1)-es*(1.-eps))
     alv = lv0 - clmcpv*(ticb(i)-273.15)
     ! ori c approximation here:
     ! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
     ! ori     &   -gz(i,icb(i))-alv*qg)/cpd
     ! convect3: no approximation:
+! ori c approximation here:
+! ori         tp(i,icb(i))=(ah0(i)-(cl-cpd)*qnk(i)*ticb(i)
+! ori     &   -gz(i,icb(i))-alv*qg)/cpd
+! convect3: no approximation:
     tp(i, icb(i)+1) = (ah0(i)-gz(i,icb(i)+1)-alv*qg)/(cpd+(cl-cpd)*qnk(i))
     ! ori         clw(i,icb(i))=qnk(i)-qg
     ! ori         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
+! ori         clw(i,icb(i))=qnk(i)-qg
+! ori         clw(i,icb(i))=max(0.0,clw(i,icb(i)))
     clw(i, icb(i)+1) = qnk(i) - qg
     clw(i, icb(i)+1) = max(0.0, clw(i,icb(i)+1))
     rg = qg/(1.-qnk(i))
     ! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
     ! convect3: (qg utilise au lieu du vrai mixing ratio rg)
     tvp(i, icb(i)+1) = tp(i, icb(i)+1)*(1.+qg/eps-qnk(i)) !whole thing
+! ori         tvp(i,icb(i))=tp(i,icb(i))*(1.+rg*epsi)
+! convect3: (qg utilise au lieu du vrai mixing ratio rg)
+    tvp(i, icb(i)+1) = tp(i, icb(i)+1)*(1.+qg/eps-qnk(i))     !whole thing
   END DO
 …
 END SUBROUTINE cv3_undilute1
 SUBROUTINE cv3_trigger(len, nd, icb, plcl, p, th, tv, tvp, thnk, pbase, &
     buoybase, iflag, sig, w0)
+SUBROUTINE cv3_trigger(len, nd, icb, plcl, p, th, tv, tvp, thnk, &
+                       pbase, buoybase, iflag, sig, w0)
   IMPLICIT NONE
   ! -------------------------------------------------------------------
   ! --- TRIGGERING
   ! - computes the cloud base
   ! - triggering (crude in this version)
   ! - relaxation of sig and w0 when no convection
   ! Caution1: if no convection, we set iflag=4
   ! (it used to be 0 in convect3)
   ! Caution2: at this stage, tvp (and thus buoy) are know up
   ! through icb only!
   ! -> the buoyancy below cloud base not (yet) set to the cloud base buoyancy
   ! -------------------------------------------------------------------
+! -------------------------------------------------------------------
+! --- TRIGGERING
+! - computes the cloud base
+! - triggering (crude in this version)
+! - relaxation of sig and w0 when no convection
+! Caution1: if no convection, we set iflag=4
+! (it used to be 0 in convect3)
+! Caution2: at this stage, tvp (and thus buoy) are know up
+! through icb only!
+! -> the buoyancy below cloud base not (yet) set to the cloud base buoyancy
+! -------------------------------------------------------------------
   include "cv3param.h"
   ! input:
+! input:
   INTEGER len, nd
   INTEGER icb(len)
 …
   REAL thnk(len)
   ! output:
+! output:
   REAL pbase(len), buoybase(len)
   ! input AND output:
+! input AND output:
   INTEGER iflag(len)
   REAL sig(len, nd), w0(len, nd)
   ! local variables:
+! local variables:
   INTEGER i, k
   REAL tvpbase, tvbase, tdif, ath, ath1
   ! ***   set cloud base buoyancy at (plcl+dpbase) level buoyancy
+! ***   set cloud base buoyancy at (plcl+dpbase) level buoyancy
   DO i = 1, len
     pbase(i) = plcl(i) + dpbase
+    tvpbase = tvp(i, icb(i))*(pbase(i)-p(i,icb(i)+1))/ &
+      (p(i,icb(i))-p(i,icb(i)+1)) + tvp(i, icb(i)+1)*(p(i,icb(i))-pbase(i))/( &
+      p(i,icb(i))-p(i,icb(i)+1))
+    tvbase = tv(i, icb(i))*(pbase(i)-p(i,icb(i)+1))/ &
+      (p(i,icb(i))-p(i,icb(i)+1)) + tv(i, icb(i)+1)*(p(i,icb(i))-pbase(i))/(p &
+      (i,icb(i))-p(i,icb(i)+1))
+    tvpbase = tvp(i, icb(i))  *(pbase(i)-p(i,icb(i)+1))/(p(i,icb(i))-p(i,icb(i)+1)) + &
+              tvp(i, icb(i)+1)*(p(i,icb(i))-pbase(i))  /(p(i,icb(i))-p(i,icb(i)+1))
+    tvbase = tv(i, icb(i))  *(pbase(i)-p(i,icb(i)+1))/(p(i,icb(i))-p(i,icb(i)+1)) + &
+             tv(i, icb(i)+1)*(p(i,icb(i))-pbase(i))  /(p(i,icb(i))-p(i,icb(i)+1))
     buoybase(i) = tvpbase - tvbase
   END DO
   ! ***   make sure that column is dry adiabatic between the surface  ***
   ! ***    and cloud base, and that lifted air is positively buoyant  ***
   ! ***                         at cloud base                         ***
   ! ***       if not, return to calling program after resetting       ***
   ! ***                        sig(i) and w0(i)                       ***
   ! oct3      do 200 i=1,len
   ! oct3
   ! oct3       tdif = buoybase(i)
   ! oct3       ath1 = th(i,1)
   ! oct3       ath  = th(i,icb(i)-1) - dttrig
   ! oct3
   ! oct3       if (tdif.lt.dtcrit .or. ath.gt.ath1) then
   ! oct3         do 60 k=1,nl
   ! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
   ! oct3            sig(i,k) = AMAX1(sig(i,k),0.0)
   ! oct3            w0(i,k)  = beta*w0(i,k)
   ! oct3   60    continue
   ! oct3         iflag(i)=4 ! pour version vectorisee
   ! oct3c convect3         iflag(i)=0
   ! oct3cccc         return
   ! oct3       endif
   ! oct3
   ! oct3200   continue
   ! -- oct3: on reecrit la boucle 200 (pour la vectorisation)
+! ***   make sure that column is dry adiabatic between the surface  ***
+! ***    and cloud base, and that lifted air is positively buoyant  ***
+! ***                         at cloud base                         ***
+! ***       if not, return to calling program after resetting       ***
+! ***                        sig(i) and w0(i)                       ***
+! oct3      do 200 i=1,len
+! oct3
+! oct3       tdif = buoybase(i)
+! oct3       ath1 = th(i,1)
+! oct3       ath  = th(i,icb(i)-1) - dttrig
+! oct3
+! oct3       if (tdif.lt.dtcrit .or. ath.gt.ath1) then
+! oct3         do 60 k=1,nl
+! oct3            sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif
+! oct3            sig(i,k) = AMAX1(sig(i,k),0.0)
+! oct3            w0(i,k)  = beta*w0(i,k)
+! oct3   60    continue
+! oct3         iflag(i)=4 ! pour version vectorisee
+! oct3c convect3         iflag(i)=0
+! oct3cccc         return
+! oct3       endif
+! oct3
+! oct3200   continue
+! -- oct3: on reecrit la boucle 200 (pour la vectorisation)
   DO k = 1, nl
 …
         w0(i, k) = beta*w0(i, k)
         iflag(i) = 4 ! pour version vectorisee
         ! convect3         iflag(i)=0
+! convect3         iflag(i)=0
       END IF
 …
   END DO
   ! fin oct3 --
+! fin oct3 --
   RETURN
 END SUBROUTINE cv3_trigger
+SUBROUTINE cv3_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
+    plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, &
+    th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, &
+    iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, &
+    v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, w0)
+SUBROUTINE cv3_compress(len, nloc, ncum, nd, ntra, &
+                        iflag1, nk1, icb1, icbs1, &
+                        plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, &
+                        t1, q1, qs1, u1, v1, gz1, th1, &
+                        tra1, &
+                        h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
+                        sig1, w01, &
+                        iflag, nk, icb, icbs, &
+                        plcl, tnk, qnk, gznk, pbase, buoybase, &
+                        t, q, qs, u, v, gz, th, &
+                        tra, &
+                        h, lv, cpn, p, ph, tv, tp, tvp, clw, &
+                        sig, w0)
   IMPLICIT NONE
 …
   include 'iniprint.h'
   ! inputs:
+!inputs:
   INTEGER len, ncum, nd, ntra, nloc
   INTEGER iflag1(len), nk1(len), icb1(len), icbs1(len)
 …
   REAL tra1(len, nd, ntra)
   ! outputs:
   ! en fait, on a nloc=len pour l'instant (cf cv_driver)
+!outputs:
+! en fait, on a nloc=len pour l'instant (cf cv_driver)
   INTEGER iflag(nloc), nk(nloc), icb(nloc), icbs(nloc)
   REAL plcl(nloc), tnk(nloc), qnk(nloc), gznk(nloc)
 …
   REAL tra(nloc, nd, ntra)
   ! local variables:
+!local variables:
   INTEGER i, k, nn, j
 …
   END DO
   ! AC!      do 121 j=1,ntra
   ! AC!ccccc      do 111 k=1,nl+1
   ! AC!      do 111 k=1,nd
   ! AC!       nn=0
   ! AC!      do 101 i=1,len
   ! AC!      if(iflag1(i).eq.0)then
   ! AC!       nn=nn+1
   ! AC!       tra(nn,k,j)=tra1(i,k,j)
   ! AC!      endif
   ! AC! 101  continue
   ! AC! 111  continue
   ! AC! 121  continue
+!AC!      do 121 j=1,ntra
+!AC!ccccc      do 111 k=1,nl+1
+!AC!      do 111 k=1,nd
+!AC!       nn=0
+!AC!      do 101 i=1,len
+!AC!      if(iflag1(i).eq.0)then
+!AC!       nn=nn+1
+!AC!       tra(nn,k,j)=tra1(i,k,j)
+!AC!      endif
+!AC! 101  continue
+!AC! 111  continue
+!AC! 121  continue
   IF (nn/=ncum) THEN
 …
   ! JAM--------------------------------------------------------------------
   ! Calcul de la quantité d'eau sous forme de glace
   ! --------------------------------------------------------------------
+!JAM--------------------------------------------------------------------
+! Calcul de la quantité d'eau sous forme de glace
+! --------------------------------------------------------------------
   REAL qi(len, nl)
   REAL t(len, nl), clw(len, nl)
 …
         END IF
       END IF
       ! print*,t(i,k),qi(i,k),'temp,testglace'
+! print*,t(i,k),qi(i,k),'temp,testglace'
     END DO
   END DO
 …
 END SUBROUTINE icefrac
+SUBROUTINE cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, tnk, qnk, gznk, hnk, &
+    t, q, qs, gz, p, h, tv, lv, lf, pbase, buoybase, plcl, inb, tp, tvp, clw, &
+    hp, ep, sigp, buoy, frac)
+SUBROUTINE cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, &
+                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
+                         p, h, tv, lv, lf, pbase, buoybase, plcl, &
+                         inb, tp, tvp, clw, hp, ep, sigp, buoy, frac)
   IMPLICIT NONE
   ! ---------------------------------------------------------------------
   ! Purpose:
   ! FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
   ! &
   ! COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
   ! FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
   ! &
   ! FIND THE LEVEL OF NEUTRAL BUOYANCY
   ! Main differences convect3/convect4:
   ! - icbs (input) is the first level above LCL (may differ from icb)
   ! - many minor differences in the iterations
   ! - condensed water not removed from tvp in convect3
   ! - vertical profile of buoyancy computed here (use of buoybase)
   ! - the determination of inb is different
   ! - no inb1, only inb in output
   ! ---------------------------------------------------------------------
+! ---------------------------------------------------------------------
+! Purpose:
+! FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+! &
+! COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
+! FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
+! &
+! FIND THE LEVEL OF NEUTRAL BUOYANCY
+! Main differences convect3/convect4:
+!   - icbs (input) is the first level above LCL (may differ from icb)
+!   - many minor differences in the iterations
+!   - condensed water not removed from tvp in convect3
+!   - vertical profile of buoyancy computed here (use of buoybase)
+!   - the determination of inb is different
+!   - no inb1, only inb in output
+! ---------------------------------------------------------------------
   include "cvthermo.h"
 …
   include "cvflag.h"
   ! inputs:
+!inputs:
   INTEGER ncum, nd, nloc, j
   INTEGER icb(nloc), icbs(nloc), nk(nloc)
 …
   REAL pbase(nloc), buoybase(nloc), plcl(nloc)
   ! outputs:
+!outputs:
   INTEGER inb(nloc)
   REAL tp(nloc, nd), tvp(nloc, nd), clw(nloc, nd)
 …
   REAL buoy(nloc, nd)
   ! local variables:
+!local variables:
   INTEGER i, k
   REAL tg, qg, ahg, alv, alf, s, tc, es, esi, denom, rg, tca, elacrit
 …
   REAL fracg
   ! =====================================================================
   ! --- SOME INITIALIZATIONS
   ! =====================================================================
+! =====================================================================
+! --- SOME INITIALIZATIONS
+! =====================================================================
   DO k = 1, nl
 …
   END DO
   ! =====================================================================
   ! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
   ! =====================================================================
   ! ---       The procedure is to solve the equation.
   ! cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
   ! ***  Calculate certain parcel quantities, including static energy   ***
+! =====================================================================
+! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+! =====================================================================
+! ---       The procedure is to solve the equation.
+!                cp*tp+L*qp+phi=cp*tnk+L*qnk+gznk.
+! ***  Calculate certain parcel quantities, including static energy   ***
   DO i = 1, ncum
     ah0(i) = (cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i) & ! debug     &
                                                   ! +qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
       +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15)) + gznk(i)
   END DO
   ! ***  Find lifted parcel quantities above cloud base    ***
+    ah0(i) = (cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i)+ &
+! debug          qnk(i)*(lv0-clmcpv*(tnk(i)-t0))+gznk(i)
+             qnk(i)*(lv0-clmcpv*(tnk(i)-273.15)) + gznk(i)
+  END DO
+! ***  Find lifted parcel quantities above cloud base    ***
   DO k = minorig + 1, nl
     DO i = 1, ncum
       ! ori         if(k.ge.(icb(i)+1))then
       IF (k>=(icbs(i)+1)) THEN ! convect3
+! ori       if(k.ge.(icb(i)+1))then
+      IF (k>=(icbs(i)+1)) THEN                                ! convect3
         tg = t(i, k)
         qg = qs(i, k)
         ! debug       alv=lv0-clmcpv*(t(i,k)-t0)
+! debug       alv=lv0-clmcpv*(t(i,k)-t0)
         alv = lv0 - clmcpv*(t(i,k)-273.15)
         ! First iteration.
         ! ori          s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
         s = cpd*(1.-qnk(i)) + cl*qnk(i) & ! convect3
           +alv*alv*qg/(rrv*t(i,k)*t(i,k)) ! convect3
+! First iteration.
+! ori          s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+        s = cpd*(1.-qnk(i)) + cl*qnk(i) + &                   ! convect3
+            alv*alv*qg/(rrv*t(i,k)*t(i,k))                    ! convect3
         s = 1./s
         ! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
         ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gz(i, k) ! convect3
         tg = tg + s*(ah0(i)-ahg)
         ! ori          tg=max(tg,35.0)
         ! debug        tc=tg-t0
+! ori          tg=max(tg,35.0)
+! debug        tc=tg-t0
         tc = tg - 273.15
         denom = 243.5 + tc
         denom = max(denom, 1.0) ! convect3
         ! ori          if(tc.ge.0.0)then
+        denom = max(denom, 1.0)                               ! convect3
+! ori          if(tc.ge.0.0)then
         es = 6.112*exp(17.67*tc/denom)
         ! ori          else
         ! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
         ! ori          endif
+! ori          else
+! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+! ori          endif
         qg = eps*es/(p(i,k)-es*(1.-eps))
         ! Second iteration.
         ! ori          s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
         ! ori          s=1./s
         ! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+! Second iteration.
+! ori          s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+! ori          s=1./s
+! ori          ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
         ahg = cpd*tg + (cl-cpd)*qnk(i)*tg + alv*qg + gz(i, k) ! convect3
         tg = tg + s*(ah0(i)-ahg)
         ! ori          tg=max(tg,35.0)
         ! debug        tc=tg-t0
+! ori          tg=max(tg,35.0)
+! debug        tc=tg-t0
         tc = tg - 273.15
         denom = 243.5 + tc
         denom = max(denom, 1.0) ! convect3
         ! ori          if(tc.ge.0.0)then
+        denom = max(denom, 1.0)                               ! convect3
+! ori          if(tc.ge.0.0)then
         es = 6.112*exp(17.67*tc/denom)
         ! ori          else
         ! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
         ! ori          endif
+! ori          else
+! ori                   es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+! ori          endif
         qg = eps*es/(p(i,k)-es*(1.-eps))
         ! debug        alv=lv0-clmcpv*(t(i,k)-t0)
+! debug        alv=lv0-clmcpv*(t(i,k)-t0)
         alv = lv0 - clmcpv*(t(i,k)-273.15)
+        ! print*,'cpd dans convect2 ',cpd
+        ! print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
+        ! print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
+        ! ori c approximation here:
+        ! ori
+        ! tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
+        ! convect3: no approximation:
+! print*,'cpd dans convect2 ',cpd
+! print*,'tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd'
+! print*,tp(i,k),ah0(i),cl,cpd,qnk(i),t(i,k),gz(i,k),alv,qg,cpd
+! ori c approximation here:
+! ori        tp(i,k)=(ah0(i)-(cl-cpd)*qnk(i)*t(i,k)-gz(i,k)-alv*qg)/cpd
+! convect3: no approximation:
         IF (cvflag_ice) THEN
           tp(i, k) = max(0., (ah0(i)-gz(i,k)-alv*qg)/(cpd+(cl-cpd)*qnk(i)))
 …
         clw(i, k) = max(0.0, clw(i,k))
         rg = qg/(1.-qnk(i))
         ! ori               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
         ! convect3: (qg utilise au lieu du vrai mixing ratio rg):
+! ori               tvp(i,k)=tp(i,k)*(1.+rg*epsi)
+! convect3: (qg utilise au lieu du vrai mixing ratio rg):
         tvp(i, k) = tp(i, k)*(1.+qg/eps-qnk(i)) ! whole thing
         IF (cvflag_ice) THEN
 …
       IF (cvflag_ice) THEN
         ! CR:attention boucle en klon dans Icefrac
         ! Call Icefrac(t,clw,qi,nl,nloc)
+!CR:attention boucle en klon dans Icefrac
+! Call Icefrac(t,clw,qi,nl,nloc)
         IF (t(i,k)>263.15) THEN
           qi(i, k) = 0.
 …
           END IF
         END IF
         ! CR: fin test
+!CR: fin test
         IF (t(i,k)<263.15) THEN
           ! CR: on commente les calculs d'Arnaud car division par zero
           ! nouveau calcul propose par JYG
           ! alv=lv0-clmcpv*(t(i,k)-273.15)
           ! alf=lf0-clmci*(t(i,k)-273.15)
           ! tg=tp(i,k)
           ! tc=tp(i,k)-273.15
           ! denom=243.5+tc
           ! do j=1,3
           ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
           ! il faudra que esi vienne en argument de la convection
           ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
           ! tbis=t(i,k)+(tp(i,k)-tg)
+          ! esi=exp(23.33086-(6111.72784/tbis)
           ! :               +0.15215*log(tbis))
           ! qsat_new=eps*esi/(p(i,k)-esi*(1.-eps))
+          ! snew=cpd*(1.-qnk(i))+cl*qnk(i)+alv*alv*qsat_new/
           ! :                               (rrv*tbis*tbis)
           ! snew=1./snew
           ! print*,esi,qsat_new,snew,'esi,qsat,snew'
           ! tp(i,k)=tg+(alf*qi(i,k)+alv*qg*(1.-(esi/es)))*snew
           ! print*,k,tp(i,k),qnk(i),'avec glace'
           ! print*,'tpNAN',tg,alf,qi(i,k),alv,qg,esi,es,snew
           ! enddo
+!CR: on commente les calculs d'Arnaud car division par zero
+! nouveau calcul propose par JYG
+!       alv=lv0-clmcpv*(t(i,k)-273.15)
+!       alf=lf0-clmci*(t(i,k)-273.15)
+!       tg=tp(i,k)
+!       tc=tp(i,k)-273.15
+!       denom=243.5+tc
+!       do j=1,3
+! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! il faudra que esi vienne en argument de la convection
+! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!        tbis=t(i,k)+(tp(i,k)-tg)
+!        esi=exp(23.33086-(6111.72784/tbis) + &
+!                       0.15215*log(tbis))
+!        qsat_new=eps*esi/(p(i,k)-esi*(1.-eps))
+!        snew=cpd*(1.-qnk(i))+cl*qnk(i)+alv*alv*qsat_new/ &
+!                                       (rrv*tbis*tbis)
+!        snew=1./snew
+!        print*,esi,qsat_new,snew,'esi,qsat,snew'
+!        tp(i,k)=tg+(alf*qi(i,k)+alv*qg*(1.-(esi/es)))*snew
+!        print*,k,tp(i,k),qnk(i),'avec glace'
+!        print*,'tpNAN',tg,alf,qi(i,k),alv,qg,esi,es,snew
+!       enddo
           alv = lv0 - clmcpv*(t(i,k)-273.15)
 …
             esi = exp(23.33086-(6111.72784/tp(i,k))+0.15215*log(tp(i,k)))
             qsat_new = eps*esi/(p(i,k)-esi*(1.-eps))
             snew = cpd*(1.-qnk(i)) + cl*qnk(i) + alv*als*qsat_new/(rrv*tp(i,k &
               )*tp(i,k))
+            snew = cpd*(1.-qnk(i)) + cl*qnk(i) + alv*als*qsat_new/ &
+                                                 (rrv*tp(i,k)*tp(i,k))
             snew = 1./snew
+            ! c             print*,esi,qsat_new,snew,'esi,qsat,snew'
+            tp(i, k) = tp(i, k) + ((cpd*(1.-qnk(i))+cl*qnk(i))*(tg-tp(i, &
+              k))+alv*(qg-qsat_new)+alf*qi(i,k))*snew
+            ! print*,k,tp(i,k),qsat_new,qnk(i),qi(i,k),
+            ! :             'k,tp,q,qt,qi avec glace'
+! c             print*,esi,qsat_new,snew,'esi,qsat,snew'
+            tp(i, k) = tp(i, k) + &
+                       ((cpd*(1.-qnk(i))+cl*qnk(i))*(tg-tp(i,k)) + &
+                        alv*(qg-qsat_new)+alf*qi(i,k))*snew
+! print*,k,tp(i,k),qsat_new,qnk(i),qi(i,k), &
+!              'k,tp,q,qt,qi avec glace'
           END DO
           ! CR:reprise du code AJ
+!CR:reprise du code AJ
           clw(i, k) = qnk(i) - qsat_new
           clw(i, k) = max(0.0, clw(i,k))
           tvp(i, k) = max(0., tp(i,k)*(1.+qsat_new/eps-qnk(i)))
           ! print*,tvp(i,k),'tvp'
+! print*,tvp(i,k),'tvp'
         END IF
         IF (clw(i,k)<1.E-11) THEN
 …
   END DO
   ! =====================================================================
   ! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF
   ! --- PRECIPITATION FALLING OUTSIDE OF CLOUD
   ! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
   ! =====================================================================
+! =====================================================================
+! --- SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF
+! --- PRECIPITATION FALLING OUTSIDE OF CLOUD
+! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
+! =====================================================================
   IF (flag_epkeorig/=1) THEN
 …
     END DO
   END IF
   ! =====================================================================
   ! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
   ! --- VIRTUAL TEMPERATURE
   ! =====================================================================
   ! dans convect3, tvp est calcule en une seule fois, et sans retirer
   ! l'eau condensee (~> reversible CAPE)
   ! ori      do 340 k=minorig+1,nl
   ! ori        do 330 i=1,ncum
   ! ori        if(k.ge.(icb(i)+1))then
   ! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
   ! oric         print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
   ! oric         print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
   ! ori        endif
   ! ori 330    continue
   ! ori 340  continue
   ! ori      do 350 i=1,ncum
   ! ori       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
   ! ori 350  continue
   DO i = 1, ncum ! convect3
     tp(i, nlp) = tp(i, nl) ! convect3
   END DO ! convect3
   ! =====================================================================
   ! --- EFFECTIVE VERTICAL PROFILE OF BUOYANCY (convect3 only):
   ! =====================================================================
   ! -- this is for convect3 only:
   ! first estimate of buoyancy:
+! =====================================================================
+! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
+! --- VIRTUAL TEMPERATURE
+! =====================================================================
+! dans convect3, tvp est calcule en une seule fois, et sans retirer
+! l'eau condensee (~> reversible CAPE)
+! ori      do 340 k=minorig+1,nl
+! ori        do 330 i=1,ncum
+! ori        if(k.ge.(icb(i)+1))then
+! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
+! oric         print*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
+! oric         print*, i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)
+! ori        endif
+! ori 330    continue
+! ori 340  continue
+! ori      do 350 i=1,ncum
+! ori       tvp(i,nlp)=tvp(i,nl)-(gz(i,nlp)-gz(i,nl))/cpd
+! ori 350  continue
+  DO i = 1, ncum                                           ! convect3
+    tp(i, nlp) = tp(i, nl)                                 ! convect3
+  END DO                                                   ! convect3
+! =====================================================================
+! --- EFFECTIVE VERTICAL PROFILE OF BUOYANCY (convect3 only):
+! =====================================================================
+! -- this is for convect3 only:
+! first estimate of buoyancy:
   DO i = 1, ncum
 …
   END DO
   ! set buoyancy=buoybase for all levels below base
   ! for safety, set buoy(icb)=buoybase
+! set buoyancy=buoybase for all levels below base
+! for safety, set buoy(icb)=buoybase
   DO i = 1, ncum
 …
       END IF
     END DO
     ! buoy(icb(i),k)=buoybase(i)
+!    buoy(icb(i),k)=buoybase(i)
     buoy(i, icb(i)) = buoybase(i)
   END DO
   ! -- end convect3
   ! =====================================================================
   ! --- FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S
   ! --- LEVEL OF NEUTRAL BUOYANCY
   ! =====================================================================
   ! -- this is for convect3 only:
+! -- end convect3
+! =====================================================================
+! --- FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S
+! --- LEVEL OF NEUTRAL BUOYANCY
+! =====================================================================
+! -- this is for convect3 only:
   DO i = 1, ncum
 …
   ! --    iposit(i) = first level, above icb, with positive buoyancy
+! --    iposit(i) = first level, above icb, with positive buoyancy
   DO k = 1, nl - 1
     DO i = 1, ncum
 …
   END DO
   ! -- end convect3
   ! ori      do 510 i=1,ncum
   ! ori        cape(i)=0.0
   ! ori        capem(i)=0.0
   ! ori        inb(i)=icb(i)+1
   ! ori        inb1(i)=inb(i)
   ! ori 510  continue
   ! Originial Code
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
   ! if(k.ge.(icb(i)+1))then
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
   ! cape(i)=cape(i)+by
   ! if(by.ge.0.0)inb1(i)=k+1
   ! if(cape(i).gt.0.0)then
   ! inb(i)=k+1
   ! capem(i)=cape(i)
   ! endif
   ! endif
   ! 520    continue
   ! 530  continue
   ! do 540 i=1,ncum
   ! byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
   ! cape(i)=capem(i)+byp
   ! defrac=capem(i)-cape(i)
   ! defrac=max(defrac,0.001)
   ! frac(i)=-cape(i)/defrac
   ! frac(i)=min(frac(i),1.0)
   ! frac(i)=max(frac(i),0.0)
   ! 540   continue
   ! K Emanuel fix
   ! call zilch(byp,ncum)
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
   ! if(k.ge.(icb(i)+1))then
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! cape(i)=cape(i)+by
   ! if(by.ge.0.0)inb1(i)=k+1
   ! if(cape(i).gt.0.0)then
   ! inb(i)=k+1
   ! capem(i)=cape(i)
   ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
   ! endif
   ! endif
   ! 520    continue
   ! 530  continue
   ! do 540 i=1,ncum
   ! inb(i)=max(inb(i),inb1(i))
   ! cape(i)=capem(i)+byp(i)
   ! defrac=capem(i)-cape(i)
   ! defrac=max(defrac,0.001)
   ! frac(i)=-cape(i)/defrac
   ! frac(i)=min(frac(i),1.0)
   ! frac(i)=max(frac(i),0.0)
   ! 540   continue
   ! J Teixeira fix
   ! ori      call zilch(byp,ncum)
   ! ori      do 515 i=1,ncum
   ! ori        lcape(i)=.true.
   ! ori 515  continue
   ! ori      do 530 k=minorig+1,nl-1
   ! ori        do 520 i=1,ncum
   ! ori          if(cape(i).lt.0.0)lcape(i)=.false.
   ! ori          if((k.ge.(icb(i)+1)).and.lcape(i))then
   ! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
   ! ori            cape(i)=cape(i)+by
   ! ori            if(by.ge.0.0)inb1(i)=k+1
   ! ori            if(cape(i).gt.0.0)then
   ! ori              inb(i)=k+1
   ! ori              capem(i)=cape(i)
   ! ori            endif
   ! ori          endif
   ! ori 520    continue
   ! ori 530  continue
   ! ori      do 540 i=1,ncum
   ! ori          cape(i)=capem(i)+byp(i)
   ! ori          defrac=capem(i)-cape(i)
   ! ori          defrac=max(defrac,0.001)
   ! ori          frac(i)=-cape(i)/defrac
   ! ori          frac(i)=min(frac(i),1.0)
   ! ori          frac(i)=max(frac(i),0.0)
   ! ori 540  continue
   ! =====================================================================
   ! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
   ! =====================================================================
+! -- end convect3
+! ori      do 510 i=1,ncum
+! ori        cape(i)=0.0
+! ori        capem(i)=0.0
+! ori        inb(i)=icb(i)+1
+! ori        inb1(i)=inb(i)
+! ori 510  continue
+! Originial Code
+!    do 530 k=minorig+1,nl-1
+!     do 520 i=1,ncum
+!      if(k.ge.(icb(i)+1))then
+!       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+!       byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+!       cape(i)=cape(i)+by
+!       if(by.ge.0.0)inb1(i)=k+1
+!       if(cape(i).gt.0.0)then
+!        inb(i)=k+1
+!        capem(i)=cape(i)
+!       endif
+!      endif
+!520    continue
+!530  continue
+!    do 540 i=1,ncum
+!     byp=(tvp(i,nl)-tv(i,nl))*dph(i,nl)/p(i,nl)
+!     cape(i)=capem(i)+byp
+!     defrac=capem(i)-cape(i)
+!     defrac=max(defrac,0.001)
+!     frac(i)=-cape(i)/defrac
+!     frac(i)=min(frac(i),1.0)
+!     frac(i)=max(frac(i),0.0)
+!540   continue
+!    K Emanuel fix
+!    call zilch(byp,ncum)
+!    do 530 k=minorig+1,nl-1
+!     do 520 i=1,ncum
+!      if(k.ge.(icb(i)+1))then
+!       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+!       cape(i)=cape(i)+by
+!       if(by.ge.0.0)inb1(i)=k+1
+!       if(cape(i).gt.0.0)then
+!        inb(i)=k+1
+!        capem(i)=cape(i)
+!        byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+!       endif
+!      endif
+!520    continue
+!530  continue
+!    do 540 i=1,ncum
+!     inb(i)=max(inb(i),inb1(i))
+!     cape(i)=capem(i)+byp(i)
+!     defrac=capem(i)-cape(i)
+!     defrac=max(defrac,0.001)
+!     frac(i)=-cape(i)/defrac
+!     frac(i)=min(frac(i),1.0)
+!     frac(i)=max(frac(i),0.0)
+!540   continue
+! J Teixeira fix
+! ori      call zilch(byp,ncum)
+! ori      do 515 i=1,ncum
+! ori        lcape(i)=.true.
+! ori 515  continue
+! ori      do 530 k=minorig+1,nl-1
+! ori        do 520 i=1,ncum
+! ori          if(cape(i).lt.0.0)lcape(i)=.false.
+! ori          if((k.ge.(icb(i)+1)).and.lcape(i))then
+! ori            by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
+! ori            byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
+! ori            cape(i)=cape(i)+by
+! ori            if(by.ge.0.0)inb1(i)=k+1
+! ori            if(cape(i).gt.0.0)then
+! ori              inb(i)=k+1
+! ori              capem(i)=cape(i)
+! ori            endif
+! ori          endif
+! ori 520    continue
+! ori 530  continue
+! ori      do 540 i=1,ncum
+! ori          cape(i)=capem(i)+byp(i)
+! ori          defrac=capem(i)-cape(i)
+! ori          defrac=max(defrac,0.001)
+! ori          frac(i)=-cape(i)/defrac
+! ori          frac(i)=min(frac(i),1.0)
+! ori          frac(i)=max(frac(i),0.0)
+! ori 540  continue
+! =====================================================================
+! ---   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
+! =====================================================================
   DO k = 1, nd
 …
           frac(i, k) = 1. - (t(i,k)-243.15)/(263.15-243.15)
           frac(i, k) = min(max(frac(i,k),0.0), 1.0)
           hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac(i,k)*lf(i,k))*ep &
             (i, k)*clw(i, k)
+          hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac(i,k)*lf(i,k))* &
+                              ep(i, k)*clw(i, k)
         ELSE
 …
 END SUBROUTINE cv3_undilute2
+SUBROUTINE cv3_closure(nloc, ncum, nd, icb, inb, pbase, p, ph, tv, buoy, sig, &
+    w0, cape, m, iflag)
+SUBROUTINE cv3_closure(nloc, ncum, nd, icb, inb, &
+                       pbase, p, ph, tv, buoy, &
+                       sig, w0, cape, m, iflag)
   IMPLICIT NONE
   ! ===================================================================
   ! ---  CLOSURE OF CONVECT3
   ! vectorization: S. Bony
   ! ===================================================================
+! ===================================================================
+! ---  CLOSURE OF CONVECT3
+!
+! vectorization: S. Bony
+! ===================================================================
   include "cvthermo.h"
   include "cv3param.h"
   ! input:
+!input:
   INTEGER ncum, nd, nloc
   INTEGER icb(nloc), inb(nloc)
 …
   REAL tv(nloc, nd), buoy(nloc, nd)
   ! input/output:
+!input/output:
   REAL sig(nloc, nd), w0(nloc, nd)
   INTEGER iflag(nloc)
   ! output:
+!output:
   REAL cape(nloc)
   REAL m(nloc, nd)
   ! local variables:
+!local variables:
   INTEGER i, j, k, icbmax
   REAL deltap, fac, w, amu
 …
   ! -------------------------------------------------------
   ! -- Initialization
   ! -------------------------------------------------------
+! -------------------------------------------------------
+! -- Initialization
+! -------------------------------------------------------
   DO k = 1, nl
 …
   END DO
   ! -------------------------------------------------------
   ! -- Reset sig(i) and w0(i) for i>inb and i<icb
   ! -------------------------------------------------------
   ! update sig and w0 above LNB:
+! -------------------------------------------------------
+! -- Reset sig(i) and w0(i) for i>inb and i<icb
+! -------------------------------------------------------
+! update sig and w0 above LNB:
   DO k = 1, nl - 1
     DO i = 1, ncum
       IF ((inb(i)<(nl-1)) .AND. (k>=(inb(i)+1))) THEN
         sig(i, k) = beta*sig(i, k) + 2.*alpha*buoy(i, inb(i))*abs(buoy(i,inb( &
           i)))
+        sig(i, k) = beta*sig(i, k) + &
+.*alpha*buoy(i, inb(i))*abs(buoy(i,inb(i)))
         sig(i, k) = amax1(sig(i,k), 0.0)
         w0(i, k) = beta*w0(i, k)
 …
   END DO
   ! compute icbmax:
+! compute icbmax:
   icbmax = 2
 …
   END DO
   ! update sig and w0 below cloud base:
+! update sig and w0 below cloud base:
   DO k = 1, icbmax
     DO i = 1, ncum
       IF (k<=icb(i)) THEN
+        sig(i, k) = beta*sig(i, k) - 2.*alpha*buoy(i, icb(i))*buoy(i, icb(i))
+        sig(i, k) = beta*sig(i, k) - &
+.*alpha*buoy(i, icb(i))*buoy(i, icb(i))
         sig(i, k) = max(sig(i,k), 0.0)
         w0(i, k) = beta*w0(i, k)
 …
   END DO
   ! !      if(inb.lt.(nl-1))then
   ! !         do 85 i=inb+1,nl-1
   ! !            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
   ! !     1              abs(buoy(inb))
   ! !            sig(i)=max(sig(i),0.0)
   ! !            w0(i)=beta*w0(i)
   ! !   85    continue
   ! !      end if
   ! !      do 87 i=1,icb
   ! !         sig(i)=beta*sig(i)-2.*alpha*buoy(icb)*buoy(icb)
   ! !         sig(i)=max(sig(i),0.0)
   ! !         w0(i)=beta*w0(i)
   ! !   87 continue
   ! -------------------------------------------------------------
   ! -- Reset fractional areas of updrafts and w0 at initial time
   ! -- and after 10 time steps of no convection
   ! -------------------------------------------------------------
+!!      if(inb.lt.(nl-1))then
+!!         do 85 i=inb+1,nl-1
+!!            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
+!!     1              abs(buoy(inb))
+!!            sig(i)=max(sig(i),0.0)
+!!            w0(i)=beta*w0(i)
+!!   85    continue
+!!      end if
+!!      do 87 i=1,icb
+!!         sig(i)=beta*sig(i)-2.*alpha*buoy(icb)*buoy(icb)
+!!         sig(i)=max(sig(i),0.0)
+!!         w0(i)=beta*w0(i)
+!!   87 continue
+! -------------------------------------------------------------
+! -- Reset fractional areas of updrafts and w0 at initial time
+! -- and after 10 time steps of no convection
+! -------------------------------------------------------------
   DO k = 1, nl - 1
 …
   END DO
   ! -------------------------------------------------------------
   ! -- Calculate convective available potential energy (cape),
   ! -- vertical velocity (w), fractional area covered by
   ! -- undilute updraft (sig), and updraft mass flux (m)
   ! -------------------------------------------------------------
+! -------------------------------------------------------------
+! -- Calculate convective available potential energy (cape),
+! -- vertical velocity (w), fractional area covered by
+! -- undilute updraft (sig), and updraft mass flux (m)
+! -------------------------------------------------------------
   DO i = 1, ncum
 …
   END DO
   ! compute dtmin (minimum buoyancy between ICB and given level k):
+! compute dtmin (minimum buoyancy between ICB and given level k):
   DO i = 1, ncum
 …
     DO k = 1, nl
       DO j = minorig, nl
+        IF ((k>=(icb(i)+1)) .AND. (k<=inb(i)) .AND. (j>=icb(i)) .AND. (j<=(k- &
+))) THEN
+        IF ((k>=(icb(i)+1)) .AND. (k<=inb(i)) .AND. (j>=icb(i)) .AND. (j<=(k-1))) THEN
           dtmin(i, k) = amin1(dtmin(i,k), buoy(i,j))
         END IF
 …
   END DO
   ! the interval on which cape is computed starts at pbase :
+! the interval on which cape is computed starts at pbase :
   DO k = 1, nl
 …
         sigold(i, k) = sig(i, k)
         ! dtmin(i,k)=100.0
         ! do 97 j=icb(i),k-1 ! mauvaise vectorisation
         ! dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
         ! 97     continue
+! dtmin(i,k)=100.0
+! do 97 j=icb(i),k-1 ! mauvaise vectorisation
+! dtmin(i,k)=AMIN1(dtmin(i,k),buoy(i,j))
+! 97     continue
         sig(i, k) = beta*sig(i, k) + alpha*dtmin(i, k)*abs(dtmin(i,k))
 …
   DO i = 1, ncum
     w0(i, icb(i)) = 0.5*w0(i, icb(i)+1)
+    m(i, icb(i)) = 0.5*m(i, icb(i)+1)*(ph(i,icb(i))-ph(i,icb(i)+1))/ &
+      (ph(i,icb(i)+1)-ph(i,icb(i)+2))
+    m(i, icb(i)) = 0.5*m(i, icb(i)+1)*(ph(i,icb(i))-ph(i,icb(i)+1))/(ph(i,icb(i)+1)-ph(i,icb(i)+2))
     sig(i, icb(i)) = sig(i, icb(i)+1)
     sig(i, icb(i)-1) = sig(i, icb(i))
   END DO
+  ! ccc 3. Compute final cloud base mass flux and set iflag to 3 if
+  ! ccc    cloud base mass flux is exceedingly small and is decreasing (i.e.
+  ! if
+  ! ccc    the final mass flux (cbmflast) is greater than the target mass
+  ! flux
+  ! ccc    (cbmf) ??).
+  ! cc
+  ! c      do i = 1,ncum
+  ! c       cbmflast(i) = 0.
+  ! c      enddo
+  ! cc
+  ! c      do k= 1,nl
+  ! c       do i = 1,ncum
+  ! c        IF (k .ge. icb(i) .and. k .le. inb(i)) THEN
+  ! c         cbmflast(i) = cbmflast(i)+M(i,k)
+  ! c        ENDIF
+  ! c       enddo
+  ! c      enddo
+  ! cc
+  ! c      do i = 1,ncum
+  ! c       IF (cbmflast(i) .lt. 1.e-6) THEN
+  ! c         iflag(i) = 3
+  ! c       ENDIF
+  ! c      enddo
+  ! cc
+  ! c      do k= 1,nl
+  ! c       do i = 1,ncum
+  ! c        IF (iflag(i) .ge. 3) THEN
+  ! c         M(i,k) = 0.
+  ! c         sig(i,k) = 0.
+  ! c         w0(i,k) = 0.
+  ! c        ENDIF
+  ! c       enddo
+  ! c      enddo
+  ! cc
+  ! !      cape=0.0
+  ! !      do 98 i=icb+1,inb
+  ! !         deltap = min(pbase,ph(i-1))-min(pbase,ph(i))
+  ! !         cape=cape+rrd*buoy(i-1)*deltap/p(i-1)
+  ! !         dcape=rrd*buoy(i-1)*deltap/p(i-1)
+  ! !         dlnp=deltap/p(i-1)
+  ! !         cape=max(0.0,cape)
+  ! !         sigold=sig(i)
+  ! !         dtmin=100.0
+  ! !         do 97 j=icb,i-1
+  ! !            dtmin=amin1(dtmin,buoy(j))
+  ! !   97    continue
+  ! !         sig(i)=beta*sig(i)+alpha*dtmin*abs(dtmin)
+  ! !         sig(i)=max(sig(i),0.0)
+  ! !         sig(i)=amin1(sig(i),0.01)
+  ! !         fac=amin1(((dtcrit-dtmin)/dtcrit),1.0)
+  ! !         w=(1.-beta)*fac*sqrt(cape)+beta*w0(i)
+  ! !         amu=0.5*(sig(i)+sigold)*w
+  ! !         m(i)=amu*0.007*p(i)*(ph(i)-ph(i+1))/tv(i)
+  ! !         w0(i)=w
+  ! !   98 continue
+  ! !      w0(icb)=0.5*w0(icb+1)
+  ! !      m(icb)=0.5*m(icb+1)*(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
+  ! !      sig(icb)=sig(icb+1)
+  ! !      sig(icb-1)=sig(icb)
+! ccc 3. Compute final cloud base mass flux and set iflag to 3 if
+! ccc    cloud base mass flux is exceedingly small and is decreasing (i.e. if
+! ccc    the final mass flux (cbmflast) is greater than the target mass flux
+! ccc    (cbmf) ??).
+! cc
+! c      do i = 1,ncum
+! c       cbmflast(i) = 0.
+! c      enddo
+! cc
+! c      do k= 1,nl
+! c       do i = 1,ncum
+! c        IF (k .ge. icb(i) .and. k .le. inb(i)) THEN
+! c         cbmflast(i) = cbmflast(i)+M(i,k)
+! c        ENDIF
+! c       enddo
+! c      enddo
+! cc
+! c      do i = 1,ncum
+! c       IF (cbmflast(i) .lt. 1.e-6) THEN
+! c         iflag(i) = 3
+! c       ENDIF
+! c      enddo
+! cc
+! c      do k= 1,nl
+! c       do i = 1,ncum
+! c        IF (iflag(i) .ge. 3) THEN
+! c         M(i,k) = 0.
+! c         sig(i,k) = 0.
+! c         w0(i,k) = 0.
+! c        ENDIF
+! c       enddo
+! c      enddo
+! cc
+!!      cape=0.0
+!!      do 98 i=icb+1,inb
+!!         deltap = min(pbase,ph(i-1))-min(pbase,ph(i))
+!!         cape=cape+rrd*buoy(i-1)*deltap/p(i-1)
+!!         dcape=rrd*buoy(i-1)*deltap/p(i-1)
+!!         dlnp=deltap/p(i-1)
+!!         cape=max(0.0,cape)
+!!         sigold=sig(i)
+!!         dtmin=100.0
+!!         do 97 j=icb,i-1
+!!            dtmin=amin1(dtmin,buoy(j))
+!!   97    continue
+!!         sig(i)=beta*sig(i)+alpha*dtmin*abs(dtmin)
+!!         sig(i)=max(sig(i),0.0)
+!!         sig(i)=amin1(sig(i),0.01)
+!!         fac=amin1(((dtcrit-dtmin)/dtcrit),1.0)
+!!         w=(1.-beta)*fac*sqrt(cape)+beta*w0(i)
+!!         amu=0.5*(sig(i)+sigold)*w
+!!         m(i)=amu*0.007*p(i)*(ph(i)-ph(i+1))/tv(i)
+!!         w0(i)=w
+!!   98 continue
+!!      w0(icb)=0.5*w0(icb+1)
+!!      m(icb)=0.5*m(icb+1)*(ph(icb)-ph(icb+1))/(ph(icb+1)-ph(icb+2))
+!!      sig(icb)=sig(icb+1)
+!!      sig(icb-1)=sig(icb)
   RETURN
 END SUBROUTINE cv3_closure
+SUBROUTINE cv3_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, ph, t, rr, rs, &
+    u, v, tra, h, lv, lf, frac, qnk, unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
+    ment, qent, uent, vent, nent, sij, elij, ments, qents, traent)
+SUBROUTINE cv3_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, &
+                      ph, t, rr, rs, u, v, tra, h, lv, lf, frac, qnk, &
+                      unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
+                      ment, qent, uent, vent, nent, sij, elij, ments, qents, traent)
   IMPLICIT NONE
   ! ---------------------------------------------------------------------
   ! a faire:
   ! - vectorisation de la partie normalisation des flux (do 789...)
   ! ---------------------------------------------------------------------
+! ---------------------------------------------------------------------
+! a faire:
+! - vectorisation de la partie normalisation des flux (do 789...)
+! ---------------------------------------------------------------------
   include "cvthermo.h"
 …
   include "cvflag.h"
   ! inputs:
+!inputs:
   INTEGER ncum, nd, na, ntra, nloc
   INTEGER icb(nloc), inb(nloc), nk(nloc)
 …
   REAL m(nloc, na) ! input of convect3
   ! outputs:
+!outputs:
   REAL ment(nloc, na, na), qent(nloc, na, na)
   REAL uent(nloc, na, na), vent(nloc, na, na)
 …
   INTEGER nent(nloc, nd)
   ! local variables:
+!local variables:
   INTEGER i, j, k, il, im, jm
   INTEGER num1, num2
 …
   LOGICAL lwork(nloc)
   ! =====================================================================
   ! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
   ! =====================================================================
   ! ori        do 360 i=1,ncum*nlp
+! =====================================================================
+! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
+! =====================================================================
+! ori        do 360 i=1,ncum*nlp
   DO j = 1, nl
     DO i = 1, ncum
       nent(i, j) = 0
       ! in convect3, m is computed in cv3_closure
       ! ori          m(i,1)=0.0
     END DO
   END DO
   ! ori      do 400 k=1,nlp
   ! ori       do 390 j=1,nlp
+! in convect3, m is computed in cv3_closure
+! ori          m(i,1)=0.0
+    END DO
+  END DO
+! ori      do 400 k=1,nlp
+! ori       do 390 j=1,nlp
   DO j = 1, nl
     DO k = 1, nl
 …
         vent(i, k, j) = v(i, j)
         elij(i, k, j) = 0.0
         ! ym            ment(i,k,j)=0.0
         ! ym            sij(i,k,j)=0.0
+!ym            ment(i,k,j)=0.0
+!ym            sij(i,k,j)=0.0
       END DO
     END DO
   END DO
   ! ym
+!ym
   ment(1:ncum, 1:nd, 1:nd) = 0.0
   sij(1:ncum, 1:nd, 1:nd) = 0.0
   ! AC!      do k=1,ntra
   ! AC!       do j=1,nd  ! instead nlp
   ! AC!        do i=1,nd ! instead nlp
   ! AC!         do il=1,ncum
   ! AC!            traent(il,i,j,k)=tra(il,j,k)
   ! AC!         enddo
   ! AC!        enddo
   ! AC!       enddo
   ! AC!      enddo
+!AC!      do k=1,ntra
+!AC!       do j=1,nd  ! instead nlp
+!AC!        do i=1,nd ! instead nlp
+!AC!         do il=1,ncum
+!AC!            traent(il,i,j,k)=tra(il,j,k)
+!AC!         enddo
+!AC!        enddo
+!AC!       enddo
+!AC!      enddo
   zm(:, :) = 0.
   ! =====================================================================
   ! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
   ! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
   ! --- FRACTION (sij)
   ! =====================================================================
+! =====================================================================
+! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
+! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
+! --- FRACTION (sij)
+! =====================================================================
   DO i = minorig + 1, nl
 …
     DO j = minorig, nl
       DO il = 1, ncum
+        IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)- &
+)) .AND. (j<=inb(il))) THEN
+        IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)-1)) .AND. (j<=inb(il))) THEN
           rti = qnk(il) - ep(il, i)*clw(il, i)
 …
           IF (cvflag_ice) THEN
             ! print*,cvflag_ice,'cvflag_ice dans do 700'
+! print*,cvflag_ice,'cvflag_ice dans do 700'
             IF (t(il,j)<=263.15) THEN
               bf2 = 1. + (lf(il,j)+lv(il,j))*(lv(il,j)+frac(il,j)*lf(il,j))* &
                 rs(il, j)/(rrv*t(il,j)*t(il,j)*cpd)
+              bf2 = 1. + (lf(il,j)+lv(il,j))*(lv(il,j)+frac(il,j)* &
+                   lf(il,j))*rs(il, j)/(rrv*t(il,j)*t(il,j)*cpd)
             END IF
           END IF
 …
             IF (cvflag_ice) THEN
+              anum = anum - (lv(il,j)+frac(il,j)*lf(il,j))*(rti-rs(il,j)-cwat &
+                *bf2)
+              anum = anum - (lv(il,j)+frac(il,j)*lf(il,j))*(rti-rs(il,j)-cwat*bf2)
               denom = denom + (lv(il,j)+frac(il,j)*lf(il,j))*(rr(il,i)-rti)
             ELSE
 …
             IF (abs(denom)<0.01) denom = 0.01
             sij(il, i, j) = anum/denom
+            altem = sij(il, i, j)*rr(il, i) + (1.-sij(il,i,j))*rti - &
+              rs(il, j)
+            altem = sij(il, i, j)*rr(il, i) + (1.-sij(il,i,j))*rti - rs(il, j)
             altem = altem - (bf2-1.)*cwat
           END IF
           IF (sij(il,i,j)>0.0 .AND. sij(il,i,j)<0.95) THEN
             qent(il, i, j) = sij(il, i, j)*rr(il, i) + (1.-sij(il,i,j))*rti
+            uent(il, i, j) = sij(il, i, j)*u(il, i) + &
+              (1.-sij(il,i,j))*unk(il)
+            vent(il, i, j) = sij(il, i, j)*v(il, i) + &
+              (1.-sij(il,i,j))*vnk(il)
+            ! !!!      do k=1,ntra
+            ! !!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
+            ! !!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
+            ! !!!      end do
+            uent(il, i, j) = sij(il, i, j)*u(il, i) + (1.-sij(il,i,j))*unk(il)
+            vent(il, i, j) = sij(il, i, j)*v(il, i) + (1.-sij(il,i,j))*vnk(il)
+!!!!      do k=1,ntra
+!!!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
+!!!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
+!!!!      end do
             elij(il, i, j) = altem
             elij(il, i, j) = max(0.0, elij(il,i,j))
 …
     END DO
+    ! AC!       do k=1,ntra
+    ! AC!        do j=minorig,nl
+    ! AC!         do il=1,ncum
+    ! AC!          if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+    ! AC!     :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
+    ! AC!            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
+    ! AC!     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
+    ! AC!          endif
+    ! AC!         enddo
+    ! AC!        enddo
+    ! AC!       enddo
+    ! ***   if no air can entrain at level i assume that updraft detrains
+    ! ***
+    ! ***   at that level and calculate detrained air flux and properties
+    ! ***
+    ! @      do 170 i=icb(il),inb(il)
+!AC!       do k=1,ntra
+!AC!        do j=minorig,nl
+!AC!         do il=1,ncum
+!AC!          if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
+!AC!     :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
+!AC!            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
+!AC!     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
+!AC!          endif
+!AC!         enddo
+!AC!        enddo
+!AC!       enddo
+! ***   if no air can entrain at level i assume that updraft detrains  ***
+! ***   at that level and calculate detrained air flux and properties  ***
+! @      do 170 i=icb(il),inb(il)
     DO il = 1, ncum
       IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
         ! @      if(nent(il,i).eq.0)then
+! @      if(nent(il,i).eq.0)then
         ment(il, i, i) = m(il, i)
         qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
 …
         vent(il, i, i) = vnk(il)
         elij(il, i, i) = clw(il, i)
         ! MAF      sij(il,i,i)=1.0
+! MAF      sij(il,i,i)=1.0
         sij(il, i, i) = 0.0
       END IF
 …
   END DO
+  ! AC!      do j=1,ntra
+  ! AC!       do i=minorig+1,nl
+  ! AC!        do il=1,ncum
+  ! AC!         if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0)
+  ! then
+  ! AC!          traent(il,i,i,j)=tra(il,nk(il),j)
+  ! AC!         endif
+  ! AC!        enddo
+  ! AC!       enddo
+  ! AC!      enddo
+!AC!      do j=1,ntra
+!AC!       do i=minorig+1,nl
+!AC!        do il=1,ncum
+!AC!         if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) then
+!AC!          traent(il,i,i,j)=tra(il,nk(il),j)
+!AC!         endif
+!AC!        enddo
+!AC!       enddo
+!AC!      enddo
   DO j = minorig, nl
     DO i = minorig, nl
       DO il = 1, ncum
+        IF ((j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. (i>=icb(il)) .AND. (i<= &
+            inb(il))) THEN
+        IF ((j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. (i>=icb(il)) .AND. (i<=inb(il))) THEN
           sigij(il, i, j) = sij(il, i, j)
         END IF
 …
     END DO
   END DO
   ! @      enddo
   ! @170   continue
   ! =====================================================================
   ! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
   ! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
   ! =====================================================================
+! @      enddo
+! @170   continue
+! =====================================================================
+! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
+! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
+! =====================================================================
   CALL zilch(asum, nloc*nd)
 …
         IF (cvflag_ice) THEN
           anum = h(il, i) - hp(il, i) - (lv(il,i)+frac(il,i)*lf(il,i))*(qp-rs &
             (il,i)) + (cpv-cpd)*t(il, i)*(qp-rr(il,i))
           denom = h(il, i) - hp(il, i) + (lv(il,i)+frac(il,i)*lf(il,i))*(rr( &
             il,i)-qp) + (cpd-cpv)*t(il, i)*(rr(il,i)-qp)
+          anum = h(il, i) - hp(il, i) - (lv(il,i)+frac(il,i)*lf(il,i))* &
+                       (qp-rs(il,i)) + (cpv-cpd)*t(il, i)*(qp-rr(il,i))
+          denom = h(il, i) - hp(il, i) + (lv(il,i)+frac(il,i)*lf(il,i))* &
+                       (rr(il,i)-qp) + (cpd-cpv)*t(il, i)*(rr(il,i)-qp)
         ELSE
           anum = h(il, i) - hp(il, i) - lv(il, i)*(qp-rs(il,i)) + &
             (cpv-cpd)*t(il, i)*(qp-rr(il,i))
+                       (cpv-cpd)*t(il, i)*(qp-rr(il,i))
           denom = h(il, i) - hp(il, i) + lv(il, i)*(rr(il,i)-qp) + &
             (cpd-cpv)*t(il, i)*(rr(il,i)-qp)
+                       (cpd-cpv)*t(il, i)*(rr(il,i)-qp)
         END IF
 …
       num2 = 0
       DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
+          il)-1) .AND. j<=inb(il) .AND. lwork(il)) num2 = num2 + 1
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
+            lwork(il)) num2 = num2 + 1
       END DO
       IF (num2<=0) GO TO 175
       DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
+            il)-1) .AND. j<=inb(il) .AND. lwork(il)) THEN
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
+            lwork(il)) THEN
           IF (sij(il,i,j)>1.0E-16 .AND. sij(il,i,j)<0.95) THEN
 …
     DO j = minorig, nl
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
             il)-1) .AND. j<=inb(il)) THEN
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
           ment(il, i, j) = ment(il, i, j)*asij(il)
         END IF
 …
     DO j = minorig, nl
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
             il)-1) .AND. j<=inb(il)) THEN
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
           asum(il, i) = asum(il, i) + ment(il, i, j)
           ment(il, i, j) = ment(il, i, j)*sig(il, j)
 …
     DO j = minorig, nl
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
             il)-1) .AND. j<=inb(il)) THEN
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
           ment(il, i, j) = ment(il, i, j)*asum(il, i)*bsum(il, i)
         END IF
 …
     DO j = minorig, nl
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
             il)-1) .AND. j<=inb(il)) THEN
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
           csum(il, i) = csum(il, i) + ment(il, i, j)
         END IF
 …
         vent(il, i, i) = vnk(il)
         elij(il, i, i) = clw(il, i)
         ! MAF        sij(il,i,i)=1.0
+! MAF        sij(il,i,i)=1.0
         sij(il, i, i) = 0.0
       END IF
     END DO ! il
     ! AC!      do j=1,ntra
     ! AC!       do il=1,ncum
     ! AC!        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
     ! AC!     :     .and. csum(il,i).lt.m(il,i) ) then
     ! AC!         traent(il,i,i,j)=tra(il,nk(il),j)
     ! AC!        endif
     ! AC!       enddo
     ! AC!      enddo
+!AC!      do j=1,ntra
+!AC!       do il=1,ncum
+!AC!        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
+!AC!     :     .and. csum(il,i).lt.m(il,i) ) then
+!AC!         traent(il,i,i,j)=tra(il,nk(il),j)
+!AC!        endif
+!AC!       enddo
+!AC!      enddo
 END DO
   ! MAF: renormalisation de MENT
+! MAF: renormalisation de MENT
   CALL zilch(zm, nloc*na)
   DO jm = 1, nd
 …
 END SUBROUTINE cv3_mixing
+SUBROUTINE cv3_unsat(nloc, ncum, nd, na, ntra, icb, inb, iflag, t, rr, rs, &
+    gz, u, v, tra, p, ph, th, tv, lv, lf, cpn, ep, sigp, clw, m, ment, elij, &
+    delt, plcl, coef_clos, mp, rp, up, vp, trap, wt, water, evap, fondue, &
+    ice, faci, b, sigd, wdtraina, wdtrainm) ! RomP
+SUBROUTINE cv3_unsat(nloc, ncum, nd, na, ntra, icb, inb, iflag, &
+                     t, rr, rs, gz, u, v, tra, p, ph, &
+                     th, tv, lv, lf, cpn, ep, sigp, clw, &
+                     m, ment, elij, delt, plcl, coef_clos, &
+                     mp, rp, up, vp, trap, wt, water, evap, fondue, ice, &
+                     faci, b, sigd, &
+                     wdtrainA, wdtrainM)                                      ! RomP
   IMPLICIT NONE
 …
   include "cvflag.h"
   ! inputs:
+!inputs:
   INTEGER ncum, nd, na, ntra, nloc
   INTEGER icb(nloc), inb(nloc)
 …
   REAL coef_clos(nloc)
   ! input/output
+!input/output
   INTEGER iflag(nloc)
   ! outputs:
+!outputs:
   REAL mp(nloc, na), rp(nloc, na), up(nloc, na), vp(nloc, na)
   REAL water(nloc, na), evap(nloc, na), wt(nloc, na)
 …
   REAL trap(nloc, na, ntra)
   REAL b(nloc, na), sigd(nloc)
   ! 25/08/10 - RomP---- ajout des masses precipitantes ejectees
   ! lascendance adiabatique et des flux melanges Pa et Pm.
   ! Distinction des wdtrain
   ! Pa = wdtrainA     Pm = wdtrainM
   REAL wdtraina(nloc, na), wdtrainm(nloc, na)
   ! local variables
+! 25/08/10 - RomP---- ajout des masses precipitantes ejectees
+! de l ascendance adiabatique et des flux melanges Pa et Pm.
+! Distinction des wdtrain
+! Pa = wdtrainA     Pm = wdtrainM
+  REAL wdtrainA(nloc, na), wdtrainM(nloc, na)
+!local variables
   INTEGER i, j, k, il, num1, ndp1
   REAL tinv, delti, coef
 …
   ! ------------------------------------------------------
+! ------------------------------------------------------
   delti = 1./delt
 …
     END DO
   END DO
   ! AC!        do k=1,ntra
   ! AC!         do i=1,nd
   ! AC!          do il=1,ncum
   ! AC!           trap(il,i,k)=tra(il,i,k)
   ! AC!          enddo
   ! AC!         enddo
   ! AC!        enddo
   ! ! RomP >>>
+!AC!        do k=1,ntra
+!AC!         do i=1,nd
+!AC!          do il=1,ncum
+!AC!           trap(il,i,k)=tra(il,i,k)
+!AC!          enddo
+!AC!         enddo
+!AC!        enddo
+!! RomP >>>
   DO i = 1, nd
     DO il = 1, ncum
       wdtraina(il, i) = 0.0
       wdtrainm(il, i) = 0.0
     END DO
   END DO
   ! ! RomP <<<
   ! ***  check whether ep(inb)=0, if so, skip precipitating    ***
   ! ***             downdraft calculation                      ***
+      wdtrainA(il, i) = 0.0
+      wdtrainM(il, i) = 0.0
+    END DO
+  END DO
+!! RomP <<<
+! ***  check whether ep(inb)=0, if so, skip precipitating    ***
+! ***             downdraft calculation                      ***
   DO il = 1, ncum
     ! !          lwork(il)=.TRUE.
     ! !          if(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
+!!          lwork(il)=.TRUE.
+!!          if(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
     lwork(il) = ep(il, inb(il)) >= 0.0001
   END DO
   ! ***  Set the fractionnal area sigd of precipitating downdraughts
+! ***  Set the fractionnal area sigd of precipitating downdraughts
   DO il = 1, ncum
     sigd(il) = sigdz*coef_clos(il)
 …
   ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   ! ***                    begin downdraft loop                    ***
   ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!
+! ***                    begin downdraft loop                    ***
+!
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   DO i = nl + 1, 1, -1
 …
     ! ***  integrate liquid water equation to find condensed water   ***
     ! ***                and condensed water flux                    ***
     ! ***              calculate detrained precipitation             ***
+! ***  integrate liquid water equation to find condensed water   ***
+! ***                and condensed water flux                    ***
+!
+!
+! ***              calculate detrained precipitation             ***
     DO il = 1, ncum
 …
         IF (cvflag_grav) THEN
           wdtrain(il) = grav*ep(il, i)*m(il, i)*clw(il, i)
           wdtraina(il, i) = wdtrain(il)/grav !   Pa   RomP
+          wdtrainA(il, i) = wdtrain(il)/grav                        !   Pa   RomP
         ELSE
           wdtrain(il) = 10.0*ep(il, i)*m(il, i)*clw(il, i)
           wdtraina(il, i) = wdtrain(il)/10. !   Pa   RomP
+          wdtrainA(il, i) = wdtrain(il)/10.                         !   Pa   RomP
         END IF
       END IF
 …
             IF (cvflag_grav) THEN
               wdtrain(il) = wdtrain(il) + grav*awat*ment(il, j, i)
               wdtrainm(il, i) = wdtrain(il)/grav - wdtraina(il, i) !   Pm  RomP
+              wdtrainM(il, i) = wdtrain(il)/grav - wdtrainA(il, i)  !   Pm  RomP
             ELSE
               wdtrain(il) = wdtrain(il) + 10.0*awat*ment(il, j, i)
               wdtrainm(il, i) = wdtrain(il)/10. - wdtraina(il, i) !   Pm  RomP
+              wdtrainM(il, i) = wdtrain(il)/10. - wdtrainA(il, i)   !   Pm  RomP
             END IF
           END IF
 …
     ! ***    find rain water and evaporation using provisional   ***
     ! ***              estimates of rp(i)and rp(i-1)             ***
+! ***    find rain water and evaporation using provisional   ***
+! ***              estimates of rp(i)and rp(i-1)             ***
 …
           END IF
           rp(il, i) = rp(il, i+1) + (cpd*(t(il,i+1)-t(il, &
             i))+gz(il,i+1)-gz(il,i))/lv(il, i)
+          rp(il, i) = rp(il, i+1) + &
+                      (cpd*(t(il,i+1)-t(il,i))+gz(il,i+1)-gz(il,i))/lv(il, i)
           rp(il, i) = 0.5*(rp(il,i)+rr(il,i))
         END IF
 …
           afac = p(il, 1)*(rs(il,1)-rp(il,1))/(1.0E4+2000.0*p(il,1)*rs(il,1))
           IF (cvflag_ice) THEN
+            afac1 = p(il, i)*(rs(il,1)-rp(il,1))/(1.0E4+2000.0*p(il,1)*rs(il, &
+))
+            afac1 = p(il, i)*(rs(il,1)-rp(il,1))/(1.0E4+2000.0*p(il,1)*rs(il,1))
           END IF
         ELSE
+          rp(il, i-1) = rp(il, i) + (cpd*(t(il,i)-t(il, &
+            i-1))+gz(il,i)-gz(il,i-1))/lv(il, i)
+          rp(il, i-1) = rp(il, i) + (cpd*(t(il,i)-t(il,i-1))+gz(il,i)-gz(il,i-1))/lv(il, i)
           rp(il, i-1) = 0.5*(rp(il,i-1)+rr(il,i-1))
           rp(il, i-1) = amin1(rp(il,i-1), rs(il,i-1))
           rp(il, i-1) = max(rp(il,i-1), 0.0)
+          afac1 = p(il, i)*(rs(il,i)-rp(il,i))/(1.0E4+2000.0*p(il,i)*rs(il,i) &
+            )
+          afac2 = p(il, i-1)*(rs(il,i-1)-rp(il,i-1))/ &
+            (1.0E4+2000.0*p(il,i-1)*rs(il,i-1))
+          afac1 = p(il, i)*(rs(il,i)-rp(il,i))/(1.0E4+2000.0*p(il,i)*rs(il,i))
+          afac2 = p(il, i-1)*(rs(il,i-1)-rp(il,i-1))/(1.0E4+2000.0*p(il,i-1)*rs(il,i-1))
           afac = 0.5*(afac1+afac2)
         END IF
 …
         bfac = 1./(sigd(il)*wt(il,i))
         ! jyg1
         ! cc        sigt=1.0
         ! cc        if(i.ge.icb)sigt=sigp(i)
         ! prise en compte de la variation progressive de sigt dans
         ! les couches icb et icb-1:
         ! pour plcl<ph(i+1), pr1=0 & pr2=1
         ! pour plcl>ph(i),   pr1=1 & pr2=0
         ! pour ph(i+1)<plcl<ph(i), pr1 est la proportion a cheval
         ! sur le nuage, et pr2 est la proportion sous la base du
         ! nuage.
+!JYG1
+! cc        sigt=1.0
+! cc        if(i.ge.icb)sigt=sigp(i)
+! prise en compte de la variation progressive de sigt dans
+! les couches icb et icb-1:
+! pour plcl<ph(i+1), pr1=0 & pr2=1
+! pour plcl>ph(i),   pr1=1 & pr2=0
+! pour ph(i+1)<plcl<ph(i), pr1 est la proportion a cheval
+! sur le nuage, et pr2 est la proportion sous la base du
+! nuage.
         pr1 = (plcl(il)-ph(il,i+1))/(ph(il,i)-ph(il,i+1))
         pr1 = max(0., min(1.,pr1))
 …
         pr2 = max(0., min(1.,pr2))
         sigt = sigp(il, i)*pr1 + pr2
+        ! jyg2
+        ! jyg----
+        ! b6 = bfac*100.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
+        ! c6 = water(il,i+1) + wdtrain(il)*bfac
+        ! c6 = prec(il,i+1) + wdtrain(il)*bfac
+        ! revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
+        ! evap(il,i)=sigt*afac*revap
+        ! water(il,i)=revap*revap
+        ! prec(il,i)=revap*revap
+        ! c        print *,' i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il)
+        ! ',
+        ! c     $            i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il)
+        ! c---end jyg---
+        ! --------retour à la formulation originale d'Emanuel.
+!JYG2
+!JYG----
+!    b6 = bfac*100.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
+!    c6 = water(il,i+1) + wdtrain(il)*bfac
+!    c6 = prec(il,i+1) + wdtrain(il)*bfac
+!    revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
+!    evap(il,i)=sigt*afac*revap
+!    water(il,i)=revap*revap
+!    prec(il,i)=revap*revap
+!!        print *,' i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il) ', &
+!!                 i,b6,c6,revap,evap(il,i),water(il,i),wdtrain(il)
+!!---end jyg---
+! --------retour à la formulation originale d'Emanuel.
         IF (cvflag_ice) THEN
           ! b6=bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
+          ! c6=prec(il,i+1)+bfac*wdtrain(il)
           ! :    -50.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il,i+1)
           ! if(c6.gt.0.0)then
           ! revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
           ! JAM  Attention: evap=sigt*E
           ! Modification: evap devient l'évaporation en milieu de couche
           ! car nécessaire dans cv3_yield
           ! Du coup, il faut modifier pas mal d'équations...
           ! et l'expression de afac qui devient afac1
           ! revap=sqrt((prec(i+1)+prec(i))/2)
+!   b6=bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
+!   c6=prec(il,i+1)+bfac*wdtrain(il) &
+!       -50.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il,i+1)
+!   if(c6.gt.0.0)then
+!   revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
+!JAM  Attention: evap=sigt*E
+!    Modification: evap devient l'évaporation en milieu de couche
+!    car nécessaire dans cv3_yield
+!    Du coup, il faut modifier pas mal d'équations...
+!    et l'expression de afac qui devient afac1
+!    revap=sqrt((prec(i+1)+prec(i))/2)
           b6 = bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac1
           c6 = prec(il, i+1) + 0.5*bfac*wdtrain(il)
           ! print *,'bfac,sigd(il),sigt,afac1 ',bfac,sigd(il),sigt,afac1
           ! print *,'prec(il,i+1),wdtrain(il) ',prec(il,i+1),wdtrain(il)
           ! print *,'b6,c6,b6*b6+4.*c6 ',b6,c6,b6*b6+4.*c6
+! print *,'bfac,sigd(il),sigt,afac1 ',bfac,sigd(il),sigt,afac1
+! print *,'prec(il,i+1),wdtrain(il) ',prec(il,i+1),wdtrain(il)
+! print *,'b6,c6,b6*b6+4.*c6 ',b6,c6,b6*b6+4.*c6
           IF (c6>b6*b6+1.E-20) THEN
             revap = 2.*c6/(b6+sqrt(b6*b6+4.*c6))
 …
           END IF
           prec(il, i) = max(0., 2.*revap*revap-prec(il,i+1))
+          ! print*,prec(il,i),'neige'
+          ! jyg    Dans sa formulation originale, Emanuel calcule
+          ! l'evaporation par:
+          ! c             evap(il,i)=sigt*afac*revap
+          ! ce qui n'est pas correct. Dans cv_routines, la formulation a été
+          ! modifiee.
+          ! Ici,l'evaporation evap est simplement calculee par l'equation de
+          ! conservation.
+          ! prec(il,i)=revap*revap
+          ! else
+          ! jyg----   Correction : si c6 <= 0, water(il,i)=0.
+          ! prec(il,i)=0.
+          ! endif
+          ! jyg---   Dans tous les cas, evaporation = [tt ce qui entre dans
+          ! la couche i]
+          ! moins [tt ce qui sort de la couche i]
+          ! print *, 'evap avec ice'
+          evap(il, i) = (wdtrain(il)+sigd(il)*wt(il,i)*(prec(il,i+1)-prec(il, &
+            i)))/(sigd(il)*(ph(il,i)-ph(il,i+1))*100.)
+          d6 = bfac*wdtrain(il) - 100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))* &
+            evap(il, i)
+! print*,prec(il,i),'neige'
+!JYG    Dans sa formulation originale, Emanuel calcule l'evaporation par:
+! c             evap(il,i)=sigt*afac*revap
+! ce qui n'est pas correct. Dans cv_routines, la formulation a été modifiee.
+! Ici,l'evaporation evap est simplement calculee par l'equation de
+! conservation.
+! prec(il,i)=revap*revap
+! else
+!JYG----   Correction : si c6 <= 0, water(il,i)=0.
+! prec(il,i)=0.
+! endif
+!JYG---   Dans tous les cas, evaporation = [tt ce qui entre dans la couche i]
+! moins [tt ce qui sort de la couche i]
+! print *, 'evap avec ice'
+          evap(il, i) = (wdtrain(il)+sigd(il)*wt(il,i)*(prec(il,i+1)-prec(il,i))) / &
+                        (sigd(il)*(ph(il,i)-ph(il,i+1))*100.)
+          d6 = bfac*wdtrain(il) - 100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i)
           e6 = bfac*wdtrain(il)
           f6 = -100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i)
 …
           END IF
           ! water(il,i)=water(il,i+1)+(1.-fraci(il,i))*e6+(1.-faci(il,i))*f6
           ! water(il,i)=max(water(il,i),0.)
           ! ice(il,i)=ice(il,i+1)+fraci(il,i)*e6+faci(il,i)*f6
           ! ice(il,i)=max(ice(il,i),0.)
           ! fondue(il,i)=ice(il,i)*thaw
           ! water(il,i)=water(il,i)+fondue(il,i)
           ! ice(il,i)=ice(il,i)-fondue(il,i)
           ! if((water(il,i)+ice(il,i)).lt.1.e-30)then
           ! faci(il,i)=0.
           ! else
           ! faci(il,i)=ice(il,i)/(water(il,i)+ice(il,i))
           ! endif
+!           water(il,i)=water(il,i+1)+(1.-fraci(il,i))*e6+(1.-faci(il,i))*f6
+!           water(il,i)=max(water(il,i),0.)
+!           ice(il,i)=ice(il,i+1)+fraci(il,i)*e6+faci(il,i)*f6
+!           ice(il,i)=max(ice(il,i),0.)
+!           fondue(il,i)=ice(il,i)*thaw
+!           water(il,i)=water(il,i)+fondue(il,i)
+!           ice(il,i)=ice(il,i)-fondue(il,i)
+!           if((water(il,i)+ice(il,i)).lt.1.e-30)then
+!             faci(il,i)=0.
+!           else
+!             faci(il,i)=ice(il,i)/(water(il,i)+ice(il,i))
+!           endif
         ELSE
           b6 = bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
           c6 = water(il, i+1) + bfac*wdtrain(il) - 50.*sigd(il)*bfac*(ph(il,i &
             )-ph(il,i+1))*evap(il, i+1)
+          c6 = water(il, i+1) + bfac*wdtrain(il) - &
+.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i+1)
           IF (c6>0.0) THEN
             revap = 0.5*(-b6+sqrt(b6*b6+4.*c6))
 …
             water(il, i) = 0.
           END IF
           ! print *, 'evap sans ice'
           evap(il, i) = (wdtrain(il)+sigd(il)*wt(il,i)*(water(il, &
             i+1)-water(il,i)))/(sigd(il)*(ph(il,i)-ph(il,i+1))*100.)
+! print *, 'evap sans ice'
+          evap(il, i) = (wdtrain(il)+sigd(il)*wt(il,i)*(water(il,i+1)-water(il,i)))/ &
+                        (sigd(il)*(ph(il,i)-ph(il,i+1))*100.)
         END IF
       END IF !(i.le.inb(il) .and. lwork(il))
     END DO
     ! ----------------------------------------------------------------
     ! cc
     ! ***  calculate precipitating downdraft mass flux under     ***
     ! ***              hydrostatic approximation                 ***
+! ----------------------------------------------------------------
+! cc
+! ***  calculate precipitating downdraft mass flux under     ***
+! ***              hydrostatic approximation                 ***
     DO il = 1, ncum
 …
         IF (cvflag_ice) THEN
           IF (cvflag_grav) THEN
+            mp(il, i) = 100.*ginv*(lvcp(il,i)*sigd(il)*tevap(il)*(p(il, &
+              i-1)-p(il,i))/delth+lfcp(il,i)*sigd(il)*faci(il,i)*tevap(il)*(p &
+              (il,i-1)-p(il,i))/delth+lfcp(il,i)*sigd(il)*wt(il,i)/100.* &
+              fondue(il,i)*(p(il,i-1)-p(il,i))/delth/(ph(il,i)-ph(il,i+1)))
+            mp(il, i) = 100.*ginv*(lvcp(il,i)*sigd(il)*tevap(il)* &
+                                               (p(il,i-1)-p(il,i))/delth + &
+                                   lfcp(il,i)*sigd(il)*faci(il,i)*tevap(il)* &
+                                               (p(il,i-1)-p(il,i))/delth + &
+                                   lfcp(il,i)*sigd(il)*wt(il,i)/100.*fondue(il,i)* &
+                                               (p(il,i-1)-p(il,i))/delth/(ph(il,i)-ph(il,i+1)))
           ELSE
+            mp(il, i) = 10.*(lvcp(il,i)*sigd(il)*tevap(il)*(p(il,i-1)-p(il, &
+              i))/delth+lfcp(il,i)*sigd(il)*faci(il,i)*tevap(il)*(p(il, &
+              i-1)-p(il,i))/delth+lfcp(il,i)*sigd(il)*wt(il,i)/100.*fondue(il &
+              ,i)*(p(il,i-1)-p(il,i))/delth/(ph(il,i)-ph(il,i+1)))
+            mp(il, i) = 10.*(lvcp(il,i)*sigd(il)*tevap(il)* &
+                                                (p(il,i-1)-p(il,i))/delth + &
+                             lfcp(il,i)*sigd(il)*faci(il,i)*tevap(il)* &
+                                                (p(il,i-1)-p(il,i))/delth + &
+                             lfcp(il,i)*sigd(il)*wt(il,i)/100.*fondue(il,i)* &
+                                                (p(il,i-1)-p(il,i))/delth/(ph(il,i)-ph(il,i+1)))
           END IF
 …
           IF (cvflag_grav) THEN
             mp(il, i) = 100.*ginv*lvcp(il, i)*sigd(il)*tevap(il)* &
               (p(il,i-1)-p(il,i))/delth
+                                                (p(il,i-1)-p(il,i))/delth
           ELSE
             mp(il, i) = 10.*lvcp(il, i)*sigd(il)*tevap(il)* &
               (p(il,i-1)-p(il,i))/delth
+                                                (p(il,i-1)-p(il,i))/delth
           END IF
 …
       END IF !(i.le.inb(il) .and. lwork(il) .and. i.ne.1)
     END DO
     ! ----------------------------------------------------------------
     ! ***           if hydrostatic assumption fails,             ***
     ! ***   solve cubic difference equation for downdraft theta  ***
     ! ***  and mass flux from two simultaneous differential eqns ***
+! ----------------------------------------------------------------
+! ***           if hydrostatic assumption fails,             ***
+! ***   solve cubic difference equation for downdraft theta  ***
+! ***  and mass flux from two simultaneous differential eqns ***
     DO il = 1, ncum
 …
         amfac = sigd(il)*sigd(il)*70.0*ph(il, i)*(p(il,i-1)-p(il,i))* &
           (th(il,i)-th(il,i-1))/(tv(il,i)*th(il,i))
+                         (th(il,i)-th(il,i-1))/(tv(il,i)*th(il,i))
         amp2 = abs(mp(il,i+1)*mp(il,i+1)-mp(il,i)*mp(il,i))
         IF (amp2>(0.1*amfac)) THEN
           xf = 100.0*sigd(il)*sigd(il)*sigd(il)*(ph(il,i)-ph(il,i+1))
           tf = b(il, i) - 5.0*(th(il,i)-th(il,i-1))*t(il, i)/(lvcp(il,i)*sigd &
             (il)*th(il,i))
+          tf = b(il, i) - 5.0*(th(il,i)-th(il,i-1))*t(il, i) / &
+                              (lvcp(il,i)*sigd(il)*th(il,i))
           af = xf*tf + mp(il, i+1)*mp(il, i+1)*tinv
           IF (cvflag_ice) THEN
             bf = 2.*(tinv*mp(il,i+1))**3 + tinv*mp(il, i+1)*xf*tf + &
+.*(p(il,i-1)-p(il,i))*xf*(tevap(il)*(1.+(lf(il,i)/lv(il,i))* &
+              faci(il,i))+(lf(il,i)/lv(il,i))*wt(il,i)/100.*fondue(il,i)/(ph( &
+              il,i)-ph(il,i+1)))
+.*(p(il,i-1)-p(il,i))*xf*(tevap(il)*(1.+(lf(il,i)/lv(il,i))*faci(il,i)) + &
+                (lf(il,i)/lv(il,i))*wt(il,i)/100.*fondue(il,i)/(ph(il,i)-ph(il,i+1)))
           ELSE
             bf = 2.*(tinv*mp(il,i+1))**3 + tinv*mp(il, i+1)*xf*tf + &
 .*(p(il,i-1)-p(il,i))*xf*tevap(il)
+.*(p(il,i-1)-p(il,i))*xf*tevap(il)
           END IF
 …
             IF ((0.5*bf-sru)<0.0) fac = -1.0
             mp(il, i) = mp(il, i+1)*tinv + (0.5*bf+sru)**tinv + &
               fac*(abs(0.5*bf-sru))**tinv
+                                           fac*(abs(0.5*bf-sru))**tinv
           ELSE
             d = atan(2.*sqrt(-ur)/(bf+1.0E-28))
 …
           IF (cvflag_ice) THEN
             IF (cvflag_grav) THEN
+              ! jyg : il y a vraisemblablement une erreur dans la ligne 2
+              ! suivante:
+              ! il faut diviser par (mp(il,i)*sigd(il)*grav) et non par
               ! (mp(il,i)+sigd(il)*0.1).
               ! Et il faut bien revoir les facteurs 100.
               b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*(tevap(il)*( &
 .+(lf(il,i)/lv(il,i))*faci(il,i))+(lf(il,i)/lv(il, &
                 i))*wt(il,i)/100.*fondue(il,i)/(ph(il,i)-ph(il, &
                 i+1)))/(mp(il,i)+sigd(il)*0.1) - 10.0*(th(il,i)-th(il,i-1))*t &
                 (il, i)/(lvcp(il,i)*sigd(il)*th(il,i))
+!JYG : il y a vraisemblablement une erreur dans la ligne 2 suivante:
+! il faut diviser par (mp(il,i)*sigd(il)*grav) et non par (mp(il,i)+sigd(il)*0.1).
+! Et il faut bien revoir les facteurs 100.
+              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))* &
+                           (tevap(il)*(1.+(lf(il,i)/lv(il,i))*faci(il,i)) + &
+                           (lf(il,i)/lv(il,i))*wt(il,i)/100.*fondue(il,i) / &
+                           (ph(il,i)-ph(il,i+1))) / &
+                           (mp(il,i)+sigd(il)*0.1) - &
+.0*(th(il,i)-th(il,i-1))*t(il, i) / &
+                           (lvcp(il,i)*sigd(il)*th(il,i))
             ELSE
+              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*(tevap(il)*( &
+.+(lf(il,i)/lv(il,i))*faci(il,i))+(lf(il,i)/lv(il, &
+                i))*wt(il,i)/100.*fondue(il,i)/(ph(il,i)-ph(il, &
+                i+1)))/(mp(il,i)+sigd(il)*0.1) - 10.0*(th(il,i)-th(il,i-1))*t &
+                (il, i)/(lvcp(il,i)*sigd(il)*th(il,i))
+              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*&
+                           (tevap(il)*(1.+(lf(il,i)/lv(il,i))*faci(il,i)) + &
+                           (lf(il,i)/lv(il,i))*wt(il,i)/100.*fondue(il,i) / &
+                           (ph(il,i)-ph(il,i+1))) / &
+                           (mp(il,i)+sigd(il)*0.1) - &
+.0*(th(il,i)-th(il,i-1))*t(il, i) / &
+                           (lvcp(il,i)*sigd(il)*th(il,i))
             END IF
           ELSE
             IF (cvflag_grav) THEN
+              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*tevap(il)/(mp &
+                (il,i)+sigd(il)*0.1) - 10.0*(th(il,i)-th(il,i-1))*t(il, i)/( &
+                lvcp(il,i)*sigd(il)*th(il,i))
+              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*tevap(il) / &
+                           (mp(il,i)+sigd(il)*0.1) - &
+.0*(th(il,i)-th(il,i-1))*t(il, i) / &
+                           (lvcp(il,i)*sigd(il)*th(il,i))
             ELSE
+              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*tevap(il)/(mp &
+                (il,i)+sigd(il)*0.1) - 10.0*(th(il,i)-th(il,i-1))*t(il, i)/( &
+                lvcp(il,i)*sigd(il)*th(il,i))
+              b(il, i-1) = b(il, i) + 100.0*(p(il,i-1)-p(il,i))*tevap(il) / &
+                           (mp(il,i)+sigd(il)*0.1) - &
+.0*(th(il,i)-th(il,i-1))*t(il, i) / &
+                           (lvcp(il,i)*sigd(il)*th(il,i))
             END IF
           END IF
 …
         END IF !(amp2.gt.(0.1*amfac))
         ! ***         limit magnitude of mp(i) to meet cfl condition      ***
+! ***         limit magnitude of mp(i) to meet cfl condition      ***
         ampmax = 2.0*(ph(il,i)-ph(il,i+1))*delti
 …
         mp(il, i) = min(mp(il,i), ampmax)
+        ! ***      force mp to decrease linearly to zero                 ***
+        ! ***       between cloud base and the surface                   ***
+        ! c      if(p(il,i).gt.p(il,icb(il)))then
+        ! c
+        ! mp(il,i)=mp(il,icb(il))*(p(il,1)-p(il,i))/(p(il,1)-p(il,icb(il)))
+        ! c      endif
+! ***      force mp to decrease linearly to zero                 ***
+! ***       between cloud base and the surface                   ***
+! c      if(p(il,i).gt.p(il,icb(il)))then
+! c       mp(il,i)=mp(il,icb(il))*(p(il,1)-p(il,i))/(p(il,1)-p(il,icb(il)))
+! c      endif
         IF (ph(il,i)>0.9*plcl(il)) THEN
           mp(il, i) = mp(il, i)*(ph(il,1)-ph(il,i))/(ph(il,1)-0.9*plcl(il))
 …
       END IF ! (i.le.inb(il) .and. lwork(il) .and. i.ne.1)
     END DO
     ! ----------------------------------------------------------------
     ! ***       find mixing ratio of precipitating downdraft     ***
+! ----------------------------------------------------------------
+! ***       find mixing ratio of precipitating downdraft     ***
     DO il = 1, ncum
 …
           IF (cvflag_grav) THEN
+            rp(il, i) = rp(il, i+1)*mp(il, i+1) + rr(il, i)*(mp(il,i)-mp(il,i &
+              +1)) + 100.*ginv*0.5*sigd(il)*(ph(il,i)-ph(il,i+1))*(evap(il,i+ &
+)+evap(il,i))
+            rp(il, i) = rp(il, i+1)*mp(il, i+1) + rr(il, i)*(mp(il,i)-mp(il,i+1)) + &
+.*ginv*0.5*sigd(il)*(ph(il,i)-ph(il,i+1))*(evap(il,i+1)+evap(il,i))
           ELSE
+            rp(il, i) = rp(il, i+1)*mp(il, i+1) + rr(il, i)*(mp(il,i)-mp(il,i &
+              +1)) + 5.*sigd(il)*(ph(il,i)-ph(il,i+1))*(evap(il,i+1)+evap(il, &
+              i))
+            rp(il, i) = rp(il, i+1)*mp(il, i+1) + rr(il, i)*(mp(il,i)-mp(il,i+1)) + &
+.*sigd(il)*(ph(il,i)-ph(il,i+1))*(evap(il,i+1)+evap(il,i))
           END IF
           rp(il, i) = rp(il, i)/mp(il, i)
+          up(il, i) = up(il, i+1)*mp(il, i+1) + u(il, i)*(mp(il,i)-mp(il,i+1) &
+            )
+          up(il, i) = up(il, i+1)*mp(il, i+1) + u(il, i)*(mp(il,i)-mp(il,i+1))
           up(il, i) = up(il, i)/mp(il, i)
+          vp(il, i) = vp(il, i+1)*mp(il, i+1) + v(il, i)*(mp(il,i)-mp(il,i+1) &
+            )
+          vp(il, i) = vp(il, i+1)*mp(il, i+1) + v(il, i)*(mp(il,i)-mp(il,i+1))
           vp(il, i) = vp(il, i)/mp(il, i)
 …
           IF (mp(il,i+1)>1.0E-16) THEN
             IF (cvflag_grav) THEN
               rp(il, i) = rp(il, i+1) + 100.*ginv*0.5*sigd(il)*(ph(il,i)-ph( &
                 il,i+1))*(evap(il,i+1)+evap(il,i))/mp(il, i+1)
+              rp(il, i) = rp(il,i+1) + 100.*ginv*0.5*sigd(il)*(ph(il,i)-ph(il,i+1)) * &
+                                       (evap(il,i+1)+evap(il,i))/mp(il,i+1)
             ELSE
               rp(il, i) = rp(il, i+1) + 5.*sigd(il)*(ph(il,i)-ph(il,i+1))*( &
                 evap(il,i+1)+evap(il,i))/mp(il, i+1)
+              rp(il, i) = rp(il,i+1) + 5.*sigd(il)*(ph(il,i)-ph(il,i+1)) * &
+                                       (evap(il,i+1)+evap(il,i))/mp(il, i+1)
             END IF
             up(il, i) = up(il, i+1)
 …
       END IF ! (i.lt.inb(il) .and. lwork(il))
     END DO
     ! ----------------------------------------------------------------
     ! ***       find tracer concentrations in precipitating downdraft     ***
     ! AC!      do j=1,ntra
     ! AC!       do il = 1,ncum
     ! AC!       if (i.lt.inb(il) .and. lwork(il)) then
     ! AC!c
     ! AC!         if(mplus(il))then
     ! AC!          trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
     ! AC!     :              +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
     ! AC!          trap(il,i,j)=trap(il,i,j)/mp(il,i)
     ! AC!         else ! if (mplus(il))
     ! AC!          if(mp(il,i+1).gt.1.0e-16)then
     ! AC!           trap(il,i,j)=trap(il,i+1,j)
     ! AC!          endif
     ! AC!         endif ! (mplus(il)) else if (.not.mplus(il))
     ! AC!c
     ! AC!        endif ! (i.lt.inb(il) .and. lwork(il))
     ! AC!       enddo
     ! AC!      end do
+! ----------------------------------------------------------------
+! ***       find tracer concentrations in precipitating downdraft     ***
+!AC!      do j=1,ntra
+!AC!       do il = 1,ncum
+!AC!       if (i.lt.inb(il) .and. lwork(il)) then
+!AC!c
+!AC!         if(mplus(il))then
+!AC!          trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
+!AC!     :              +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
+!AC!          trap(il,i,j)=trap(il,i,j)/mp(il,i)
+!AC!         else ! if (mplus(il))
+!AC!          if(mp(il,i+1).gt.1.0e-16)then
+!AC!           trap(il,i,j)=trap(il,i+1,j)
+!AC!          endif
+!AC!         endif ! (mplus(il)) else if (.not.mplus(il))
+!AC!c
+!AC!        endif ! (i.lt.inb(il) .and. lwork(il))
+!AC!       enddo
+!AC!      end do
 END DO
   ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   ! ***                    end of downdraft loop                    ***
   ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! ***                    end of downdraft loop                    ***
+! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 …
 END SUBROUTINE cv3_unsat
+SUBROUTINE cv3_yield(nloc, ncum, nd, na, ntra, icb, inb, delt, t, rr, t_wake, &
+    rr_wake, s_wake, u, v, tra, gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
+    ep, clw, m, tp, mp, rp, up, vp, trap, wt, water, ice, evap, fondue, faci, &
+    b, sigd, ment, qent, hent, iflag_mix, uent, vent, nent, elij, traent, &
+    sig, tv, tvp, wghti, iflag, precip, vprecip, ft, fr, fu, fv, ftra, cbmf, &
+    upwd, dnwd, dnwd0, ma, mip, tls, tps, qcondc, wd, ftd, fqd)
+SUBROUTINE cv3_yield(nloc, ncum, nd, na, ntra, ok_conserv_q, &
+                     icb, inb, delt, &
+                     t, rr, t_wake, rr_wake, s_wake, u, v, tra, &
+                     gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
+                     ep, clw, m, tp, mp, rp, up, vp, trap, &
+                     wt, water, ice, evap, fondue, faci, b, sigd, &
+                     ment, qent, hent, iflag_mix, uent, vent, &
+                     nent, elij, traent, sig, &
+                     tv, tvp, wghti, &
+                     iflag, precip, Vprecip, ft, fr, fu, fv, ftra, &
+                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
+                     tls, tps, qcondc, wd, &
+                     ftd, fqd)
   IMPLICIT NONE
 …
   include "conema3.h"
+  ! inputs:
+  ! print*,'cv3_yield apres include'
+  INTEGER iflag_mix
+  INTEGER ncum, nd, na, ntra, nloc
+  INTEGER icb(nloc), inb(nloc)
+  REAL delt
+  REAL t(nloc, nd), rr(nloc, nd), u(nloc, nd), v(nloc, nd)
+  REAL t_wake(nloc, nd), rr_wake(nloc, nd)
+  REAL s_wake(nloc)
+  REAL tra(nloc, nd, ntra), sig(nloc, nd)
+  REAL gz(nloc, na), ph(nloc, nd+1), h(nloc, na), hp(nloc, na)
+  REAL th(nloc, na), p(nloc, nd), tp(nloc, na)
+  REAL lv(nloc, na), cpn(nloc, na), ep(nloc, na), clw(nloc, na)
+  REAL lf(nloc, na)
+  REAL m(nloc, na), mp(nloc, na), rp(nloc, na), up(nloc, na)
+  REAL vp(nloc, na), wt(nloc, nd), trap(nloc, nd, ntra)
+  REAL water(nloc, na), evap(nloc, na), b(nloc, na), sigd(nloc)
+  REAL fondue(nloc, na), faci(nloc, na), ice(nloc, na)
+  REAL ment(nloc, na, na), qent(nloc, na, na), uent(nloc, na, na)
+  REAL hent(nloc, na, na)
+  ! IM bug   real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
+  REAL vent(nloc, na, na), elij(nloc, na, na)
+  INTEGER nent(nloc, nd)
+  REAL traent(nloc, na, na, ntra)
+  REAL tv(nloc, nd), tvp(nloc, nd), wghti(nloc, nd)
+  ! print*,'cv3_yield declarations 1'
+  ! input/output:
+  INTEGER iflag(nloc)
+  ! outputs:
+  REAL precip(nloc)
+  REAL ft(nloc, nd), fr(nloc, nd), fu(nloc, nd), fv(nloc, nd)
+  REAL ftd(nloc, nd), fqd(nloc, nd)
+  REAL ftra(nloc, nd, ntra)
+  REAL upwd(nloc, nd), dnwd(nloc, nd), ma(nloc, nd)
+  REAL dnwd0(nloc, nd), mip(nloc, nd)
+  REAL vprecip(nloc, nd+1)
+  REAL tls(nloc, nd), tps(nloc, nd)
+  REAL qcondc(nloc, nd) ! cld
+  REAL wd(nloc) ! gust
+  REAL cbmf(nloc)
+  ! print*,'cv3_yield declarations 2'
+  ! local variables:
+  INTEGER i, k, il, n, j, num1
+  REAL rat, delti
+  REAL ax, bx, cx, dx, ex
+  REAL cpinv, rdcp, dpinv
+  REAL awat(nloc)
+  REAL lvcp(nloc, na), lfcp(nloc, na), mke(nloc, na)
+  REAL am(nloc), work(nloc), ad(nloc), amp1(nloc)
+  ! !!      real up1(nloc), dn1(nloc)
+  REAL up1(nloc, nd, nd), dn1(nloc, nd, nd)
+  REAL asum(nloc), bsum(nloc), csum(nloc), dsum(nloc)
+  REAL esum(nloc), fsum(nloc), gsum(nloc), hsum(nloc)
+  REAL th_wake(nloc, nd)
+  REAL alpha_qpos(nloc), alpha_qpos1(nloc)
+  REAL qcond(nloc, nd), nqcond(nloc, nd), wa(nloc, nd) ! cld
+  REAL siga(nloc, nd), sax(nloc, nd), mac(nloc, nd) ! cld
+  ! print*,'cv3_yield declarations 3'
+  ! -------------------------------------------------------------
+  ! initialization:
+!inputs:
+      INTEGER iflag_mix
+      INTEGER ncum, nd, na, ntra, nloc
+      LOGICAL ok_conserv_q
+      INTEGER icb(nloc), inb(nloc)
+      REAL delt
+      REAL t(nloc, nd), rr(nloc, nd), u(nloc, nd), v(nloc, nd)
+      REAL t_wake(nloc, nd), rr_wake(nloc, nd)
+      REAL s_wake(nloc)
+      REAL tra(nloc, nd, ntra), sig(nloc, nd)
+      REAL gz(nloc, na), ph(nloc, nd+1), h(nloc, na), hp(nloc, na)
+      REAL th(nloc, na), p(nloc, nd), tp(nloc, na)
+      REAL lv(nloc, na), cpn(nloc, na), ep(nloc, na), clw(nloc, na)
+      REAL lf(nloc, na)
+      REAL m(nloc, na), mp(nloc, na), rp(nloc, na), up(nloc, na)
+      REAL vp(nloc, na), wt(nloc, nd), trap(nloc, nd, ntra)
+      REAL water(nloc, na), evap(nloc, na), b(nloc, na), sigd(nloc)
+      REAL fondue(nloc, na), faci(nloc, na), ice(nloc, na)
+      REAL ment(nloc, na, na), qent(nloc, na, na), uent(nloc, na, na)
+      REAL hent(nloc, na, na)
+!IM bug   real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
+      REAL vent(nloc, na, na), elij(nloc, na, na)
+      INTEGER nent(nloc, nd)
+      REAL traent(nloc, na, na, ntra)
+      REAL tv(nloc, nd), tvp(nloc, nd), wghti(nloc, nd)
+!
+!input/output:
+      INTEGER iflag(nloc)
+!
+!outputs:
+      REAL precip(nloc)
+      REAL ft(nloc, nd), fr(nloc, nd), fu(nloc, nd), fv(nloc, nd)
+      REAL ftd(nloc, nd), fqd(nloc, nd)
+      REAL ftra(nloc, nd, ntra)
+      REAL upwd(nloc, nd), dnwd(nloc, nd), ma(nloc, nd)
+      REAL dnwd0(nloc, nd), mip(nloc, nd)
+      REAL Vprecip(nloc, nd+1)
+      REAL tls(nloc, nd), tps(nloc, nd)
+      REAL qcondc(nloc, nd) ! cld
+      REAL wd(nloc) ! gust
+      REAL cbmf(nloc)
+!
+!local variables:
+      INTEGER i, k, il, n, j, num1
+      REAL rat, delti
+      REAL ax, bx, cx, dx, ex
+      REAL cpinv, rdcp, dpinv
+      REAL awat(nloc)
+      REAL lvcp(nloc, na), lfcp(nloc, na), mke(nloc, na)
+      REAL am(nloc), work(nloc), ad(nloc), amp1(nloc)
+!!      real up1(nloc), dn1(nloc)
+      REAL up1(nloc, nd, nd), dn1(nloc, nd, nd)
+      REAL asum(nloc), bsum(nloc), csum(nloc), dsum(nloc)
+      REAL esum(nloc), fsum(nloc), gsum(nloc), hsum(nloc)
+      REAL th_wake(nloc, nd)
+      REAL alpha_qpos(nloc), alpha_qpos1(nloc)
+      REAL qcond(nloc, nd), nqcond(nloc, nd), wa(nloc, nd) ! cld
+      REAL siga(nloc, nd), sax(nloc, nd), mac(nloc, nd) ! cld
+      REAL sumdq !jyg
+!
+! -------------------------------------------------------------
+! initialization:
   delti = 1.0/delt
+  ! print*,'cv3_yield initialisation delt', delt
+  ! precip,Vprecip,ft,fr,fu,fv,ftra
+  ! :                    ,cbmf,upwd,dnwd,dnwd0,ma,mip
+  ! :                    ,tls,tps,qcondc,wd
+  ! :                    ,ftd,fqd  )
+! print*,'cv3_yield initialisation delt', delt
+!
   DO il = 1, ncum
     precip(il) = 0.0
     vprecip(il, nd+1) = 0.0
+    Vprecip(il, nd+1) = 0.0
     wd(il) = 0.0 ! gust
   END DO
 …
   DO i = 1, nd
     DO il = 1, ncum
       vprecip(il, i) = 0.0
+      Vprecip(il, i) = 0.0
       ft(il, i) = 0.0
       fr(il, i) = 0.0
 …
     END DO
   END DO
   ! print*,'cv3_yield initialisation 2'
   ! AC!      do j=1,ntra
   ! AC!       do i=1,nd
   ! AC!        do il=1,ncum
   ! AC!          ftra(il,i,j)=0.0
   ! AC!        enddo
   ! AC!       enddo
   ! AC!      enddo
   ! print*,'cv3_yield initialisation 3'
+! print*,'cv3_yield initialisation 2'
+!AC!      do j=1,ntra
+!AC!       do i=1,nd
+!AC!        do il=1,ncum
+!AC!          ftra(il,i,j)=0.0
+!AC!        enddo
+!AC!       enddo
+!AC!      enddo
+! print*,'cv3_yield initialisation 3'
   DO i = 1, nl
     DO il = 1, ncum
 …
   ! ***  calculate surface precipitation in mm/day     ***
+! ***  calculate surface precipitation in mm/day     ***
   DO il = 1, ncum
     IF (ep(il,inb(il))>=0.0001 .AND. iflag(il)<=1) THEN
       IF (cvflag_ice) THEN
+        IF (cvflag_grav) THEN
+          precip(il) = wt(il, 1)*sigd(il)*(water(il,1)+ice(il,1))*86400.* &
+./(rowl*grav)
+        ELSE
+          precip(il) = wt(il, 1)*sigd(il)*(water(il,1)+ice(il,1))*8640.
+        END IF
+        precip(il) = wt(il, 1)*sigd(il)*(water(il,1)+ice(il,1)) &
+                              *86400.*1000./(rowl*grav)
       ELSE
+        IF (cvflag_grav) THEN
+          precip(il) = wt(il, 1)*sigd(il)*water(il, 1)*86400.*1000./ &
+            (rowl*grav)
+        ELSE
+          precip(il) = wt(il, 1)*sigd(il)*water(il, 1)*8640.
+        END IF
+        precip(il) = wt(il, 1)*sigd(il)*water(il, 1) &
+                              *86400.*1000./(rowl*grav)
       END IF
     END IF
   END DO
   ! print*,'cv3_yield apres calcul precip'
   ! ===  calculate vertical profile of  precipitation in kg/m2/s  ===
+! print*,'cv3_yield apres calcul precip'
+! ===  calculate vertical profile of  precipitation in kg/m2/s  ===
   DO i = 1, nl
 …
       IF (ep(il,inb(il))>=0.0001 .AND. i<=inb(il) .AND. iflag(il)<=1) THEN
         IF (cvflag_ice) THEN
+          IF (cvflag_grav) THEN
+            vprecip(il, i) = wt(il, i)*sigd(il)*(water(il,i)+ice(il,i))/grav
+          ELSE
+            vprecip(il, i) = wt(il, i)*sigd(il)*(water(il,i)+ice(il,i))/10.
+          END IF
+          Vprecip(il, i) = wt(il, i)*sigd(il)*(water(il,i)+ice(il,i))/grav
         ELSE
+          IF (cvflag_grav) THEN
+            vprecip(il, i) = wt(il, i)*sigd(il)*water(il, i)/grav
+          ELSE
+            vprecip(il, i) = wt(il, i)*sigd(il)*water(il, i)/10.
+          END IF
+          Vprecip(il, i) = wt(il, i)*sigd(il)*water(il, i)/grav
         END IF
       END IF
 …
   ! ***  Calculate downdraft velocity scale    ***
   ! ***  NE PAS UTILISER POUR L'INSTANT ***
   ! !      do il=1,ncum
+  ! !        wd(il)=betad*abs(mp(il,icb(il)))*0.01*rrd*t(il,icb(il))
   ! !     :                                  /(sigd(il)*p(il,icb(il)))
   ! !      enddo
   ! ***  calculate tendencies of lowest level potential temperature  ***
   ! ***                      and mixing ratio                        ***
+! ***  Calculate downdraft velocity scale    ***
+! ***  NE PAS UTILISER POUR L'INSTANT ***
+!!      do il=1,ncum
+!!        wd(il)=betad*abs(mp(il,icb(il)))*0.01*rrd*t(il,icb(il)) &
+!!                                       /(sigd(il)*p(il,icb(il)))
+!!      enddo
+! ***  calculate tendencies of lowest level potential temperature  ***
+! ***                      and mixing ratio                        ***
   DO il = 1, ncum
 …
   END DO
   ! print*,'cv3_yield avant ft'
   ! AM is the part of cbmf taken from the first level
+!    print*,'cv3_yield avant ft'
+! am is the part of cbmf taken from the first level
   DO il = 1, ncum
     am(il) = cbmf(il)*wghti(il, 1)
 …
   DO il = 1, ncum
     IF (iflag(il)<=1) THEN
+      ! convect3      if((0.1*dpinv*am).ge.delti)iflag(il)=4
+      ! jyg  Correction pour conserver l'eau
+      ! cc       ft(il,1)=-0.5*lvcp(il,1)*sigd(il)*(evap(il,1)+evap(il,2))
+      ! !precip
+! convect3      if((0.1*dpinv*am).ge.delti)iflag(il)=4
+!JYG  Correction pour conserver l'eau
+! cc       ft(il,1)=-0.5*lvcp(il,1)*sigd(il)*(evap(il,1)+evap(il,2))          !precip
       IF (cvflag_ice) THEN
         ft(il, 1) = -lvcp(il, 1)*sigd(il)*evap(il, 1) - &
           lfcp(il, 1)*sigd(il)*evap(il, 1)*faci(il, 1) - &
           lfcp(il, 1)*sigd(il)*(fondue(il,1)*wt(il,1))/(100.*(ph(il,1)-ph(il, &
 ))) !precip
+                     lfcp(il, 1)*sigd(il)*evap(il, 1)*faci(il, 1) - &
+                     lfcp(il, 1)*sigd(il)*(fondue(il,1)*wt(il,1)) / &
+                       (100.*(ph(il,1)-ph(il,2)))                             !precip
       ELSE
         ft(il, 1) = -lvcp(il, 1)*sigd(il)*evap(il, 1)
       END IF
+      IF (cvflag_grav) THEN
+        ft(il, 1) = ft(il, 1) - 0.009*grav*sigd(il)*mp(il, 2)*t_wake(il, 1)*b &
+          (il, 1)*work(il)
+      ft(il, 1) = ft(il, 1) - 0.009*grav*sigd(il)*mp(il, 2)*t_wake(il, 1)*b(il, 1)*work(il)
+      IF (cvflag_ice) THEN
+        ft(il, 1) = ft(il, 1) + 0.01*sigd(il)*wt(il, 1)*(cl-cpd)*water(il, 2) * &
+                                     (t_wake(il,2)-t_wake(il,1))*work(il)/cpn(il, 1) + &
+.01*sigd(il)*wt(il, 1)*(ci-cpd)*ice(il, 2) * &
+                                     (t_wake(il,2)-t_wake(il,1))*work(il)/cpn(il, 1)
       ELSE
         ft(il, 1) = ft(il, 1) - 0.09*sigd(il)*mp(il, 2)*t_wake(il, 1)*b(il, 1 &
           )*work(il)
+        ft(il, 1) = ft(il, 1) + 0.01*sigd(il)*wt(il, 1)*(cl-cpd)*water(il, 2) * &
+                                     (t_wake(il,2)-t_wake(il,1))*work(il)/cpn(il, 1)
       END IF
+      IF (cvflag_ice) THEN
+        ft(il, 1) = ft(il, 1) + 0.01*sigd(il)*wt(il, 1)*(cl-cpd)*water(il, 2) &
+          *(t_wake(il,2)-t_wake(il,1))*work(il)/cpn(il, 1) + &
+.01*sigd(il)*wt(il, 1)*(ci-cpd)*ice(il, 2)* &
+          (t_wake(il,2)-t_wake(il,1))*work(il)/cpn(il, 1)
+      ELSE
+        ft(il, 1) = ft(il, 1) + 0.01*sigd(il)*wt(il, 1)*(cl-cpd)*water(il, 2) &
+          *(t_wake(il,2)-t_wake(il,1))*work(il)/cpn(il, 1)
+      END IF
+      ftd(il, 1) = ft(il, 1) ! fin precip
+      IF (cvflag_grav) THEN !sature
+        IF ((0.01*grav*work(il)*am(il))>=delti) iflag(il) = 1 !consist vect
+        ft(il, 1) = ft(il, 1) + 0.01*grav*work(il)*am(il)*(t(il,2)-t(il,1)+( &
+          gz(il,2)-gz(il,1))/cpn(il,1))
+      ELSE
+        IF ((0.1*work(il)*am(il))>=delti) iflag(il) = 1 !consistency vect
+        ft(il, 1) = ft(il, 1) + 0.1*work(il)*am(il)*(t(il,2)-t(il,1)+(gz(il, &
+)-gz(il,1))/cpn(il,1))
+      END IF
+      ftd(il, 1) = ft(il, 1)                                                  ! fin precip
+      IF ((0.01*grav*work(il)*am(il))>=delti) iflag(il) = 1 !consist vect
+      ft(il, 1) = ft(il, 1) + 0.01*grav*work(il)*am(il) * &
+                                   (t(il,2)-t(il,1)+(gz(il,2)-gz(il,1))/cpn(il,1))
     END IF ! iflag
   END DO
 …
     IF (iflag_mix>0) THEN
       DO il = 1, ncum
         ! FH WARNING a modifier :
+! FH WARNING a modifier :
         cpinv = 0.
         ! cpinv=1.0/cpn(il,1)
+! cpinv=1.0/cpn(il,1)
         IF (j<=inb(il) .AND. iflag(il)<=1) THEN
+          IF (cvflag_grav) THEN
+            ft(il, 1) = ft(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(hent( &
+              il,j,1)-h(il,1)+t(il,1)*(cpv-cpd)*(rr(il,1)-qent(il,j, &
+)))*cpinv
+          ELSE
+            ft(il, 1) = ft(il, 1) + 0.1*work(il)*ment(il, j, 1)*(hent(il,j,1) &
+              -h(il,1)+t(il,1)*(cpv-cpd)*(rr(il,1)-qent(il,j,1)))*cpinv
+          END IF ! cvflag_grav
+          ft(il, 1) = ft(il, 1) + 0.01*grav*work(il)*ment(il, j, 1) * &
+                     (hent(il,j,1)-h(il,1)+t(il,1)*(cpv-cpd)*(rr(il,1)-qent(il,j,1)))*cpinv
         END IF ! j
       END DO
     END IF
   END DO
     ! fin sature
+! fin sature
   DO il = 1, ncum
     IF (iflag(il)<=1) THEN
+      IF (cvflag_grav) THEN
+        ! jyg1  Correction pour mieux conserver l'eau (conformite avec
+        ! CONVECT4.3)
+        fr(il, 1) = 0.01*grav*mp(il, 2)*(rp(il,2)-rr_wake(il,1))*work(il) + &
+          sigd(il)*evap(il, 1)
+        ! cc     :          +sigd(il)*0.5*(evap(il,1)+evap(il,2))
+        fqd(il, 1) = fr(il, 1) !precip
+        fr(il, 1) = fr(il, 1) + 0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il) !sature
+        fu(il, 1) = fu(il, 1) + 0.01*grav*work(il)*(mp(il,2)*(up(il,2)-u(il, &
+))+am(il)*(u(il,2)-u(il,1)))
+        fv(il, 1) = fv(il, 1) + 0.01*grav*work(il)*(mp(il,2)*(vp(il,2)-v(il, &
+))+am(il)*(v(il,2)-v(il,1)))
+      ELSE ! cvflag_grav
+        fr(il, 1) = 0.1*mp(il, 2)*(rp(il,2)-rr_wake(il,1))*work(il) + &
+          sigd(il)*evap(il, 1)
+        ! cc     :          +sigd(il)*0.5*(evap(il,1)+evap(il,2))
+        fqd(il, 1) = fr(il, 1) !precip
+        fr(il, 1) = fr(il, 1) + 0.1*am(il)*(rr(il,2)-rr(il,1))*work(il)
+        fu(il, 1) = fu(il, 1) + 0.1*work(il)*(mp(il,2)*(up(il,2)-u(il, &
+))+am(il)*(u(il,2)-u(il,1)))
+        fv(il, 1) = fv(il, 1) + 0.1*work(il)*(mp(il,2)*(vp(il,2)-v(il, &
+))+am(il)*(v(il,2)-v(il,1)))
+      END IF ! cvflag_grav
+!JYG1  Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)
+      fr(il, 1) = 0.01*grav*mp(il, 2)*(rp(il,2)-rr_wake(il,1))*work(il) + &
+                  sigd(il)*evap(il, 1)
+!!!                  sigd(il)*0.5*(evap(il,1)+evap(il,2))
+      fqd(il, 1) = fr(il, 1) !precip
+      fr(il, 1) = fr(il, 1) + 0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)        !sature
+      fu(il, 1) = fu(il, 1) + 0.01*grav*work(il)*(mp(il,2)*(up(il,2)-u(il,1)) + &
+                                                  am(il)*(u(il,2)-u(il,1)))
+      fv(il, 1) = fv(il, 1) + 0.01*grav*work(il)*(mp(il,2)*(vp(il,2)-v(il,1)) + &
+                                                  am(il)*(v(il,2)-v(il,1)))
     END IF ! iflag
   END DO ! il
   ! AC!     do j=1,ntra
   ! AC!      do il=1,ncum
   ! AC!       if (iflag(il) .le. 1) then
   ! AC!       if (cvflag_grav) then
   ! AC!        ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
   ! AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
   ! AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
   ! AC!       else
   ! AC!        ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
   ! AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
   ! AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
   ! AC!       endif
   ! AC!       endif  ! iflag
   ! AC!      enddo
   ! AC!     enddo
+!AC!     do j=1,ntra
+!AC!      do il=1,ncum
+!AC!       if (iflag(il) .le. 1) then
+!AC!       if (cvflag_grav) then
+!AC!        ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
+!AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
+!AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
+!AC!       else
+!AC!        ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
+!AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
+!AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
+!AC!       endif
+!AC!       endif  ! iflag
+!AC!      enddo
+!AC!     enddo
   DO j = 2, nl
     DO il = 1, ncum
       IF (j<=inb(il) .AND. iflag(il)<=1) THEN
+        IF (cvflag_grav) THEN
+          fr(il, 1) = fr(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(qent(il, &
+            j,1)-rr(il,1))
+          fu(il, 1) = fu(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(uent(il, &
+            j,1)-u(il,1))
+          fv(il, 1) = fv(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(vent(il, &
+            j,1)-v(il,1))
+        ELSE ! cvflag_grav
+          fr(il, 1) = fr(il, 1) + 0.1*work(il)*ment(il, j, 1)*(qent(il,j,1)- &
+            rr(il,1))
+          fu(il, 1) = fu(il, 1) + 0.1*work(il)*ment(il, j, 1)*(uent(il,j,1)-u &
+            (il,1))
+          fv(il, 1) = fv(il, 1) + 0.1*work(il)*ment(il, j, 1)*(vent(il,j,1)-v &
+            (il,1)) ! fin sature
+        END IF ! cvflag_grav
+        fr(il, 1) = fr(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(qent(il,j,1)-rr(il,1))
+        fu(il, 1) = fu(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(uent(il,j,1)-u(il,1))
+        fv(il, 1) = fv(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(vent(il,j,1)-v(il,1))
       END IF ! j
     END DO
   END DO
   ! AC!      do k=1,ntra
   ! AC!       do j=2,nl
   ! AC!        do il=1,ncum
   ! AC!         if (j.le.inb(il) .and. iflag(il) .le. 1) then
   ! AC!
   ! AC!          if (cvflag_grav) then
   ! AC!           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
   ! AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
   ! AC!          else
   ! AC!           ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
   ! AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
   ! AC!          endif
   ! AC!
   ! AC!         endif
   ! AC!        enddo
   ! AC!       enddo
   ! AC!      enddo
   ! print*,'cv3_yield apres ft'
   ! ***  calculate tendencies of potential temperature and mixing ratio  ***
   ! ***               at levels above the lowest level                   ***
   ! ***  first find the net saturated updraft and downdraft mass fluxes  ***
   ! ***                      through each level                          ***
+!AC!      do k=1,ntra
+!AC!       do j=2,nl
+!AC!        do il=1,ncum
+!AC!         if (j.le.inb(il) .and. iflag(il) .le. 1) then
+!AC!
+!AC!          if (cvflag_grav) then
+!AC!           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
+!AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
+!AC!          else
+!AC!           ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
+!AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
+!AC!          endif
+!AC!
+!AC!         endif
+!AC!        enddo
+!AC!       enddo
+!AC!      enddo
+! print*,'cv3_yield apres ft'
+! ***  calculate tendencies of potential temperature and mixing ratio  ***
+! ***               at levels above the lowest level                   ***
+! ***  first find the net saturated updraft and downdraft mass fluxes  ***
+! ***                      through each level                          ***
 …
           END IF
         ELSE
           ! AMP1 is the part of cbmf taken from layers I and lower
+! AMP1 is the part of cbmf taken from layers I and lower
           IF (k<=i) THEN
             amp1(il) = amp1(il) + cbmf(il)*wghti(il, k)
 …
         cpinv = 1.0/cpn(il, i)
+        ! convect3      if((0.1*dpinv*amp1).ge.delti)iflag(il)=4
+        IF (cvflag_grav) THEN
+          IF ((0.01*grav*dpinv*amp1(il))>=delti) iflag(il) = 1 ! vecto
+        ELSE
+          IF ((0.1*dpinv*amp1(il))>=delti) iflag(il) = 1 ! vecto
+        END IF
+          ! precip
+        ! cc       ft(il,i)=
+        ! -0.5*sigd(il)*lvcp(il,i)*(evap(il,i)+evap(il,i+1))
+! convect3      if((0.1*dpinv*amp1).ge.delti)iflag(il)=4
+        IF ((0.01*grav*dpinv*amp1(il))>=delti) iflag(il) = 1 ! vecto
+! precip
+! cc       ft(il,i)= -0.5*sigd(il)*lvcp(il,i)*(evap(il,i)+evap(il,i+1))
         IF (cvflag_ice) THEN
           ft(il, i) = -sigd(il)*lvcp(il, i)*evap(il, i) - &
+            sigd(il)*lfcp(il, i)*evap(il, i)*faci(il, i) - &
+            sigd(il)*lfcp(il, i)*fondue(il, i)*wt(il, i)/(100.*(p(il, &
+            i-1)-p(il,i)))
+                       sigd(il)*lfcp(il, i)*evap(il, i)*faci(il, i) - &
+                       sigd(il)*lfcp(il, i)*fondue(il, i)*wt(il, i)/(100.*(p(il,i-1)-p(il,i)))
         ELSE
           ft(il, i) = -sigd(il)*lvcp(il, i)*evap(il, i)
 …
         rat = cpn(il, i-1)*cpinv
+        IF (cvflag_grav) THEN
+          ft(il, i) = ft(il, i) - 0.009*grav*sigd(il)*(mp(il,i+1)*t_wake(il,i &
+            )*b(il,i)-mp(il,i)*t_wake(il,i-1)*rat*b(il,i-1))*dpinv
+          IF (cvflag_ice) THEN
+            ft(il, i) = ft(il, i) + 0.01*sigd(il)*wt(il, i)*(cl-cpd)*water(il &
+              , i+1)*(t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv + &
+.01*sigd(il)*wt(il, i)*(ci-cpd)*ice(il, i+1)* &
+              (t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv
+          ELSE
+            ft(il, i) = ft(il, i) + 0.01*sigd(il)*wt(il, i)*(cl-cpd)*water(il &
+              , i+1)*(t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv
+          END IF
+          ftd(il, i) = ft(il, i)
+            ! fin precip
+            ! sature
+          ft(il, i) = ft(il, i) + 0.01*grav*dpinv*(amp1(il)*(t(il,i+1)-t(il, &
+            i)+(gz(il,i+1)-gz(il,i))*cpinv)-ad(il)*(t(il,i)-t(il, &
+            i-1)+(gz(il,i)-gz(il,i-1))*cpinv))
+          IF (iflag_mix==0) THEN
+            ft(il, i) = ft(il, i) + 0.01*grav*dpinv*ment(il, i, i)*(hp(il,i)- &
+              h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
+          END IF
+        ELSE ! cvflag_grav
+          ft(il, i) = ft(il, i) - 0.09*sigd(il)*(mp(il,i+1)*t_wake(il,i)*b(il &
+            ,i)-mp(il,i)*t_wake(il,i-1)*rat*b(il,i-1))*dpinv
+          IF (cvflag_ice) THEN
+            ft(il, i) = ft(il, i) + 0.01*sigd(il)*wt(il, i)*(cl-cpd)*water(il &
+              , i+1)*(t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv + &
+.01*sigd(il)*wt(il, i)*(ci-cpd)*ice(il, i+1)* &
+              (t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv
+          ELSE
+            ft(il, i) = ft(il, i) + 0.01*sigd(il)*wt(il, i)*(cl-cpd)*water(il &
+              , i+1)*(t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv
+          END IF
+          ftd(il, i) = ft(il, i)
+            ! fin precip
+            ! sature
+          ft(il, i) = ft(il, i) + 0.1*dpinv*(amp1(il)*(t(il,i+1)-t(il, &
+            i)+(gz(il,i+1)-gz(il,i))*cpinv)-ad(il)*(t(il,i)-t(il, &
+            i-1)+(gz(il,i)-gz(il,i-1))*cpinv))
+          IF (iflag_mix==0) THEN
+            ft(il, i) = ft(il, i) + 0.1*dpinv*ment(il, i, i)*(hp(il,i)-h(il,i &
+              )+t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
+          END IF
+        END IF ! cvflag_grav
+        IF (cvflag_grav) THEN
+          ! sb: on ne fait pas encore la correction permettant de mieux
+          ! conserver l'eau:
+          ! jyg: correction permettant de mieux conserver l'eau:
+          ! cc         fr(il,i)=0.5*sigd(il)*(evap(il,i)+evap(il,i+1))
+          fr(il, i) = sigd(il)*evap(il, i) + 0.01*grav*(mp(il,i+1)*(rp(il, &
+            i+1)-rr_wake(il,i))-mp(il,i)*(rp(il,i)-rr_wake(il,i-1)))*dpinv
+          fqd(il, i) = fr(il, i) ! precip
+          fu(il, i) = 0.01*grav*(mp(il,i+1)*(up(il,i+1)-u(il, &
+            i))-mp(il,i)*(up(il,i)-u(il,i-1)))*dpinv
+          fv(il, i) = 0.01*grav*(mp(il,i+1)*(vp(il,i+1)-v(il, &
+            i))-mp(il,i)*(vp(il,i)-v(il,i-1)))*dpinv
+        ELSE ! cvflag_grav
+          ! cc         fr(il,i)=0.5*sigd(il)*(evap(il,i)+evap(il,i+1))
+          fr(il, i) = sigd(il)*evap(il, i) + 0.1*(mp(il,i+1)*(rp(il, &
+            i+1)-rr_wake(il,i))-mp(il,i)*(rp(il,i)-rr_wake(il,i-1)))*dpinv
+          fqd(il, i) = fr(il, i) ! precip
+          fu(il, i) = 0.1*(mp(il,i+1)*(up(il,i+1)-u(il,i))-mp(il,i)*(up(il, &
+            i)-u(il,i-1)))*dpinv
+          fv(il, i) = 0.1*(mp(il,i+1)*(vp(il,i+1)-v(il,i))-mp(il,i)*(vp(il, &
+            i)-v(il,i-1)))*dpinv
+        END IF ! cvflag_grav
+        IF (cvflag_grav) THEN
+          fr(il, i) = fr(il, i) + 0.01*grav*dpinv*(amp1(il)*(rr(il, &
+            i+1)-rr(il,i))-ad(il)*(rr(il,i)-rr(il,i-1)))
+          fu(il, i) = fu(il, i) + 0.01*grav*dpinv*(amp1(il)*(u(il,i+1)-u(il, &
+            i))-ad(il)*(u(il,i)-u(il,i-1)))
+          fv(il, i) = fv(il, i) + 0.01*grav*dpinv*(amp1(il)*(v(il,i+1)-v(il, &
+            i))-ad(il)*(v(il,i)-v(il,i-1)))
+        ELSE ! cvflag_grav
+          fr(il, i) = fr(il, i) + 0.1*dpinv*(amp1(il)*(rr(il,i+1)-rr(il, &
+            i))-ad(il)*(rr(il,i)-rr(il,i-1)))
+          fu(il, i) = fu(il, i) + 0.1*dpinv*(amp1(il)*(u(il,i+1)-u(il, &
+            i))-ad(il)*(u(il,i)-u(il,i-1)))
+          fv(il, i) = fv(il, i) + 0.1*dpinv*(amp1(il)*(v(il,i+1)-v(il, &
+            i))-ad(il)*(v(il,i)-v(il,i-1)))
+        END IF ! cvflag_grav
+        ft(il, i) = ft(il, i) - 0.009*grav*sigd(il) * &
+                     (mp(il,i+1)*t_wake(il,i)*b(il,i)-mp(il,i)*t_wake(il,i-1)*rat*b(il,i-1))*dpinv
+        IF (cvflag_ice) THEN
+          ft(il, i) = ft(il, i) + 0.01*sigd(il)*wt(il, i)*(cl-cpd)*water(il, i+1) * &
+                                       (t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv + &
+.01*sigd(il)*wt(il, i)*(ci-cpd)*ice(il, i+1) * &
+                                       (t_wake(il,i+1)-t_wake(il,i))*dpinv*cpinv
+        ELSE
+          ft(il, i) = ft(il, i) + 0.01*sigd(il)*wt(il, i)*(cl-cpd)*water(il, i+1) * &
+                                       (t_wake(il,i+1)-t_wake(il,i))*dpinv* &
+            cpinv
+        END IF
+        ftd(il, i) = ft(il, i)
+! fin precip
+! sature
+        ft(il, i) = ft(il, i) + 0.01*grav*dpinv * &
+                     (amp1(il)*(t(il,i+1)-t(il,i) + (gz(il,i+1)-gz(il,i))*cpinv) - &
+                      ad(il)*(t(il,i)-t(il,i-1)+(gz(il,i)-gz(il,i-1))*cpinv))
+        IF (iflag_mix==0) THEN
+          ft(il, i) = ft(il, i) + 0.01*grav*dpinv*ment(il, i, i)*(hp(il,i)-h(il,i) + &
+                                    t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,i,i)))*cpinv
+        END IF
+! sb: on ne fait pas encore la correction permettant de mieux
+! conserver l'eau:
+!JYG: correction permettant de mieux conserver l'eau:
+! cc         fr(il,i)=0.5*sigd(il)*(evap(il,i)+evap(il,i+1))
+        fr(il, i) = sigd(il)*evap(il, i) + 0.01*grav*(mp(il,i+1)*(rp(il,i+1)-rr_wake(il,i)) - &
+                                                      mp(il,i)*(rp(il,i)-rr_wake(il,i-1)))*dpinv
+        fqd(il, i) = fr(il, i)                                                                     ! precip
+        fu(il, i) = 0.01*grav*(mp(il,i+1)*(up(il,i+1)-u(il,i)) - &
+                               mp(il,i)*(up(il,i)-u(il,i-1)))*dpinv
+        fv(il, i) = 0.01*grav*(mp(il,i+1)*(vp(il,i+1)-v(il,i)) - &
+                               mp(il,i)*(vp(il,i)-v(il,i-1)))*dpinv
+        fr(il, i) = fr(il, i) + 0.01*grav*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i)) - &
+                                                 ad(il)*(rr(il,i)-rr(il,i-1)))
+        fu(il, i) = fu(il, i) + 0.01*grav*dpinv*(amp1(il)*(u(il,i+1)-u(il,i)) - &
+                                                 ad(il)*(u(il,i)-u(il,i-1)))
+        fv(il, i) = fv(il, i) + 0.01*grav*dpinv*(amp1(il)*(v(il,i+1)-v(il,i)) - &
+                                                 ad(il)*(v(il,i)-v(il,i-1)))
       END IF ! i
     END DO
     ! AC!      do k=1,ntra
     ! AC!       do il=1,ncum
     ! AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) then
     ! AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! AC!         cpinv=1.0/cpn(il,i)
     ! AC!         if (cvflag_grav) then
     ! AC!           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
     ! AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
     ! AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
     ! AC!         else
     ! AC!           ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
     ! AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
     ! AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
     ! AC!         endif
     ! AC!        endif
     ! AC!       enddo
     ! AC!      enddo
+!AC!      do k=1,ntra
+!AC!       do il=1,ncum
+!AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) then
+!AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
+!AC!         cpinv=1.0/cpn(il,i)
+!AC!         if (cvflag_grav) then
+!AC!           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
+!AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
+!AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
+!AC!         else
+!AC!           ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
+!AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
+!AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
+!AC!         endif
+!AC!        endif
+!AC!       enddo
+!AC!      enddo
     DO k = 1, i - 1
 …
             dpinv = 1.0/(ph(il,i)-ph(il,i+1))
             cpinv = 1.0/cpn(il, i)
+            IF (cvflag_grav) THEN
+              ft(il, i) = ft(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(hent(il &
+                ,k,i)-h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)+awat(il)-qent(il,k, &
+                i)))*cpinv
+            ELSE
+              ft(il, i) = ft(il, i) + 0.1*dpinv*ment(il, k, i)*(hent(il,k,i)- &
+                h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)+awat(il)-qent(il,k, &
+                i)))*cpinv
+            END IF !cvflag_grav
+            ft(il, i) = ft(il, i) + 0.01*grav*dpinv*ment(il, k, i) * &
+                 (hent(il,k,i)-h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)+awat(il)-qent(il,k,i)))*cpinv
+!
+!
           END IF ! i
         END DO
 …
           dpinv = 1.0/(ph(il,i)-ph(il,i+1))
           cpinv = 1.0/cpn(il, i)
+          IF (cvflag_grav) THEN
+            fr(il, i) = fr(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(qent(il,k &
+              ,i)-awat(il)-rr(il,i))
+            fu(il, i) = fu(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(uent(il,k &
+              ,i)-u(il,i))
+            fv(il, i) = fv(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(vent(il,k &
+              ,i)-v(il,i))
+          ELSE ! cvflag_grav
+            fr(il, i) = fr(il, i) + 0.1*dpinv*ment(il, k, i)*(qent(il,k,i)- &
+              awat(il)-rr(il,i))
+            fu(il, i) = fu(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(uent(il,k &
+              ,i)-u(il,i))
+            fv(il, i) = fv(il, i) + 0.1*dpinv*ment(il, k, i)*(vent(il,k,i)-v( &
+              il,i))
+          END IF ! cvflag_grav
+          ! (saturated updrafts resulting from mixing)        ! cld
+          qcond(il, i) = qcond(il, i) + (elij(il,k,i)-awat(il)) ! cld
+          fr(il, i) = fr(il, i) + 0.01*grav*dpinv*ment(il, k, i) * &
+                                                       (qent(il,k,i)-awat(il)-rr(il,i))
+          fu(il, i) = fu(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(uent(il,k,i)-u(il,i))
+          fv(il, i) = fv(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(vent(il,k,i)-v(il,i))
+! (saturated updrafts resulting from mixing)                                   ! cld
+          qcond(il, i) = qcond(il, i) + (elij(il,k,i)-awat(il))                ! cld
           nqcond(il, i) = nqcond(il, i) + 1. ! cld
         END IF ! i
 …
     END DO
     ! AC!      do j=1,ntra
     ! AC!       do k=1,i-1
     ! AC!        do il=1,ncum
     ! AC!         if (i.le.inb(il) .and. iflag(il) .le. 1) then
     ! AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! AC!          cpinv=1.0/cpn(il,i)
     ! AC!          if (cvflag_grav) then
     ! AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     ! AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
     ! AC!          else
     ! AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     ! AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
     ! AC!          endif
     ! AC!         endif
     ! AC!        enddo
     ! AC!       enddo
     ! AC!      enddo
+!AC!      do j=1,ntra
+!AC!       do k=1,i-1
+!AC!        do il=1,ncum
+!AC!         if (i.le.inb(il) .and. iflag(il) .le. 1) then
+!AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
+!AC!          cpinv=1.0/cpn(il,i)
+!AC!          if (cvflag_grav) then
+!AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
+!AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
+!AC!          else
+!AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
+!AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
+!AC!          endif
+!AC!         endif
+!AC!        enddo
+!AC!       enddo
+!AC!      enddo
     DO k = i, nl + 1
 …
             dpinv = 1.0/(ph(il,i)-ph(il,i+1))
             cpinv = 1.0/cpn(il, i)
+            IF (cvflag_grav) THEN
+              ft(il, i) = ft(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(hent(il &
+                ,k,i)-h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,k, &
+                i)))*cpinv
+            ELSE
+              ft(il, i) = ft(il, i) + 0.1*dpinv*ment(il, k, i)*(hent(il,k,i)- &
+                h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,k,i)))*cpinv
+            END IF !cvflag_grav
+            ft(il, i) = ft(il, i) + 0.01*grav*dpinv*ment(il, k, i) * &
+                  (hent(il,k,i)-h(il,i)+t(il,i)*(cpv-cpd)*(rr(il,i)-qent(il,k,i)))*cpinv
           END IF ! i
         END DO
 …
           cpinv = 1.0/cpn(il, i)
+          IF (cvflag_grav) THEN
+            fr(il, i) = fr(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(qent(il,k &
+              ,i)-rr(il,i))
+            fu(il, i) = fu(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(uent(il,k &
+              ,i)-u(il,i))
+            fv(il, i) = fv(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(vent(il,k &
+              ,i)-v(il,i))
+          ELSE ! cvflag_grav
+            fr(il, i) = fr(il, i) + 0.1*dpinv*ment(il, k, i)*(qent(il,k,i)-rr &
+              (il,i))
+            fu(il, i) = fu(il, i) + 0.1*dpinv*ment(il, k, i)*(uent(il,k,i)-u( &
+              il,i))
+            fv(il, i) = fv(il, i) + 0.1*dpinv*ment(il, k, i)*(vent(il,k,i)-v( &
+              il,i))
+          END IF ! cvflag_grav
+          fr(il, i) = fr(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-rr(il,i))
+          fu(il, i) = fu(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(uent(il,k,i)-u(il,i))
+          fv(il, i) = fv(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(vent(il,k,i)-v(il,i))
         END IF ! i and k
       END DO
     END DO
     ! AC!      do j=1,ntra
     ! AC!       do k=i,nl+1
     ! AC!        do il=1,ncum
     ! AC!         if (i.le.inb(il) .and. k.le.inb(il)
     ! AC!     $                .and. iflag(il) .le. 1) then
     ! AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! AC!          cpinv=1.0/cpn(il,i)
     ! AC!          if (cvflag_grav) then
     ! AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     ! AC!     :         *(traent(il,k,i,j)-tra(il,i,j))
     ! AC!          else
     ! AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     ! AC!     :             *(traent(il,k,i,j)-tra(il,i,j))
     ! AC!          endif
     ! AC!         endif ! i and k
     ! AC!        enddo
     ! AC!       enddo
     ! AC!      enddo
     ! sb: interface with the cloud parameterization:          ! cld
+!AC!      do j=1,ntra
+!AC!       do k=i,nl+1
+!AC!        do il=1,ncum
+!AC!         if (i.le.inb(il) .and. k.le.inb(il)
+!AC!     $                .and. iflag(il) .le. 1) then
+!AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
+!AC!          cpinv=1.0/cpn(il,i)
+!AC!          if (cvflag_grav) then
+!AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
+!AC!     :         *(traent(il,k,i,j)-tra(il,i,j))
+!AC!          else
+!AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
+!AC!     :             *(traent(il,k,i,j)-tra(il,i,j))
+!AC!          endif
+!AC!         endif ! i and k
+!AC!        enddo
+!AC!       enddo
+!AC!      enddo
+! sb: interface with the cloud parameterization:                               ! cld
     DO k = i + 1, nl
       DO il = 1, ncum
         IF (k<=inb(il) .AND. i<=inb(il) .AND. iflag(il)<=1) THEN ! cld
           ! (saturated downdrafts resulting from mixing)            ! cld
           qcond(il, i) = qcond(il, i) + elij(il, k, i) ! cld
+        IF (k<=inb(il) .AND. i<=inb(il) .AND. iflag(il)<=1) THEN               ! cld
+! (saturated downdrafts resulting from mixing)                                 ! cld
+          qcond(il, i) = qcond(il, i) + elij(il, k, i)                         ! cld
           nqcond(il, i) = nqcond(il, i) + 1. ! cld
         END IF ! cld
 …
     END DO ! cld
     ! (particular case: no detraining level is found)         ! cld
     DO il = 1, ncum ! cld
       IF (i<=inb(il) .AND. nent(il,i)==0 .AND. iflag(il)<=1) THEN ! cld
         qcond(il, i) = qcond(il, i) + (1.-ep(il,i))*clw(il, i) ! cld
         nqcond(il, i) = nqcond(il, i) + 1. ! cld
       END IF ! cld
     END DO ! cld
     DO il = 1, ncum ! cld
       IF (i<=inb(il) .AND. nqcond(il,i)/=0 .AND. iflag(il)<=1) THEN ! cld
         qcond(il, i) = qcond(il, i)/nqcond(il, i) ! cld
       END IF ! cld
     END DO
     ! AC!      do j=1,ntra
     ! AC!       do il=1,ncum
     ! AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) then
     ! AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! AC!         cpinv=1.0/cpn(il,i)
     ! AC!
     ! AC!         if (cvflag_grav) then
     ! AC!          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
     ! AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
     ! AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
     ! AC!         else
     ! AC!          ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
     ! AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
     ! AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
     ! AC!         endif
     ! AC!        endif ! i
     ! AC!       enddo
     ! AC!      enddo
+! (particular case: no detraining level is found)                              ! cld
+    DO il = 1, ncum                                                            ! cld
+      IF (i<=inb(il) .AND. nent(il,i)==0 .AND. iflag(il)<=1) THEN              ! cld
+        qcond(il, i) = qcond(il, i) + (1.-ep(il,i))*clw(il, i)                 ! cld
+        nqcond(il, i) = nqcond(il, i) + 1.                                     ! cld
+      END IF                                                                   ! cld
+    END DO                                                                     ! cld
+    DO il = 1, ncum                                                            ! cld
+      IF (i<=inb(il) .AND. nqcond(il,i)/=0 .AND. iflag(il)<=1) THEN            ! cld
+        qcond(il, i) = qcond(il, i)/nqcond(il, i)                              ! cld
+      END IF                                                                   ! cld
+    END DO
+!AC!      do j=1,ntra
+!AC!       do il=1,ncum
+!AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) then
+!AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
+!AC!         cpinv=1.0/cpn(il,i)
+!AC!
+!AC!         if (cvflag_grav) then
+!AC!          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
+!AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
+!AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
+!AC!         else
+!AC!          ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
+!AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
+!AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
+!AC!         endif
+!AC!        endif ! i
+!AC!       enddo
+!AC!      enddo
 END DO
+  ! ***   move the detrainment at level inb down to level inb-1   ***
+  ! ***        in such a way as to preserve the vertically        ***
+  ! ***          integrated enthalpy and water tendencies         ***
+  ! Correction bug le 18-03-09
+!JYG<
+!Conservation de l'eau
+!   sumdq = 0.
+!   DO k = 1, nl
+!     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
+!   END DO
+!   PRINT *, 'cv3_yield, apres 500, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
+!JYG>
+! ***   move the detrainment at level inb down to level inb-1   ***
+! ***        in such a way as to preserve the vertically        ***
+! ***          integrated enthalpy and water tendencies         ***
+! Correction bug le 18-03-09
   DO il = 1, ncum
     IF (iflag(il)<=1) THEN
+      IF (cvflag_grav) THEN
+        ax = 0.01*grav*ment(il, inb(il), inb(il))*(hp(il,inb(il))-h(il,inb(il &
+          ))+t(il,inb(il))*(cpv-cpd)*(rr(il,inb(il))-qent(il,inb(il), &
+          inb(il))))/(cpn(il,inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1)))
+        ft(il, inb(il)) = ft(il, inb(il)) - ax
+        ft(il, inb(il)-1) = ft(il, inb(il)-1) + ax*cpn(il, inb(il))*(ph(il, &
+          inb(il))-ph(il,inb(il)+1))/(cpn(il,inb(il)-1)*(ph(il, &
+          inb(il)-1)-ph(il,inb(il))))
+        bx = 0.01*grav*ment(il, inb(il), inb(il))*(qent(il,inb(il),inb(il))- &
+          rr(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
+        fr(il, inb(il)) = fr(il, inb(il)) - bx
+        fr(il, inb(il)-1) = fr(il, inb(il)-1) + bx*(ph(il,inb(il))-ph(il,inb( &
+          il)+1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
+        cx = 0.01*grav*ment(il, inb(il), inb(il))*(uent(il,inb(il),inb(il))-u &
+          (il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
+        fu(il, inb(il)) = fu(il, inb(il)) - cx
+        fu(il, inb(il)-1) = fu(il, inb(il)-1) + cx*(ph(il,inb(il))-ph(il,inb( &
+          il)+1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
+        dx = 0.01*grav*ment(il, inb(il), inb(il))*(vent(il,inb(il),inb(il))-v &
+          (il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
+        fv(il, inb(il)) = fv(il, inb(il)) - dx
+        fv(il, inb(il)-1) = fv(il, inb(il)-1) + dx*(ph(il,inb(il))-ph(il,inb( &
+          il)+1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
+      ELSE
+        ax = 0.1*ment(il, inb(il), inb(il))*(hp(il,inb(il))-h(il,inb(il))+t( &
+          il,inb(il))*(cpv-cpd)*(rr(il,inb(il))-qent(il,inb(il), &
+          inb(il))))/(cpn(il,inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1)))
+        ft(il, inb(il)) = ft(il, inb(il)) - ax
+        ft(il, inb(il)-1) = ft(il, inb(il)-1) + ax*cpn(il, inb(il))*(ph(il, &
+          inb(il))-ph(il,inb(il)+1))/(cpn(il,inb(il)-1)*(ph(il, &
+          inb(il)-1)-ph(il,inb(il))))
+        bx = 0.1*ment(il, inb(il), inb(il))*(qent(il,inb(il),inb(il))-rr(il, &
+          inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
+        fr(il, inb(il)) = fr(il, inb(il)) - bx
+        fr(il, inb(il)-1) = fr(il, inb(il)-1) + bx*(ph(il,inb(il))-ph(il,inb( &
+          il)+1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
+        cx = 0.1*ment(il, inb(il), inb(il))*(uent(il,inb(il),inb(il))-u(il, &
+          inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
+        fu(il, inb(il)) = fu(il, inb(il)) - cx
+        fu(il, inb(il)-1) = fu(il, inb(il)-1) + cx*(ph(il,inb(il))-ph(il,inb( &
+          il)+1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
+        dx = 0.1*ment(il, inb(il), inb(il))*(vent(il,inb(il),inb(il))-v(il, &
+          inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
+        fv(il, inb(il)) = fv(il, inb(il)) - dx
+        fv(il, inb(il)-1) = fv(il, inb(il)-1) + dx*(ph(il,inb(il))-ph(il,inb( &
+          il)+1))/(ph(il,inb(il)-1)-ph(il,inb(il)))
+      END IF
+      ax = 0.01*grav*ment(il, inb(il), inb(il))* &
+           (hp(il,inb(il))-h(il,inb(il))+t(il,inb(il))*(cpv-cpd)*(rr(il,inb(il))-qent(il,inb(il),inb(il))))/ &
+                                (cpn(il,inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1)))
+      ft(il, inb(il)) = ft(il, inb(il)) - ax
+      ft(il, inb(il)-1) = ft(il, inb(il)-1) + ax*cpn(il, inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1))/ &
+                              (cpn(il,inb(il)-1)*(ph(il,inb(il)-1)-ph(il,inb(il))))
+      bx = 0.01*grav*ment(il, inb(il), inb(il))*(qent(il,inb(il),inb(il))-rr(il,inb(il)))/ &
+                                                 (ph(il,inb(il))-ph(il,inb(il)+1))
+      fr(il, inb(il)) = fr(il, inb(il)) - bx
+      fr(il, inb(il)-1) = fr(il, inb(il)-1) + bx*(ph(il,inb(il))-ph(il,inb(il)+1))/ &
+                                                 (ph(il,inb(il)-1)-ph(il,inb(il)))
+      cx = 0.01*grav*ment(il, inb(il), inb(il))*(uent(il,inb(il),inb(il))-u(il,inb(il)))/ &
+                                                 (ph(il,inb(il))-ph(il,inb(il)+1))
+      fu(il, inb(il)) = fu(il, inb(il)) - cx
+      fu(il, inb(il)-1) = fu(il, inb(il)-1) + cx*(ph(il,inb(il))-ph(il,inb(il)+1))/ &
+                                                 (ph(il,inb(il)-1)-ph(il,inb(il)))
+      dx = 0.01*grav*ment(il, inb(il), inb(il))*(vent(il,inb(il),inb(il))-v(il,inb(il)))/ &
+                                                 (ph(il,inb(il))-ph(il,inb(il)+1))
+      fv(il, inb(il)) = fv(il, inb(il)) - dx
+      fv(il, inb(il)-1) = fv(il, inb(il)-1) + dx*(ph(il,inb(il))-ph(il,inb(il)+1))/ &
+                                                 (ph(il,inb(il)-1)-ph(il,inb(il)))
     END IF !iflag
   END DO
+  ! AC!      do j=1,ntra
+  ! AC!       do il=1,ncum
+  ! AC!        IF (iflag(il) .le. 1) THEN
+  ! AC! IF (cvflag_grav) then
+  ! AC!        ex=0.01*grav*ment(il,inb(il),inb(il))
+  ! AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
+  ! AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
+  ! AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
+  ! AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
+  ! AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
+  ! AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
+  ! AC! else
+  ! AC!        ex=0.1*ment(il,inb(il),inb(il))
+  ! AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
+  ! AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
+  ! AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
+  ! AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
+  ! AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
+  ! AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
+  ! AC!        ENDIF   !cvflag grav
+  ! AC!        ENDIF    !iflag
+  ! AC!       enddo
+  ! AC!      enddo
+  ! ***    homogenize tendencies below cloud base    ***
+!JYG<
+!Conservation de l'eau
+!   sumdq = 0.
+!   DO k = 1, nl
+!     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
+!   END DO
+!   PRINT *, 'cv3_yield, apres 503, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
+!JYG>
+!AC!      do j=1,ntra
+!AC!       do il=1,ncum
+!AC!        IF (iflag(il) .le. 1) THEN
+!AC!    IF (cvflag_grav) then
+!AC!        ex=0.01*grav*ment(il,inb(il),inb(il))
+!AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
+!AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
+!AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
+!AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
+!AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
+!AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
+!AC!    else
+!AC!        ex=0.1*ment(il,inb(il),inb(il))
+!AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
+!AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
+!AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
+!AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
+!AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
+!AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
+!AC!        ENDIF   !cvflag grav
+!AC!        ENDIF    !iflag
+!AC!       enddo
+!AC!      enddo
+! ***    homogenize tendencies below cloud base    ***
 …
   END DO
   ! do i=1,nl
   ! do il=1,ncum
   ! th_wake(il,i)=t_wake(il,i)*(1000.0/p(il,i))**rdcp
   ! enddo
   ! enddo
+!do i=1,nl
+!do il=1,ncum
+!th_wake(il,i)=t_wake(il,i)*(1000.0/p(il,i))**rdcp
+!enddo
+!enddo
   DO i = 1, nl
     DO il = 1, ncum
       IF (i<=(icb(il)-1) .AND. iflag(il)<=1) THEN
         ! jyg  Saturated part : use T profile
+!jyg  Saturated part : use T profile
         asum(il) = asum(il) + (ft(il,i)-ftd(il,i))*(ph(il,i)-ph(il,i+1))
+        bsum(il) = bsum(il) + (fr(il,i)-fqd(il,i))*(lv(il,i)+(cl-cpd)*(t(il, &
+          i)-t(il,1)))*(ph(il,i)-ph(il,i+1))
+        csum(il) = csum(il) + (lv(il,i)+(cl-cpd)*(t(il,i)-t(il, &
+)))*(ph(il,i)-ph(il,i+1))
+!jyg<20140311
+!Correction pour conserver l eau
+        IF (ok_conserv_q) THEN
+          bsum(il) = bsum(il) + (fr(il,i)-fqd(il,i))*(ph(il,i)-ph(il,i+1))
+          csum(il) = csum(il) + (ph(il,i)-ph(il,i+1))
+        ELSE
+          bsum(il)=bsum(il)+(fr(il,i)-fqd(il,i))*(lv(il,i)+(cl-cpd)*(t(il,i)-t(il,1)))* &
+                            (ph(il,i)-ph(il,i+1))
+          csum(il)=csum(il)+(lv(il,i)+(cl-cpd)*(t(il,i)-t(il,1)))* &
+                            (ph(il,i)-ph(il,i+1))
+        ENDIF ! (ok_conserv_q)
+!jyg>
         dsum(il) = dsum(il) + t(il, i)*(ph(il,i)-ph(il,i+1))/th(il, i)
         ! jyg  Unsaturated part : use T_wake profile
+!jyg  Unsaturated part : use T_wake profile
         esum(il) = esum(il) + ftd(il, i)*(ph(il,i)-ph(il,i+1))
+        fsum(il) = fsum(il) + fqd(il, i)*(lv(il,i)+(cl-cpd)*(t_wake(il, &
+          i)-t_wake(il,1)))*(ph(il,i)-ph(il,i+1))
+        gsum(il) = gsum(il) + (lv(il,i)+(cl-cpd)*(t_wake(il,i)-t_wake(il, &
+)))*(ph(il,i)-ph(il,i+1))
+        hsum(il) = hsum(il) + t_wake(il, i)*(ph(il,i)-ph(il,i+1))/th_wake(il, &
+          i)
+!jyg<20140311
+!Correction pour conserver l eau
+        IF (ok_conserv_q) THEN
+          fsum(il) = fsum(il) + fqd(il, i)*(ph(il,i)-ph(il,i+1))
+          gsum(il) = gsum(il) + (ph(il,i)-ph(il,i+1))
+        ELSE
+          fsum(il)=fsum(il)+fqd(il,i)*(lv(il,i)+(cl-cpd)*(t_wake(il,i)-t_wake(il,1)))* &
+                            (ph(il,i)-ph(il,i+1))
+          gsum(il)=gsum(il)+(lv(il,i)+(cl-cpd)*(t_wake(il,i)-t_wake(il,1)))* &
+                            (ph(il,i)-ph(il,i+1))
+        ENDIF ! (ok_conserv_q)
+!jyg>
+        hsum(il) = hsum(il) + t_wake(il, i)*(ph(il,i)-ph(il,i+1))/th_wake(il, i)
       END IF
     END DO
   END DO
   ! !!!      do 700 i=1,icb(il)-1
+!!!!      do 700 i=1,icb(il)-1
   DO i = 1, nl
     DO il = 1, ncum
 …
   END DO
+  ! ***   Check that moisture stays positive. If not, scale tendencies
+  ! in order to ensure moisture positivity
+!jyg<
+!Conservation de l'eau
+!!  sumdq = 0.
+!!  DO k = 1, nl
+!!    sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
+!!  END DO
+!!  PRINT *, 'cv3_yield, apres hom, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
+!jyg>
+! ***   Check that moisture stays positive. If not, scale tendencies
+! in order to ensure moisture positivity
   DO il = 1, ncum
     alpha_qpos(il) = 1.
     IF (iflag(il)<=1) THEN
       IF (fr(il,1)<=0.) THEN
+        alpha_qpos(il) = max(alpha_qpos(il), (-delt*fr(il, &
+))/(s_wake(il)*rr_wake(il,1)+(1.-s_wake(il))*rr(il,1)))
+        alpha_qpos(il) = max(alpha_qpos(il), (-delt*fr(il,1))/(s_wake(il)*rr_wake(il,1)+(1.-s_wake(il))*rr(il,1)))
       END IF
     END IF
 …
       IF (iflag(il)<=1) THEN
         IF (fr(il,i)<=0.) THEN
+          alpha_qpos1(il) = max(1., (-delt*fr(il,i))/(s_wake(il)*rr_wake(il, &
+            i)+(1.-s_wake(il))*rr(il,i)))
+          IF (alpha_qpos1(il)>=alpha_qpos(il)) alpha_qpos(il) &
+            = alpha_qpos1(il)
+          alpha_qpos1(il) = max(1., (-delt*fr(il,i))/(s_wake(il)*rr_wake(il,i)+(1.-s_wake(il))*rr(il,i)))
+          IF (alpha_qpos1(il)>=alpha_qpos(il)) alpha_qpos(il) = alpha_qpos1(il)
         END IF
       END IF
 …
         m(il, i) = m(il, i)/alpha_qpos(il)
         mp(il, i) = mp(il, i)/alpha_qpos(il)
         vprecip(il, i) = vprecip(il, i)/alpha_qpos(il)
+        Vprecip(il, i) = vprecip(il, i)/alpha_qpos(il)
       END IF
     END DO
 …
   END DO
   ! AC!      DO j = 1,ntra
   ! AC!      DO i = 1,nl
   ! AC!       DO il = 1,ncum
   ! AC!        IF (iflag(il) .le. 1) THEN
   ! AC!         ftra(il,i,j) = ftra(il,i,j)/alpha_qpos(il)
   ! AC!        ENDIF
   ! AC!       ENDDO
   ! AC!      ENDDO
   ! AC!      ENDDO
   ! ***           reset counter and return           ***
+!AC!      DO j = 1,ntra
+!AC!      DO i = 1,nl
+!AC!       DO il = 1,ncum
+!AC!        IF (iflag(il) .le. 1) THEN
+!AC!         ftra(il,i,j) = ftra(il,i,j)/alpha_qpos(il)
+!AC!        ENDIF
+!AC!       ENDDO
+!AC!      ENDDO
+!AC!      ENDDO
+! ***           reset counter and return           ***
   DO il = 1, ncum
 …
           END IF
         END IF
         ! c        print *,'cbmf',il,i,k,cbmf(il),wghti(il,k)
+! c        print *,'cbmf',il,i,k,cbmf(il),wghti(il,k)
       END DO
     END DO
 …
     DO k = i, nl
       DO il = 1, ncum
+        ! test         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il))
+        ! then
+! test         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il)) then
         IF (i<=inb(il) .AND. k<=inb(il)) THEN
           upwd(il, i) = upwd(il, i) + up1(il, k, i)
           dnwd(il, i) = dnwd(il, i) + dn1(il, k, i)
         END IF
+        ! c         print
+        ! *,'upwd',il,i,k,inb(il),upwd(il,i),m(il,k),up1(il,k,i)
+! c         print *,'upwd',il,i,k,inb(il),upwd(il,i),m(il,k),up1(il,k,i)
       END DO
     END DO
 …
   ! !!!      DO il=1,ncum
   ! !!!      do i=icb(il),inb(il)
   ! !!!
   ! !!!      upwd(il,i)=0.0
   ! !!!      dnwd(il,i)=0.0
   ! !!!      do k=i,inb(il)
   ! !!!      up1=0.0
   ! !!!      dn1=0.0
   ! !!!      do n=1,i-1
   ! !!!      up1=up1+ment(il,n,k)
   ! !!!      dn1=dn1-ment(il,k,n)
   ! !!!      enddo
   ! !!!      upwd(il,i)=upwd(il,i)+m(il,k)+up1
   ! !!!      dnwd(il,i)=dnwd(il,i)+dn1
   ! !!!      enddo
   ! !!!      enddo
   ! !!!
   ! !!!      ENDDO
   ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
   ! determination de la variation de flux ascendant entre
   ! deux niveau non dilue mip
   ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!!!!      DO il=1,ncum
+!!!!      do i=icb(il),inb(il)
+!!!!
+!!!!      upwd(il,i)=0.0
+!!!!      dnwd(il,i)=0.0
+!!!!      do k=i,inb(il)
+!!!!      up1=0.0
+!!!!      dn1=0.0
+!!!!      do n=1,i-1
+!!!!      up1=up1+ment(il,n,k)
+!!!!      dn1=dn1-ment(il,k,n)
+!!!!      enddo
+!!!!      upwd(il,i)=upwd(il,i)+m(il,k)+up1
+!!!!      dnwd(il,i)=dnwd(il,i)+dn1
+!!!!      enddo
+!!!!      enddo
+!!!!
+!!!!      ENDDO
+! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! determination de la variation de flux ascendant entre
+! deux niveau non dilue mip
+! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
   DO i = 1, nl
 …
   END DO
   ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
   ! icb represente de niveau ou se trouve la
   ! base du nuage , et inb le top du nuage
   ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! icb represente de niveau ou se trouve la
+! base du nuage , et inb le top du nuage
+! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
   DO i = 1, nd
 …
   DO i = 1, nd
     DO il = 1, ncum
+      rdcp = (rrd*(1.-rr(il,i))-rr(il,i)*rrv)/(cpd*(1.-rr(il, &
+        i))+rr(il,i)*cpv)
+      rdcp = (rrd*(1.-rr(il,i))-rr(il,i)*rrv)/(cpd*(1.-rr(il,i))+rr(il,i)*cpv)
       tls(il, i) = t(il, i)*(1000.0/p(il,i))**rdcp
       tps(il, i) = tp(il, i)
 …
   ! *** diagnose the in-cloud mixing ratio   ***            ! cld
   ! ***           of condensed water         ***            ! cld
+  ! ! cld
   DO i = 1, nd ! cld
     DO il = 1, ncum ! cld
       mac(il, i) = 0.0 ! cld
       wa(il, i) = 0.0 ! cld
       siga(il, i) = 0.0 ! cld
       sax(il, i) = 0.0 ! cld
     END DO ! cld
   END DO ! cld
   DO i = minorig, nl ! cld
     DO k = i + 1, nl + 1 ! cld
       DO il = 1, ncum ! cld
+! *** diagnose the in-cloud mixing ratio   ***                       ! cld
+! ***           of condensed water         ***                       ! cld
+!! cld
+  DO i = 1, nd                                                       ! cld
+    DO il = 1, ncum                                                  ! cld
+      mac(il, i) = 0.0                                               ! cld
+      wa(il, i) = 0.0                                                ! cld
+      siga(il, i) = 0.0                                              ! cld
+      sax(il, i) = 0.0                                               ! cld
+    END DO                                                           ! cld
+  END DO                                                             ! cld
+  DO i = minorig, nl                                                 ! cld
+    DO k = i + 1, nl + 1                                             ! cld
+      DO il = 1, ncum                                                ! cld
         IF (i<=inb(il) .AND. k<=(inb(il)+1) .AND. iflag(il)<=1) THEN ! cld
           mac(il, i) = mac(il, i) + m(il, k) ! cld
         END IF ! cld
       END DO ! cld
     END DO ! cld
   END DO ! cld
   DO i = 1, nl ! cld
     DO j = 1, i ! cld
       DO il = 1, ncum ! cld
         IF (i>=icb(il) .AND. i<=(inb(il)-1) & ! cld
             .AND. j>=icb(il) .AND. iflag(il)<=1) THEN ! cld
           sax(il, i) = sax(il, i) + rrd*(tvp(il,j)-tv(il,j)) & ! cld
             *(ph(il,j)-ph(il,j+1))/p(il, j) ! cld
         END IF ! cld
       END DO ! cld
     END DO ! cld
   END DO ! cld
   DO i = 1, nl ! cld
     DO il = 1, ncum ! cld
       IF (i>=icb(il) .AND. i<=(inb(il)-1) & ! cld
           .AND. sax(il,i)>0.0 .AND. iflag(il)<=1) THEN ! cld
         wa(il, i) = sqrt(2.*sax(il,i)) ! cld
       END IF ! cld
     END DO ! cld
   END DO ! cld
   DO i = 1, nl ! cld
     DO il = 1, ncum ! cld
       IF (wa(il,i)>0.0 .AND. iflag(il)<=1) & ! cld
         siga(il, i) = mac(il, i)/wa(il, i) & ! cld
         *rrd*tvp(il, i)/p(il, i)/100./delta ! cld
       siga(il, i) = min(siga(il,i), 1.0) ! cld
+      ! IM cf. FH
       IF (iflag_clw==0) THEN
         qcondc(il, i) = siga(il, i)*clw(il, i)*(1.-ep(il,i)) & ! cld
           +(1.-siga(il,i))*qcond(il, i) ! cld
       ELSE IF (iflag_clw==1) THEN
         qcondc(il, i) = qcond(il, i) ! cld
       END IF
     END DO ! cld
   END DO
   ! print*,'cv3_yield fin'
+    ! cld
+          mac(il, i) = mac(il, i) + m(il, k)                         ! cld
+        END IF                                                       ! cld
+      END DO                                                         ! cld
+    END DO                                                           ! cld
+  END DO                                                             ! cld
+  DO i = 1, nl                                                       ! cld
+    DO j = 1, i                                                      ! cld
+      DO il = 1, ncum                                                ! cld
+        IF (i>=icb(il) .AND. i<=(inb(il)-1) &                        ! cld
+            .AND. j>=icb(il) .AND. iflag(il)<=1) THEN                ! cld
+          sax(il, i) = sax(il, i) + rrd*(tvp(il,j)-tv(il,j)) &       ! cld
+            *(ph(il,j)-ph(il,j+1))/p(il, j)                          ! cld
+        END IF                                                       ! cld
+      END DO                                                         ! cld
+    END DO                                                           ! cld
+  END DO                                                             ! cld
+  DO i = 1, nl                                                       ! cld
+    DO il = 1, ncum                                                  ! cld
+      IF (i>=icb(il) .AND. i<=(inb(il)-1) &                          ! cld
+          .AND. sax(il,i)>0.0 .AND. iflag(il)<=1) THEN               ! cld
+        wa(il, i) = sqrt(2.*sax(il,i))                               ! cld
+      END IF                                                         ! cld
+    END DO                                                           ! cld
+  END DO                                                             ! cld
+  DO i = 1, nl                                                       ! cld
+    DO il = 1, ncum                                                  ! cld
+      IF (wa(il,i)>0.0 .AND. iflag(il)<=1) &                         ! cld
+        siga(il, i) = mac(il, i)/wa(il, i) &                         ! cld
+        *rrd*tvp(il, i)/p(il, i)/100./delta                          ! cld
+      siga(il, i) = min(siga(il,i), 1.0)                             ! cld
+! IM cf. FH
+      IF (iflag_clw==0) THEN                                         ! cld
+        qcondc(il, i) = siga(il, i)*clw(il, i)*(1.-ep(il,i)) &       ! cld
+          +(1.-siga(il,i))*qcond(il, i)                              ! cld
+      ELSE IF (iflag_clw==1) THEN                                    ! cld
+        qcondc(il, i) = qcond(il, i)                                 ! cld
+      END IF                                                         ! cld
+    END DO                                                           ! cld
+  END DO
+! print*,'cv3_yield fin'
   RETURN
 END SUBROUTINE cv3_yield
+! AC! et !RomP >>>
+SUBROUTINE cv3_tracer(nloc, len, ncum, nd, na, ment, sigij, da, phi, phi2, &
+    d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
+!AC! et !RomP >>>
+SUBROUTINE cv3_tracer(nloc, len, ncum, nd, na, &
+                      ment, sigij, da, phi, phi2, d1a, dam, &
+                      ep, Vprecip, elij, clw, epmlmMm, eplaMm, &
+                      icb, inb)
   IMPLICIT NONE
   include "cv3param.h"
   ! inputs:
+!inputs:
   INTEGER ncum, nd, na, nloc, len
   REAL ment(nloc, na, na), sigij(nloc, na, na)
 …
   REAL ep(nloc, na)
   INTEGER icb(nloc), inb(nloc)
   REAL vprecip(nloc, nd+1)
   ! ouputs:
+  REAL Vprecip(nloc, nd+1)
+!ouputs:
   REAL da(nloc, na), phi(nloc, na, na)
   REAL phi2(nloc, na, na)
   REAL d1a(nloc, na), dam(nloc, na)
   REAL epmlmmm(nloc, na, na), eplamm(nloc, na)
   ! variables pour tracer dans precip de l'AA et des mel
   ! local variables:
+  REAL epmlmMm(nloc, na, na), eplaMm(nloc, na)
+! variables pour tracer dans precip de l'AA et des mel
+!local variables:
   INTEGER i, j, k
   REAL epm(nloc, na, na)
   ! variables d'Emanuel : du second indice au troisieme
   ! --->    tab(i,k,j) -> de l origine k a l arrivee j
   ! ment, sigij, elij
   ! variables personnelles : du troisieme au second indice
   ! --->    tab(i,j,k) -> de k a j
   ! phi, phi2
   ! initialisations
+! variables d'Emanuel : du second indice au troisieme
+! --->    tab(i,k,j) -> de l origine k a l arrivee j
+! ment, sigij, elij
+! variables personnelles : du troisieme au second indice
+! --->    tab(i,j,k) -> de k a j
+! phi, phi2
+! initialisations
   da(:, :) = 0.
 …
   dam(:, :) = 0.
   epm(:, :, :) = 0.
   eplamm(:, :) = 0.
   epmlmmm(:, :, :) = 0.
+  eplaMm(:, :) = 0.
+  epmlmMm(:, :, :) = 0.
   phi(:, :, :) = 0.
   phi2(:, :, :) = 0.
   ! fraction deau condensee dans les melanges convertie en precip : epm
   ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
+! fraction deau condensee dans les melanges convertie en precip : epm
+! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
   DO j = 1, na
     DO k = 1, na
       DO i = 1, ncum
         IF (k>=icb(i) .AND. k<=inb(i) .AND. & ! !jyg     &
                                               ! j.ge.k.and.j.le.inb(i)) then
           ! !jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
+        IF (k>=icb(i) .AND. k<=inb(i) .AND. &
+!!jyg              j.ge.k.and.j.le.inb(i)) then
+!!jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
             j>k .AND. j<=inb(i)) THEN
           epm(i, j, k) = 1. - (1.-ep(i,j))*clw(i, j)/max(elij(i,k,j), 1.E-16)
           ! !
+!!
           epm(i, j, k) = max(epm(i,j,k), 0.0)
         END IF
 …
       DO i = 1, ncum
         IF (k>=icb(i) .AND. k<=inb(i)) THEN
           eplamm(i, j) = eplamm(i, j) + ep(i, j)*clw(i, j)*ment(i, j, k)*(1.- &
             sigij(i,j,k))
+          eplaMm(i, j) = eplamm(i, j) + &
+                         ep(i, j)*clw(i, j)*ment(i, j, k)*(1.-sigij(i,j,k))
         END IF
       END DO
 …
       DO i = 1, ncum
         IF (k>=icb(i) .AND. k<=inb(i) .AND. j<=inb(i)) THEN
           epmlmmm(i, j, k) = epm(i, j, k)*elij(i, k, j)*ment(i, k, j)
+          epmlmMm(i, j, k) = epm(i, j, k)*elij(i, k, j)*ment(i, k, j)
         END IF
       END DO
 …
   END DO
   ! matrices pour calculer la tendance des concentrations dans cvltr.F90
+! matrices pour calculer la tendance des concentrations dans cvltr.F90
   DO j = 1, na
     DO k = 1, na
 …
         d1a(i, j) = d1a(i, j) + ment(i, k, j)*ep(i, k)*(1.-sigij(i,k,j))
         IF (k<=j) THEN
+          dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, k, j)*(1.-ep(i,k))*(1. &
+            -sigij(i,k,j))
+          dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, k, j)*(1.-ep(i,k))*(1.-sigij(i,k,j))
           phi2(i, j, k) = phi(i, j, k)*epm(i, j, k)
         END IF
 …
   RETURN
 END SUBROUTINE cv3_tracer
+! AC! et !RomP <<<
+SUBROUTINE cv3_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, precip, &
+    sig, w0, ft, fq, fu, fv, ftra, ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
+    iflag1, precip1, sig1, w01, ft1, fq1, fu1, fv1, ftra1, ma1, upwd1, dnwd1, &
+    dnwd01, qcondc1, wd1, cape1)
+!AC! et !RomP <<<
+SUBROUTINE cv3_uncompress(nloc, len, ncum, nd, ntra, idcum, &
+                          iflag, &
+                          precip, sig, w0, &
+                          ft, fq, fu, fv, ftra, &
+                          Ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
+                          iflag1, &
+                          precip1, sig1, w01, &
+                          ft1, fq1, fu1, fv1, ftra1, &
+                          Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1)
   IMPLICIT NONE
   include "cv3param.h"
   ! inputs:
+!inputs:
   INTEGER len, ncum, nd, ntra, nloc
   INTEGER idcum(nloc)
 …
   REAL wd(nloc), cape(nloc)
   ! outputs:
+!outputs:
   INTEGER iflag1(len)
   REAL precip1(len)
 …
   REAL wd1(nloc), cape1(nloc)
   ! local variables:
+!local variables:
   INTEGER i, k, j
 …
+  ! AC!        do 2100 j=1,ntra
+  ! AC!c oct3         do 2110 k=1,nl
+  ! AC!         do 2110 k=1,nd ! oct3
+  ! AC!          do 2120 i=1,ncum
+  ! AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
+  ! AC! 2120     continue
+  ! AC! 2110    continue
+  ! AC! 2100   continue
+!AC!        do 2100 j=1,ntra
+!AC!c oct3         do 2110 k=1,nl
+!AC!         do 2110 k=1,nd ! oct3
+!AC!          do 2120 i=1,ncum
+!AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
+!AC! 2120     continue
+!AC! 2110    continue
+!AC! 2100   continue
+!
   RETURN
 END SUBROUTINE cv3_uncompress

LMDZ5/branches/testing/libf/phylmd/cv3_vertmix.F90

-                      r1999
+                      r2056
+SUBROUTINE cv3_vertmix(len, nd, iflag, plim1, plim2, p, ph, t, q, u, v, w, &
+    wi, nk, tmix, thmix, qmix, qsmix, umix, vmix, plcl)
+SUBROUTINE cv3_vertmix(len, nd, iflag, plim1, plim2, p, ph, &
+                       t, q, u, v, w, &
+                       wi, nk, tmix, thmix, qmix, qsmix, umix, vmix, plcl)
   ! **************************************************************
   ! *
 …
   ! ==============================================================
+  ! vertmix : determine theta et r du melange obtenu en brassant
+  ! adiabatiquement entre plim1 et plim2, avec une ponderation w.
+  ! vertmix : determines theta, t, q, qs, u and v of the mixture generated by
+  ! adiabatic mixing of air between plim1 and plim2 with weighting w.
+  ! If plim1 and plim2 fall within the same model layer, then theta, ... v
+  ! are those of that layer.
+  ! A minimum value (dpmin) is imposed upon plim1-plim2
   ! ===============================================================
 …
   include "YOMCST.h"
   include "FCTTRE.h"
+  ! input :
+  INTEGER nd, len
+  INTEGER nk(len), iflag(len)
+  REAL t(len, nd), q(len, nd), w(nd)
+  REAL u(len, nd), v(len, nd)
+  REAL p(len, nd), ph(len, nd+1)
+  REAL plim1(len), plim2(len)
+  ! output :
+  REAL tmix(len), thmix(len), qmix(len), wi(len, nd)
+  REAL umix(len), vmix(len)
+  REAL qsmix(len)
+  REAL plcl(len)
+  ! internal variables :
+  INTEGER j1(len), j2(len), niflag7
+  REAL a, b
+  REAL ahm(len), dpw(len), coef(len)
+  REAL p1(len, nd), p2(len, nd)
+  REAL rdcp(len), a2(len), b2(len), pnk(len)
+  REAL rh(len), chi(len)
+  REAL cpn
+  REAL x, y, p0, p0m1, zdelta, zcor
+!inputs:
+  INTEGER, INTENT (IN)                      ::  nd, len
+  INTEGER, DIMENSION (len), INTENT (IN)     ::  nk
+  REAL, DIMENSION (nd), INTENT (IN)        ::  w
+  REAL, DIMENSION (len), INTENT (IN)        :: plim1, plim2
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: t, q
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: u, v
+  REAL, DIMENSION (len,nd), INTENT (IN)     :: p
+  REAL, DIMENSION (len,nd+1), INTENT (IN)   :: ph
+!input/output:
+  INTEGER, DIMENSION (len), INTENT (INOUT)  ::  iflag
+!outputs:
+  REAL, DIMENSION (len), INTENT (OUT)       :: tmix, thmix, qmix
+  REAL, DIMENSION (len), INTENT (OUT)       :: umix, vmix
+  REAL, DIMENSION (len), INTENT (OUT)       :: qsmix
+  REAL, DIMENSION (len), INTENT (OUT)       :: plcl
+  REAL, DIMENSION (len,nd), INTENT (OUT)    :: wi
+!internal variables :
   INTEGER i, j
+  INTEGER niflag7
+  INTEGER, DIMENSION(len)                   :: j1, j2
+  REAL                                      :: a, b
+  REAL                                      :: cpn
+  REAL                                      :: x, y, p0, p0m1, zdelta, zcor
+  REAL                                      :: dpmin=1.
+!$OMP THREADPRIVATE(dpmin)
+  REAL, DIMENSION(len)                      :: plim2p  ! = min(plim2(:),plim1(:)-dpmin)
+  REAL, DIMENSION(len)                      :: ahm, dpw, coef
+  REAL, DIMENSION(len)                      :: rdcp, a2, b2, pnk
+  REAL, DIMENSION(len)                      :: rh, chi
+  REAL, DIMENSION(len)                      :: eqwght
+  REAL, DIMENSION(len,nd)                   :: p1, p2
+!!  print *,' ->cv3_vertmix, plim1,plim2 ', plim1,plim2   !jyg
+  plim2p(:) = min(plim2(:),plim1(:)-dpmin)
+  j1(:)=nd
+  j2(:) = 0
   DO j = 1, nd
     DO i = 1, len
       IF (plim1(i)<=ph(i,j)) j1(i) = j
+      IF (plim2(i)>=ph(i,j+1) .AND. plim2(i)<ph(i,j)) j2(i) = j
+!!!      IF (plim2p(i)>=ph(i,j+1) .AND. plim2p(i)<ph(i,j)) j2(i) = j
+      IF (plim2p(i)< ph(i,j)) j2(i) = j
     END DO
   END DO
 …
     pnk(i) = p(i, nk(i))
   END DO
+  eqwght(:) = 0.
   p0 = 1000.
 …
   DO i = 1, len
+    coef(i) = 1./(plim1(i)-plim2(i))
+  END DO
+    IF (j2(i) < j1(i)) THEN
+      coef(i) = 1.
+      eqwght(i) = 1.
+    ELSE
+      coef(i) = 1./(plim1(i)-plim2p(i))
+    ENDIF
+  END DO
+!!  print *,'cv3_vertmix, j1,j2,coef ', j1,j2,coef  !jyg
   DO j = 1, nd
 …
       IF (j>=j1(i) .AND. j<=j2(i)) THEN
         p1(i, j) = min(ph(i,j), plim1(i))
         p2(i, j) = max(ph(i,j+1), plim2(i))
+        p2(i, j) = max(ph(i,j+1), plim2p(i))
         ! CRtest:couplage thermiques: deja normalise
         ! wi(i,j) = w(j)
         ! print*,'wi',wi(i,j)
         wi(i, j) = w(j)*(p1(i,j)-p2(i,j))*coef(i)
+        wi(i, j) = w(j)*(p1(i,j)-p2(i,j))*coef(i)+eqwght(i)
         dpw(i) = dpw(i) + wi(i, j)
+!!  print *,'cv3_vertmix, j, wi(1,j),dpw ', j, wi(1,j),dpw  !jyg
       END IF
     END DO
   END DO
   ! CR:print
   ! do i=1,len
   ! print*,'plim',plim1(i),plim2(i)
+  ! print*,'plim',plim1(i),plim2p(i)
   ! enddo
   DO j = 1, nd
 …
     rdcp(i) = (rrd*(1.-qmix(i))+qmix(i)*rrv)/(cpd*(1.-qmix(i))+qmix(i)*cpv)
   END DO
+!!  print *,'cv3_vertmix, rdcp ', rdcp  !jyg
 …
       rh(i) = max(rh(i), 0.)
       plcl(i) = pnk(i)*(rh(i)**chi(i))
       IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) iflag &
         (i) = 8
+      IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) &
+          iflag(i) = 8
     ELSE
       niflag7 = niflag7 + 1
       plcl(i) = plim2(i)
+      plcl(i) = plim2p(i)
     END IF ! iflag=7
 …
   END DO
+!!  print *,' cv3_vertmix->'  !jyg
   RETURN

LMDZ5/branches/testing/libf/phylmd/cv3p_mixing.F90

-                      r1999
+                      r2056
+SUBROUTINE cv3p_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, ph, t, rr, rs, &
+    u, v, tra, h, lv, qnk, unk, vnk, hp, tv, tvp, ep, clw, sig, ment, qent, &
+    hent, uent, vent, nent, sigij, elij, supmax, ments, qents, traent)
+  ! **************************************************************
+  ! *
+  ! CV3P_MIXING : compute mixed draught properties and,         *
+  ! within a scaling factor, mixed draught        *
+  ! mass fluxes.                                  *
+  ! written by  : VTJ Philips,JY Grandpeix, 21/05/2003, 09.14.15*
+  ! modified by :                                               *
+  ! **************************************************************
+SUBROUTINE cv3p_mixing(nloc, ncum, nd, na, ntra, icb, nk, inb, &
+                       ph, t, rr, rs, u, v, tra, h, lv, qnk, &
+                       unk, vnk, hp, tv, tvp, ep, clw, sig, &
+                       Ment, Qent, hent, uent, vent, nent, &
+                       Sigij, elij, supmax, Ments, Qents, traent)
+! **************************************************************
+! *
+! CV3P_MIXING : compute mixed draught properties and,         *
+! within a scaling factor, mixed draught        *
+! mass fluxes.                                  *
+! written by  : VTJ Philips,JY Grandpeix, 21/05/2003, 09.14.15*
+! modified by :                                               *
+! **************************************************************
   IMPLICIT NONE
 …
   include "YOMCST2.h"
+  ! inputs:
+  INTEGER ncum, nd, na, ntra, nloc
+  INTEGER icb(nloc), inb(nloc), nk(nloc)
+  REAL sig(nloc, nd)
+  REAL qnk(nloc), unk(nloc), vnk(nloc)
+  REAL ph(nloc, nd+1)
+  REAL t(nloc, nd), rr(nloc, nd), rs(nloc, nd)
+  REAL u(nloc, nd), v(nloc, nd)
+  REAL tra(nloc, nd, ntra) ! input of convect3
+  REAL lv(nloc, na)
+  REAL h(nloc, na) !liquid water static energy of environment
+  REAL hp(nloc, na) !liquid water static energy of air shed from adiab. asc.
+  REAL tv(nloc, na), tvp(nloc, na), ep(nloc, na), clw(nloc, na)
+  ! outputs:
+  REAL ment(nloc, na, na), qent(nloc, na, na)
+  REAL uent(nloc, na, na), vent(nloc, na, na)
+  REAL sigij(nloc, na, na), elij(nloc, na, na)
+  REAL supmax(nloc, na) ! Highest mixing fraction of mixed updraughts
+    ! with the sign of (h-hp)
+  REAL traent(nloc, nd, nd, ntra)
+  REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
+  REAL hent(nloc, nd, nd)
+  INTEGER nent(nloc, nd)
+  ! local variables:
+!inputs:
+  INTEGER, INTENT (IN)                               :: ncum, nd, na
+  INTEGER, INTENT (IN)                               :: ntra, nloc
+  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb, nk
+  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: sig
+  REAL, DIMENSION (nloc), INTENT (IN)                :: qnk, unk, vnk
+  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
+  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, rr, rs
+  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: u, v
+  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: tra ! input of convect3
+  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lv
+  REAL, DIMENSION (nloc, na), INTENT (IN)            :: h  !liquid water static energy of environMent
+  REAL, DIMENSION (nloc, na), INTENT (IN)            :: hp !liquid water static energy of air shed from adiab. asc.
+  REAL, DIMENSION (nloc, na), INTENT (IN)            :: tv, tvp
+  REAL, DIMENSION (nloc, na), INTENT (IN)            :: ep, clw
+!outputs:
+  REAL, DIMENSION (nloc, na, na), INTENT (OUT)       :: Ment, Qent
+  REAL, DIMENSION (nloc, na, na), INTENT (OUT)       :: uent, vent
+  REAL, DIMENSION (nloc, na, na), INTENT (OUT)       :: Sigij, elij
+  REAL, DIMENSION (nloc, na), INTENT (OUT)           :: supmax(nloc, na) ! Highest mixing fraction of mixed
+                                                                         ! updraughts with the sign of (h-hp)
+  REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT) :: traent
+  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT)       :: Ments, Qents
+  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT)       :: hent
+  INTEGER, DIMENSION (nloc, nd), INTENT (OUT)        :: nent
+!local variables:
   INTEGER i, j, k, il, im, jm
   INTEGER num1, num2
+  REAL rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
+  REAL alt, delp, delm
+  REAL qmixmax(nloc), rmixmax(nloc), sqmrmax(nloc)
+  REAL qmixmin(nloc), rmixmin(nloc), sqmrmin(nloc)
+  REAL signhpmh(nloc)
+  REAL sx(nloc), scrit2
+  REAL smid(nloc), sjmin(nloc), sjmax(nloc)
+  REAL sbef(nloc), sup(nloc), smin(nloc)
+  REAL asij(nloc), smax(nloc), scrit(nloc)
+  REAL sij(nloc, nd, nd)
+  REAL csum(nloc, nd)
+  REAL awat
+  LOGICAL lwork(nloc)
+  REAL                               :: rti, bf2, anum, denom, dei, altem, cwat, stemp, qp
+  REAL                               :: alt, delp, delm
+  REAL, DIMENSION (nloc)             :: Qmixmax, Rmixmax, sqmrmax
+  REAL, DIMENSION (nloc)             :: Qmixmin, Rmixmin, sqmrmin
+  REAL, DIMENSION (nloc)             :: signhpmh
+  REAL, DIMENSION (nloc)             :: Sx
+  REAL                               :: Scrit2
+  REAL, DIMENSION (nloc)             :: Smid, Sjmin, Sjmax
+  REAL, DIMENSION (nloc)             :: Sbef, sup, smin
+  REAL, DIMENSION (nloc)             :: ASij, smax, Scrit
+  REAL, DIMENSION (nloc, nd, nd)     :: Sij
+  REAL, DIMENSION (nloc, nd)         :: csum
+  REAL                               :: awat
+  LOGICAL, DIMENSION (nloc)          :: lwork
   REAL amxupcrit, df, ff
   INTEGER nstep
+  ! --   Mixing probability distribution functions
+  REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
+  qcoef1(f) = tanh(f/gammas)
+  qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas)))
+  qff(f) = max(min(f,1.), 0.)
+  qfff(f) = min(qff(f), scut)
+  qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max
+  rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/ &
+    qcoef2max
+  qmix2(f) = -log(1.-qfff(f))/scut
+  rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut
+  qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f)
+  rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f)
+! --   Mixing probability distribution functions
+  REAL Qcoef1, Qcoef2, QFF, QFFF, Qmix, Rmix, Qmix1, Rmix1, Qmix2, Rmix2, F
+  Qcoef1(F) = tanh(F/gammas)
+  Qcoef2(F) = (tanh(F/gammas)+gammas*log(cosh((1.-F)/gammas)/cosh(F/gammas)))
+  QFF(F) = max(min(F,1.), 0.)
+  QFFf(F) = min(QFF(F), scut)
+  Qmix1(F) = (tanh((QFF(F)-Fmax)/gammas)+Qcoef1max)/Qcoef2max
+  Rmix1(F) = (gammas*log(cosh((QFF(F)-Fmax)/gammas))+QFF(F)*Qcoef1max)/Qcoef2max
+  Qmix2(F) = -log(1.-QFFf(F))/scut
+  Rmix2(F) = (QFFf(F)+(1.-QFF(F))*log(1.-QFFf(F)))/scut
+  Qmix(F) = qqa1*Qmix1(F) + qqa2*Qmix2(F)
+  Rmix(F) = qqa1*Rmix1(F) + qqa2*Rmix2(F)
   INTEGER, SAVE :: ifrst
   DATA ifrst/0/
   !$OMP THREADPRIVATE(ifrst)
   ! =====================================================================
   ! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
   ! =====================================================================
   ! -- Initialize mixing PDF coefficients
+!$OMP THREADPRIVATE(ifrst)
+! =====================================================================
+! --- INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS
+! =====================================================================
+! -- Initialize mixing PDF coefficients
   IF (ifrst==0) THEN
     ifrst = 1
     qcoef1max = qcoef1(fmax)
     qcoef2max = qcoef2(fmax)
+    Qcoef1max = Qcoef1(Fmax)
+    Qcoef2max = Qcoef2(Fmax)
   END IF
   ! ori        do 360 i=1,ncum*nlp
+! ori        do 360 i=1,ncum*nlp
   DO j = 1, nl
     DO i = 1, ncum
       nent(i, j) = 0
       ! in convect3, m is computed in cv3_closure
       ! ori          m(i,1)=0.0
     END DO
   END DO
   ! ori      do 400 k=1,nlp
   ! ori       do 390 j=1,nlp
+! in convect3, m is computed in cv3_closure
+! ori          m(i,1)=0.0
+    END DO
+  END DO
+! ori      do 400 k=1,nlp
+! ori       do 390 j=1,nlp
   DO j = 1, nl
     DO k = 1, nl
       DO i = 1, ncum
         qent(i, k, j) = rr(i, j)
+        Qent(i, k, j) = rr(i, j)
         uent(i, k, j) = u(i, j)
         vent(i, k, j) = v(i, j)
         elij(i, k, j) = 0.0
         hent(i, k, j) = 0.0
         ! AC!            ment(i,k,j)=0.0
         ! AC!            sij(i,k,j)=0.0
       END DO
     END DO
   END DO
   ! AC!
   ment(1:ncum, 1:nd, 1:nd) = 0.0
   sij(1:ncum, 1:nd, 1:nd) = 0.0
   ! AC!
+!AC!            Ment(i,k,j)=0.0
+!AC!            Sij(i,k,j)=0.0
+      END DO
+    END DO
+  END DO
+!AC!
+  Ment(1:ncum, 1:nd, 1:nd) = 0.0
+  Sij(1:ncum, 1:nd, 1:nd) = 0.0
+!AC!
   DO k = 1, ntra
 …
   END DO
   ! =====================================================================
   ! --- CALCULATE ENTRAINED AIR MASS FLUX (ment), TOTAL WATER MIXING
   ! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
   ! --- FRACTION (sij)
   ! =====================================================================
+! =====================================================================
+! --- CALCULATE ENTRAINED AIR MASS FLUX (Ment), TOTAL WATER MIXING
+! --- RATIO (QENT), TOTAL CONDENSED WATER (elij), AND MIXING
+! --- FRACTION (Sij)
+! =====================================================================
   DO i = minorig + 1, nl
 …
     DO j = minorig, nl
       DO il = 1, ncum
         IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)- &
 )) .AND. (j<=inb(il))) THEN
+        IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)-1)) &
+                         .AND. (j<=inb(il))) THEN
           rti = qnk(il) - ep(il, i)*clw(il, i)
 …
           dei = denom
           IF (abs(dei)<0.01) dei = 0.01
           sij(il, i, j) = anum/dei
           sij(il, i, i) = 1.0
           altem = sij(il, i, j)*rr(il, i) + (1.-sij(il,i,j))*rti - rs(il, j)
+          Sij(il, i, j) = anum/dei
+          Sij(il, i, i) = 1.0
+          altem = Sij(il, i, j)*rr(il, i) + (1.-Sij(il,i,j))*rti - rs(il, j)
           altem = altem/bf2
           cwat = clw(il, j)*(1.-ep(il,j))
           stemp = sij(il, i, j)
+          stemp = Sij(il, i, j)
           IF ((stemp<0.0 .OR. stemp>1.0 .OR. altem>cwat) .AND. j>i) THEN
             anum = anum - lv(il, j)*(rti-rs(il,j)-cwat*bf2)
             denom = denom + lv(il, j)*(rr(il,i)-rti)
             IF (abs(denom)<0.01) denom = 0.01
+            sij(il, i, j) = anum/denom
+            altem = sij(il, i, j)*rr(il, i) + (1.-sij(il,i,j))*rti - &
+              rs(il, j)
+            Sij(il, i, j) = anum/denom
+            altem = Sij(il, i, j)*rr(il, i) + (1.-Sij(il,i,j))*rti - rs(il, j)
             altem = altem - (bf2-1.)*cwat
           END IF
           IF (sij(il,i,j)>0.0) THEN
             ! cc                 ment(il,i,j)=m(il,i)
             ment(il, i, j) = 1.
+          IF (Sij(il,i,j)>0.0) THEN
+!!!                 Ment(il,i,j)=m(il,i)
+            Ment(il, i, j) = 1.
             elij(il, i, j) = altem
             elij(il, i, j) = amax1(0.0, elij(il,i,j))
 …
           END IF
           sij(il, i, j) = amax1(0.0, sij(il,i,j))
           sij(il, i, j) = amin1(1.0, sij(il,i,j))
+          Sij(il, i, j) = amax1(0.0, Sij(il,i,j))
+          Sij(il, i, j) = amin1(1.0, Sij(il,i,j))
         END IF ! new
       END DO
 …
+    ! ***   if no air can entrain at level i assume that updraft detrains
+    ! ***
+    ! ***   at that level and calculate detrained air flux and properties
+    ! ***
+    ! @      do 170 i=icb(il),inb(il)
+! ***   if no air can entrain at level i assume that updraft detrains  ***
+! ***   at that level and calculate detrained air flux and properties  ***
+! @      do 170 i=icb(il),inb(il)
     DO il = 1, ncum
       IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN
         ! @      if(nent(il,i).eq.0)then
         ! cc      ment(il,i,i)=m(il,i)
         ment(il, i, i) = 1.
         qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
+! @      if(nent(il,i).eq.0)then
+!!!       Ment(il,i,i)=m(il,i)
+        Ment(il, i, i) = 1.
+        Qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
         uent(il, i, i) = unk(il)
         vent(il, i, i) = vnk(il)
         elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
         sij(il, i, i) = 0.0
+        Sij(il, i, i) = 0.0
       END IF
     END DO
 …
     DO i = minorig, nl
       DO il = 1, ncum
         IF ((j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. (i>=icb(il)) .AND. (i<= &
             inb(il))) THEN
           sigij(il, i, j) = sij(il, i, j)
         END IF
       END DO
     END DO
   END DO
   ! @      enddo
   ! @170   continue
   ! =====================================================================
   ! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
   ! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
   ! =====================================================================
+        IF ((j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
+            (i>=icb(il)) .AND. (i<=inb(il))) THEN
+          Sigij(il, i, j) = Sij(il, i, j)
+        END IF
+      END DO
+    END DO
+  END DO
+! @      enddo
+! @170   continue
+! =====================================================================
+! ---  NORMALIZE ENTRAINED AIR MASS FLUXES
+! ---  TO REPRESENT EQUAL PROBABILITIES OF MIXING
+! =====================================================================
   CALL zilch(csum, nloc*nd)
 …
   END DO
   ! ---------------------------------------------------------------
   DO i = minorig + 1, nl !Loop on origin level "i"
     ! ---------------------------------------------------------------
+! ---------------------------------------------------------------
+  DO i = minorig + 1, nl      !Loop on origin level "i"
+! ---------------------------------------------------------------
     num1 = 0
 …
     ! jyg1    Find maximum of SIJ for J>I, if any.
     sx(:) = 0.
+!JYG1    Find maximum of SIJ for J>I, if any.
+    Sx(:) = 0.
     DO il = 1, ncum
       IF (i>=icb(il) .AND. i<=inb(il)) THEN
         signhpmh(il) = sign(1., hp(il,i)-h(il,i))
         sbef(il) = max(0., signhpmh(il))
+        Sbef(il) = max(0., signhpmh(il))
       END IF
     END DO
 …
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. j<=inb(il)) THEN
           IF (sbef(il)<sij(il,i,j)) THEN
             sx(il) = max(sij(il,i,j), sx(il))
           END IF
           sbef(il) = sij(il, i, j)
+          IF (Sbef(il)<Sij(il,i,j)) THEN
+            Sx(il) = max(Sij(il,i,j), Sx(il))
+          END IF
+          Sbef(il) = Sij(il, i, j)
         END IF
       END DO
 …
       IF (i>=icb(il) .AND. i<=inb(il)) THEN
         lwork(il) = (nent(il,i)/=0)
         qp = qnk(il) - ep(il, i)*clw(il, i)
         anum = h(il, i) - hp(il, i) - lv(il, i)*(qp-rs(il,i)) + &
           (cpv-cpd)*t(il, i)*(qp-rr(il,i))
         denom = h(il, i) - hp(il, i) + lv(il, i)*(rr(il,i)-qp) + &
           (cpd-cpv)*t(il, i)*(rr(il,i)-qp)
+        rti = qnk(il) - ep(il, i)*clw(il, i)
+        anum = h(il, i) - hp(il, i) - lv(il, i)*(rti-rs(il,i)) + &
+               (cpv-cpd)*t(il, i)*(rti-rr(il,i))
+        denom = h(il, i) - hp(il, i) + lv(il, i)*(rr(il,i)-rti) + &
+                (cpd-cpv)*t(il, i)*(rr(il,i)-rti)
         IF (abs(denom)<0.01) denom = 0.01
         scrit(il) = min(anum/denom, 1.)
         alt = qp - rs(il, i) + scrit(il)*(rr(il,i)-qp)
         ! jyg1    Find new critical value Scrit2
         ! such that : Sij > Scrit2  => mixed draught will detrain at J<I
         ! Sij < Scrit2  => mixed draught will detrain at J>I
         scrit2 = min(scrit(il), sx(il))*max(0., -signhpmh(il)) + &
           scrit(il)*max(0., signhpmh(il))
         scrit(il) = scrit2
         ! jyg    Correction pour la nouvelle logique; la correction pour ALT
         ! est un peu au hazard
         IF (scrit(il)<=0.0) scrit(il) = 0.0
         IF (alt<=0.0) scrit(il) = 1.0
+        Scrit(il) = min(anum/denom, 1.)
+        alt = rti - rs(il, i) + Scrit(il)*(rr(il,i)-rti)
+!JYG1    Find new critical value Scrit2
+!         such that : Sij > Scrit2  => mixed draught will detrain at J<I
+!                     Sij < Scrit2  => mixed draught will detrain at J>I
+        Scrit2 = min(Scrit(il), Sx(il))*max(0., -signhpmh(il)) + &
+                 Scrit(il)*max(0., signhpmh(il))
+        Scrit(il) = Scrit2
+!JYG    Correction pour la nouvelle logique; la correction pour ALT
+! est un peu au hazard
+        IF (Scrit(il)<=0.0) Scrit(il) = 0.0
+        IF (alt<=0.0) Scrit(il) = 1.0
         smax(il) = 0.0
         asij(il) = 0.0
         sup(il) = 0. ! upper S-value reached by descending draughts
       END IF
     END DO
     ! ---------------------------------------------------------------
     DO j = minorig, nl !Loop on destination level "j"
       ! ---------------------------------------------------------------
+        ASij(il) = 0.0
+        sup(il) = 0.      ! upper S-value reached by descending draughts
+      END IF
+    END DO
+! ---------------------------------------------------------------
+    DO j = minorig, nl         !Loop on destination level "j"
+! ---------------------------------------------------------------
       num2 = 0
       DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
+          il)-1) .AND. j<=inb(il) .AND. lwork(il)) num2 = num2 + 1
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
+            lwork(il)) num2 = num2 + 1
       END DO
       IF (num2<=0) GO TO 175
       ! -----------------------------------------------
+! -----------------------------------------------
       IF (j>i) THEN
         ! -----------------------------------------------
+! -----------------------------------------------
         DO il = 1, ncum
           IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
               il)-1) .AND. j<=inb(il) .AND. lwork(il)) THEN
             IF (sij(il,i,j)>0.0) THEN
               smid(il) = min(sij(il,i,j), scrit(il))
               sjmax(il) = smid(il)
               sjmin(il) = smid(il)
               IF (smid(il)<smin(il) .AND. sij(il,i,j+1)<smid(il)) THEN
                 smin(il) = smid(il)
                 sjmax(il) = min((sij(il,i,j+1)+sij(il,i, &
                   j))/2., sij(il,i,j), scrit(il))
                 sjmin(il) = max((sbef(il)+sij(il,i,j))/2., sij(il,i,j))
                 sjmin(il) = min(sjmin(il), scrit(il))
                 sbef(il) = sij(il, i, j)
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. &
+              j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
+              lwork(il)) THEN
+            IF (Sij(il,i,j)>0.0) THEN
+              Smid(il) = min(Sij(il,i,j), Scrit(il))
+              Sjmax(il) = Smid(il)
+              Sjmin(il) = Smid(il)
+              IF (Smid(il)<smin(il) .AND. Sij(il,i,j+1)<Smid(il)) THEN
+                smin(il) = Smid(il)
+                Sjmax(il) = min((Sij(il,i,j+1)+Sij(il,i,j))/2., Sij(il,i,j), Scrit(il))
+                Sjmin(il) = max((Sbef(il)+Sij(il,i,j))/2., Sij(il,i,j))
+                Sjmin(il) = min(Sjmin(il), Scrit(il))
+                Sbef(il) = Sij(il, i, j)
               END IF
             END IF
           END IF
         END DO
         ! -----------------------------------------------
+! -----------------------------------------------
       ELSE IF (j==i) THEN
         ! -----------------------------------------------
+! -----------------------------------------------
         DO il = 1, ncum
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
+              il)-1) .AND. j<=inb(il) .AND. lwork(il)) THEN
+            IF (sij(il,i,j)>0.0) THEN
+              smid(il) = 1.
+              sjmin(il) = max((sij(il,i,j-1)+smid(il))/2., scrit(il))*max(0., &
+                -signhpmh(il)) + min((sij(il,i,j+1)+smid(il))/2., scrit(il))* &
+                max(0., signhpmh(il))
+              sjmin(il) = max(sjmin(il), sup(il))
+              sjmax(il) = 1.
+              ! -           preparation des variables Scrit, Smin et Sbef
+              ! pour la partie j>i
+              scrit(il) = min(sjmin(il), sjmax(il), scrit(il))
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. &
+              j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
+              lwork(il)) THEN
+            IF (Sij(il,i,j)>0.0) THEN
+              Smid(il) = 1.
+              Sjmin(il) = max((Sij(il,i,j-1)+Smid(il))/2., Scrit(il))*max(0., -signhpmh(il)) + &
+                          min((Sij(il,i,j+1)+Smid(il))/2., Scrit(il))*max(0., signhpmh(il))
+              Sjmin(il) = max(Sjmin(il), sup(il))
+              Sjmax(il) = 1.
+! -             preparation des variables Scrit, Smin et Sbef pour la partie j>i
+              Scrit(il) = min(Sjmin(il), Sjmax(il), Scrit(il))
               smin(il) = 1.
               sbef(il) = max(0., signhpmh(il))
               supmax(il, i) = sign(scrit(il), -signhpmh(il))
             END IF
           END IF
         END DO
         ! -----------------------------------------------
+              Sbef(il) = max(0., signhpmh(il))
+              supmax(il, i) = sign(Scrit(il), -signhpmh(il))
+            END IF
+          END IF
+        END DO
+! -----------------------------------------------
       ELSE IF (j<i) THEN
         ! -----------------------------------------------
+! -----------------------------------------------
         DO il = 1, ncum
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
+              il)-1) .AND. j<=inb(il) .AND. lwork(il)) THEN
+            IF (sij(il,i,j)>0.0) THEN
+              smid(il) = max(sij(il,i,j), scrit(il))
+              sjmax(il) = smid(il)
+              sjmin(il) = smid(il)
+              IF (smid(il)>smax(il) .AND. sij(il,i,j+1)>smid(il)) THEN
+                smax(il) = smid(il)
+                sjmax(il) = max((sij(il,i,j+1)+sij(il,i,j))/2., sij(il,i,j))
+                sjmax(il) = max(sjmax(il), scrit(il))
+                sjmin(il) = min((sbef(il)+sij(il,i,j))/2., sij(il,i,j))
+                sjmin(il) = max(sjmin(il), scrit(il))
+                sbef(il) = sij(il, i, j)
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. &
+              j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
+              lwork(il)) THEN
+            IF (Sij(il,i,j)>0.0) THEN
+              Smid(il) = max(Sij(il,i,j), Scrit(il))
+              Sjmax(il) = Smid(il)
+              Sjmin(il) = Smid(il)
+              IF (Smid(il)>smax(il) .AND. Sij(il,i,j+1)>Smid(il)) THEN
+                smax(il) = Smid(il)
+                Sjmax(il) = max((Sij(il,i,j+1)+Sij(il,i,j))/2., Sij(il,i,j))
+                Sjmax(il) = max(Sjmax(il), Scrit(il))
+                Sjmin(il) = min((Sbef(il)+Sij(il,i,j))/2., Sij(il,i,j))
+                Sjmin(il) = max(Sjmin(il), Scrit(il))
+                Sbef(il) = Sij(il, i, j)
               END IF
+              IF (abs(sjmin(il)-sjmax(il))>1.E-10) sup(il) = max(sjmin(il), &
+                sjmax(il), sup(il))
+            END IF
+          END IF
+        END DO
+        ! -----------------------------------------------
+      END IF
+      ! -----------------------------------------------
+      DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
+            il)-1) .AND. j<=inb(il) .AND. lwork(il)) THEN
+          IF (sij(il,i,j)>0.0) THEN
+              IF (abs(Sjmin(il)-Sjmax(il))>1.E-10) &
+                             sup(il) = max(Sjmin(il), Sjmax(il), sup(il))
+            END IF
+          END IF
+        END DO
+! -----------------------------------------------
+      END IF
+! -----------------------------------------------
+      DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
+            lwork(il)) THEN
+          IF (Sij(il,i,j)>0.0) THEN
             rti = qnk(il) - ep(il, i)*clw(il, i)
+            qmixmax(il) = qmix(sjmax(il))
+            qmixmin(il) = qmix(sjmin(il))
+            rmixmax(il) = rmix(sjmax(il))
+            rmixmin(il) = rmix(sjmin(il))
+            sqmrmax(il) = sjmax(il)*qmix(sjmax(il)) - rmix(sjmax(il))
+            sqmrmin(il) = sjmin(il)*qmix(sjmin(il)) - rmix(sjmin(il))
+            ment(il, i, j) = abs(qmixmax(il)-qmixmin(il))*ment(il, i, j)
+            ! Sigij(i,j) is the 'true' mixing fraction of mixture Ment(i,j)
+            IF (abs(qmixmax(il)-qmixmin(il))>1.E-10) THEN
+              sigij(il, i, j) = (sqmrmax(il)-sqmrmin(il))/ &
+                (qmixmax(il)-qmixmin(il))
+            Qmixmax(il) = Qmix(Sjmax(il))
+            Qmixmin(il) = Qmix(Sjmin(il))
+            Rmixmax(il) = Rmix(Sjmax(il))
+            Rmixmin(il) = Rmix(Sjmin(il))
+            sqmrmax(il) = Sjmax(il)*Qmix(Sjmax(il)) - Rmix(Sjmax(il))
+            sqmrmin(il) = Sjmin(il)*Qmix(Sjmin(il)) - Rmix(Sjmin(il))
+            Ment(il, i, j) = abs(Qmixmax(il)-Qmixmin(il))*Ment(il, i, j)
+! Sigij(i,j) is the 'true' mixing fraction of mixture Ment(i,j)
+            IF (abs(Qmixmax(il)-Qmixmin(il))>1.E-10) THEN
+              Sigij(il, i, j) = (sqmrmax(il)-sqmrmin(il))/(Qmixmax(il)-Qmixmin(il))
             ELSE
+              sigij(il, i, j) = 0.
+            END IF
+            ! --    Compute Qent, uent, vent according to the true mixing
+            ! fraction
+            qent(il, i, j) = (1.-sigij(il,i,j))*rti + &
+              sigij(il, i, j)*rr(il, i)
+            uent(il, i, j) = (1.-sigij(il,i,j))*unk(il) + &
+              sigij(il, i, j)*u(il, i)
+            vent(il, i, j) = (1.-sigij(il,i,j))*vnk(il) + &
+              sigij(il, i, j)*v(il, i)
+            ! --     Compute liquid water static energy of mixed draughts
+            ! IF (j .GT. i) THEN
+            ! awat=elij(il,i,j)-(1.-ep(il,j))*clw(il,j)
+            ! awat=amax1(awat,0.0)
+            ! ELSE
+            ! awat = 0.
+            ! ENDIF
+            ! Hent(il,i,j) = (1.-Sigij(il,i,j))*HP(il,i)
+            ! :         + Sigij(il,i,j)*H(il,i)
+            ! :         + (LV(il,j)+(cpd-cpv)*t(il,j))*awat
+            ! IM 301008 beg
+            hent(il, i, j) = (1.-sigij(il,i,j))*hp(il, i) + &
+              sigij(il, i, j)*h(il, i)
+            elij(il, i, j) = qent(il, i, j) - rs(il, j)
+            elij(il, i, j) = elij(il, i, j) + ((h(il,j)-hent(il,i, &
+              j))*rs(il,j)*lv(il,j)/((cpd*(1.-qent(il,i,j))+ &
+              qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
+            elij(il, i, j) = elij(il, i, j)/(1.+lv(il,j)*lv(il,j)*rs(il,j)/(( &
+              cpd*(1.-qent(il,i,j))+qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
+              Sigij(il, i, j) = 0.
+            END IF
+! --    Compute Qent, uent, vent according to the true mixing fraction
+            Qent(il, i, j) = (1.-Sigij(il,i,j))*rti     + Sigij(il, i, j)*rr(il, i)
+            uent(il, i, j) = (1.-Sigij(il,i,j))*unk(il) + Sigij(il, i, j)*u(il, i)
+            vent(il, i, j) = (1.-Sigij(il,i,j))*vnk(il) + Sigij(il, i, j)*v(il, i)
+! --     Compute liquid water static energy of mixed draughts
+!    IF (j .GT. i) THEN
+!      awat=elij(il,i,j)-(1.-ep(il,j))*clw(il,j)
+!      awat=amax1(awat,0.0)
+!    ELSE
+!      awat = 0.
+!    ENDIF
+!    Hent(il,i,j) = (1.-Sigij(il,i,j))*HP(il,i)
+!    :         + Sigij(il,i,j)*H(il,i)
+!    :         + (LV(il,j)+(cpd-cpv)*t(il,j))*awat
+!IM 301008 beg
+            hent(il, i, j) = (1.-Sigij(il,i,j))*hp(il, i) + Sigij(il, i, j)*h(il, i)
+            elij(il, i, j) = Qent(il, i, j) - rs(il, j)
+            elij(il, i, j) = elij(il, i, j) + &
+                             ((h(il,j)-hent(il,i,j))*rs(il,j)*lv(il,j) / &
+                              ((cpd*(1.-Qent(il,i,j))+Qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
+            elij(il, i, j) = elij(il, i, j) / &
+                             (1.+lv(il,j)*lv(il,j)*rs(il,j) / &
+                              ((cpd*(1.-Qent(il,i,j))+Qent(il,i,j)*cpv)*rrv*t(il,j)*t(il,j)))
             elij(il, i, j) = max(elij(il,i,j), 0.)
             elij(il, i, j) = min(elij(il,i,j), qent(il,i,j))
+            elij(il, i, j) = min(elij(il,i,j), Qent(il,i,j))
             IF (j>i) THEN
 …
             END IF
+            ! print
+            ! *,h(il,j)-hent(il,i,j),LV(il,j)*rs(il,j)/(cpd*rrv*t(il,j)*
+            ! :         t(il,j))
+            hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)*t(il,j))* &
+              awat
+            ! IM 301008 end
+            ! print *,'mix : i,j,hent(il,i,j),sigij(il,i,j) ',
+            ! :               i,j,hent(il,i,j),sigij(il,i,j)
+            ! --      ASij is the integral of P(F) over the relevant F
+            ! interval
+            asij(il) = asij(il) + abs(qmixmax(il)*(1.-sjmax(il))+rmixmax(il)- &
+              qmixmin(il)*(1.-sjmin(il))-rmixmin(il))
+! print *,h(il,j)-hent(il,i,j),LV(il,j)*rs(il,j)/(cpd*rrv*t(il,j)*
+! :         t(il,j))
+            hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)*t(il,j))*awat
+!IM 301008 end
+! print *,'mix : i,j,hent(il,i,j),Sigij(il,i,j) ',
+! :               i,j,hent(il,i,j),Sigij(il,i,j)
+! --      ASij is the integral of P(F) over the relevant F interval
+            ASij(il) = ASij(il) + abs(Qmixmax(il)*(1.-Sjmax(il))+Rmixmax(il) - &
+                                      Qmixmin(il)*(1.-Sjmin(il))-Rmixmin(il))
           END IF
 …
       DO k = 1, ntra
         DO il = 1, ncum
           IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)- &
 )) .AND. (j<=inb(il)) .AND. lwork(il)) THEN
             IF (sij(il,i,j)>0.0) THEN
               traent(il, i, j, k) = sigij(il, i, j)*tra(il, i, k) + &
                 (1.-sigij(il,i,j))*tra(il, nk(il), k)
             END IF
           END IF
         END DO
       END DO
+      ! --    If I=J (detrainement and entrainement at the same level), then
       ! only the
       ! --    adiabatic ascent part of the mixture is considered
+          IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. &
+              (j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
+              lwork(il)) THEN
+            IF (Sij(il,i,j)>0.0) THEN
+              traent(il, i, j, k) = Sigij(il, i, j)*tra(il, i, k) + &
+                                    (1.-Sigij(il,i,j))*tra(il, nk(il), k)
+            END IF
+          END IF
+        END DO
+      END DO
+! --    If I=J (detrainement and entrainement at the same level), then only the
+! --    adiabatic ascent part of the mixture is considered
       IF (i==j) THEN
         DO il = 1, ncum
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. j>=(icb( &
+              il)-1) .AND. j<=inb(il) .AND. lwork(il)) THEN
+            IF (sij(il,i,j)>0.0) THEN
+          IF (i>=icb(il) .AND. i<=inb(il) .AND. &
+              j>=(icb(il)-1) .AND. j<=inb(il) .AND. &
+              lwork(il)) THEN
+            IF (Sij(il,i,j)>0.0) THEN
               rti = qnk(il) - ep(il, i)*clw(il, i)
+              ! cc          Ment(il,i,i) =
+              ! m(il,i)*abs(Qmixmax(il)*(1.-Sjmax(il))
+              ment(il, i, i) = abs(qmixmax(il)*(1.-sjmax( &
+                il))+rmixmax(il)-qmixmin(il)*(1.-sjmin(il))-rmixmin(il))
+              qent(il, i, i) = rti
+!!!             Ment(il,i,i) = m(il,i)*abs(Qmixmax(il)*(1.-Sjmax(il))
+              Ment(il, i, i) = abs(Qmixmax(il)*(1.-Sjmax(il))+Rmixmax(il) - &
+                                   Qmixmin(il)*(1.-Sjmin(il))-Rmixmin(il))
+              Qent(il, i, i) = rti
               uent(il, i, i) = unk(il)
               vent(il, i, i) = vnk(il)
               hent(il, i, i) = hp(il, i)
               elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
               sigij(il, i, i) = 0.
+              Sigij(il, i, i) = 0.
             END IF
           END IF
 …
         DO k = 1, ntra
           DO il = 1, ncum
+            IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)- &
+)) .AND. (j<=inb(il)) .AND. lwork(il)) THEN
+              IF (sij(il,i,j)>0.0) THEN
+            IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. &
+                (j>=(icb(il)-1)) .AND. (j<=inb(il)) .AND. &
+                lwork(il)) THEN
+              IF (Sij(il,i,j)>0.0) THEN
                 traent(il, i, i, k) = tra(il, nk(il), k)
               END IF
 …
       END IF
+END DO
+! ---------------------------------------------------------------
+END DO        ! End loop on destination level "j"
+! ---------------------------------------------------------------
     DO il = 1, ncum
       IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il)) THEN
         asij(il) = amax1(1.0E-16, asij(il))
         asij(il) = 1.0/asij(il)
+        ASij(il) = amax1(1.0E-16, ASij(il))
+        ASij(il) = 1.0/ASij(il)
         csum(il, i) = 0.0
       END IF
 …
     DO j = minorig, nl
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
             il)-1) .AND. j<=inb(il)) THEN
           ment(il, i, j) = ment(il, i, j)*asij(il)
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
+          Ment(il, i, j) = Ment(il, i, j)*ASij(il)
         END IF
       END DO
 …
     DO j = minorig, nl
       DO il = 1, ncum
         IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. j>=(icb( &
             il)-1) .AND. j<=inb(il)) THEN
           csum(il, i) = csum(il, i) + ment(il, i, j)
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. &
+            j>=(icb(il)-1) .AND. j<=inb(il)) THEN
+          csum(il, i) = csum(il, i) + Ment(il, i, j)
         END IF
       END DO
 …
     DO il = 1, ncum
+      IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) &
+          THEN
+        ! cc     :     .and. csum(il,i).lt.m(il,i) ) then
+      IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
+! cc     :     .and. csum(il,i).lt.m(il,i) ) then
         nent(il, i) = 0
         ! cc        ment(il,i,i)=m(il,i)
         ment(il, i, i) = 1.
         qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
+! cc        Ment(il,i,i)=m(il,i)
+        Ment(il, i, i) = 1.
+        Qent(il, i, i) = qnk(il) - ep(il, i)*clw(il, i)
         uent(il, i, i) = unk(il)
         vent(il, i, i) = vnk(il)
         elij(il, i, i) = clw(il, i)*(1.-ep(il,i))
         sij(il, i, i) = 0.0
+        Sij(il, i, i) = 0.0
       END IF
     END DO ! il
 …
     DO j = 1, ntra
       DO il = 1, ncum
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) &
+            THEN
+          ! cc     :     .and. csum(il,i).lt.m(il,i) ) then
+        IF (i>=icb(il) .AND. i<=inb(il) .AND. lwork(il) .AND. csum(il,i)<1.) THEN
+! cc     :     .and. csum(il,i).lt.m(il,i) ) then
           traent(il, i, i, j) = tra(il, nk(il), j)
         END IF
 …
     END DO
+END DO
+! ---------------------------------------------------------------
+END DO              ! End loop on origin level "i"
+! ---------------------------------------------------------------
   RETURN

LMDZ5/branches/testing/libf/phylmd/cva_driver.F90

-                      r1999
+                      r2056
 ! $Id$
+SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, iflag_con, iflag_mix, &
+    iflag_ice_thermo, iflag_clos, delt, t1, q1, qs1, t1_wake, q1_wake, &
+    qs1_wake, s1_wake, u1, v1, tra1, p1, ph1, ale1, alp1, sig1feed1, &
+    sig2feed1, wght1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, kbas1, &
+    ktop1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, & !input/output
+    ptop21, sigd1, ma1, mip1, vprecip1, upwd1, dnwd1, dnwd01, qcondc1, wd1, &
+    cape1, cin1, tvp1, ftd1, fqd1, plim11, plim21, asupmax1, supmax01, &
+    asupmaxmin1, lalim_conv, da1, phi1, mp1, phi21, d1a1, dam1, sigij1, clw1, & ! RomP
+    elij1, evap1, ep1, epmlmmm1, eplamm1, & ! RomP
+    wdtraina1, wdtrainm1) ! RomP
+  ! **************************************************************
+  ! *
+  ! CV_DRIVER                                                   *
+  ! *
+  ! *
+  ! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41    *
+  ! modified by :                                               *
+  ! **************************************************************
+  ! **************************************************************
+SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, &
+                      iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
+                      delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
+                      u1, v1, tra1, &
+                      p1, ph1, &
+                      Ale1, Alp1, &
+                      sig1feed1, sig2feed1, wght1, &
+                      iflag1, ft1, fq1, fu1, fv1, ftra1, &
+                      precip1, kbas1, ktop1, &
+                      cbmf1, plcl1, plfc1, wbeff1, &
+                      sig1, w01, & !input/output
+                      ptop21, sigd1, &
+                      ma1, mip1, Vprecip1, upwd1, dnwd1, dnwd01, &
+                      qcondc1, wd1, &
+                      cape1, cin1, tvp1, &
+                      ftd1, fqd1, &
+                      Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
+                      lalim_conv, &
+!!                      da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, &        ! RomP
+!!                      elij1,evap1,ep1,epmlmMm1,eplaMm1, &                ! RomP
+                      da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
+                      clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &        ! RomP, RL
+                      wdtrainA1, wdtrainM1)                                ! RomP
+! **************************************************************
+! *
+! CV_DRIVER                                                   *
+! *
+! *
+! written by   : Sandrine Bony-Lena , 17/05/2003, 11.19.41    *
+! modified by :                                               *
+! **************************************************************
+! **************************************************************
   USE dimphy
   IMPLICIT NONE
+  ! .............................START PROLOGUE............................
+  ! All argument names (except len,nd,ntra,nloc,delt and the flags) have a
+  ! "1" appended.
+  ! The "1" is removed for the corresponding compressed variables.
+  ! PARAMETERS:
+  ! Name            Type         Usage            Description
+  ! ----------      ----------     -------  ----------------------------
+  ! len           Integer        Input        first (i) dimension
+  ! nd            Integer        Input        vertical (k) dimension
+  ! ndp1          Integer        Input        nd + 1
+  ! ntra          Integer        Input        number of tracors
+  ! iflag_con     Integer        Input        version of convect (3/4)
+  ! iflag_mix     Integer        Input        version of mixing  (0/1/2)
+  ! iflag_ice_thermo Integer        Input        accounting for ice
+  ! thermodynamics (0/1)
+  ! iflag_clos    Integer        Input        version of closure (0/1)
+  ! delt          Real           Input        time step
+  ! t1            Real           Input        temperature (sat draught envt)
+  ! q1            Real           Input        specific hum (sat draught envt)
+  ! qs1           Real           Input        sat specific hum (sat draught
+  ! envt)
+  ! t1_wake       Real           Input        temperature (unsat draught
+  ! envt)
+  ! q1_wake       Real           Input        specific hum(unsat draught
+  ! envt)
+  ! qs1_wake      Real           Input        sat specific hum(unsat draughts
+  ! envt)
+  ! s1_wake       Real           Input        fractionnal area covered by
+  ! wakes
+  ! u1            Real           Input        u-wind
+  ! v1            Real           Input        v-wind
+  ! tra1          Real           Input        tracors
+  ! p1            Real           Input        full level pressure
+  ! ph1           Real           Input        half level pressure
+  ! ALE1          Real           Input        Available lifting Energy
+  ! ALP1          Real           Input        Available lifting Power
+  ! sig1feed1     Real           Input        sigma coord at lower bound of
+  ! feeding layer
+  ! sig2feed1     Real           Input        sigma coord at upper bound of
+  ! feeding layer
+  ! wght1         Real           Input        weight density determining the
+  ! feeding mixture
+  ! iflag1        Integer        Output       flag for Emanuel conditions
+  ! ft1           Real           Output       temp tend
+  ! fq1           Real           Output       spec hum tend
+  ! fu1           Real           Output       u-wind tend
+  ! fv1           Real           Output       v-wind tend
+  ! ftra1         Real           Output       tracor tend
+  ! precip1       Real           Output       precipitation
+  ! kbas1         Integer        Output       cloud base level
+  ! ktop1         Integer        Output       cloud top level
+  ! cbmf1         Real           Output       cloud base mass flux
+  ! sig1          Real           In/Out       section adiabatic updraft
+  ! w01           Real           In/Out       vertical velocity within adiab
+  ! updraft
+  ! ptop21        Real           In/Out       top of entraining zone
+  ! Ma1           Real           Output       mass flux adiabatic updraft
+  ! mip1          Real           Output       mass flux shed by the adiabatic
+  ! updraft
+  ! Vprecip1      Real           Output       vertical profile of
+  ! precipitations
+  ! upwd1         Real           Output       total upward mass flux
+  ! (adiab+mixed)
+  ! dnwd1         Real           Output       saturated downward mass flux
+  ! (mixed)
+  ! dnwd01        Real           Output       unsaturated downward mass flux
+  ! qcondc1       Real           Output       in-cld mixing ratio of
+  ! condensed water
+  ! wd1           Real           Output       downdraft velocity scale for
+  ! sfc fluxes
+  ! cape1         Real           Output       CAPE
+  ! cin1          Real           Output       CIN
+  ! tvp1          Real           Output       adiab lifted parcell virt temp
+  ! ftd1          Real           Output       precip temp tend
+  ! fqt1          Real           Output       precip spec hum tend
+  ! Plim11        Real           Output
+  ! Plim21        Real           Output
+  ! asupmax1      Real           Output
+  ! supmax01      Real           Output
+  ! asupmaxmin1   Real           Output
+  ! ftd1          Real           Output  Array of temperature tendency due to
+  ! precipitations (K/s) of dimension ND,
+  ! defined at same grid levels as T, Q, QS and P.
+  ! fqd1          Real           Output  Array of specific humidity
+  ! tendencies due to precipitations ((gm/gm)/s)
+  ! of dimension ND, defined at same grid levels as T, Q, QS and P.
+  ! wdtrainA1     Real           Output   precipitation detrained from
+  ! adiabatic draught;
+  ! used in tracer transport (cvltr)
+  ! wdtrainM1     Real           Output   precipitation detrained from mixed
+  ! draughts;
+  ! used in tracer transport (cvltr)
+  ! da1           Real           Output   used in tracer transport (cvltr)
+  ! phi1          Real           Output   used in tracer transport (cvltr)
+  ! mp1           Real           Output   used in tracer transport (cvltr)
+  ! phi21         Real           Output   used in tracer transport (cvltr)
+  ! d1a1          Real           Output   used in tracer transport (cvltr)
+  ! dam1          Real           Output   used in tracer transport (cvltr)
+  ! epmlmMm1      Real           Output   used in tracer transport (cvltr)
+  ! eplaMm1       Real           Output   used in tracer transport (cvltr)
+  ! evap1         Real           Output
+  ! ep1           Real           Output
+  ! sigij1        Real           Output
+  ! elij1         Real           Output
+  ! S. Bony, Mar 2002:
+  ! * Several modules corresponding to different physical processes
+  ! * Several versions of convect may be used:
+  ! - iflag_con=3: version lmd  (previously named convect3)
+  ! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
+  ! + tard:     - iflag_con=5: version lmd with ice (previously named convectg)
+  ! S. Bony, Oct 2002:
+  ! * Vectorization of convect3 (ie version lmd)
+  ! ..............................END PROLOGUE.............................
+! .............................START PROLOGUE............................
+! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
+! The "1" is removed for the corresponding compressed variables.
+! PARAMETERS:
+! Name            Type         Usage            Description
+! ----------      ----------     -------  ----------------------------
+! len           Integer        Input        first (i) dimension
+! nd            Integer        Input        vertical (k) dimension
+! ndp1          Integer        Input        nd + 1
+! ntra          Integer        Input        number of tracors
+! iflag_con     Integer        Input        version of convect (3/4)
+! iflag_mix     Integer        Input        version of mixing  (0/1/2)
+! iflag_ice_thermo Integer        Input        accounting for ice thermodynamics (0/1)
+! iflag_clos    Integer        Input        version of closure (0/1)
+! ok_conserv_q  Logical        Input        when true corrections for water conservation are swtiched on
+! delt          Real           Input        time step
+! t1            Real           Input        temperature (sat draught envt)
+! q1            Real           Input        specific hum (sat draught envt)
+! qs1           Real           Input        sat specific hum (sat draught envt)
+! t1_wake       Real           Input        temperature (unsat draught envt)
+! q1_wake       Real           Input        specific hum(unsat draught envt)
+! qs1_wake      Real           Input        sat specific hum(unsat draughts envt)
+! s1_wake       Real           Input        fractionnal area covered by wakes
+! u1            Real           Input        u-wind
+! v1            Real           Input        v-wind
+! tra1          Real           Input        tracors
+! p1            Real           Input        full level pressure
+! ph1           Real           Input        half level pressure
+! ALE1          Real           Input        Available lifting Energy
+! ALP1          Real           Input        Available lifting Power
+! sig1feed1     Real           Input        sigma coord at lower bound of feeding layer
+! sig2feed1     Real           Input        sigma coord at upper bound of feeding layer
+! wght1         Real           Input        weight density determining the feeding mixture
+! iflag1        Integer        Output       flag for Emanuel conditions
+! ft1           Real           Output       temp tend
+! fq1           Real           Output       spec hum tend
+! fu1           Real           Output       u-wind tend
+! fv1           Real           Output       v-wind tend
+! ftra1         Real           Output       tracor tend
+! precip1       Real           Output       precipitation
+! kbas1         Integer        Output       cloud base level
+! ktop1         Integer        Output       cloud top level
+! cbmf1         Real           Output       cloud base mass flux
+! sig1          Real           In/Out       section adiabatic updraft
+! w01           Real           In/Out       vertical velocity within adiab updraft
+! ptop21        Real           In/Out       top of entraining zone
+! Ma1           Real           Output       mass flux adiabatic updraft
+! mip1          Real           Output       mass flux shed by the adiabatic updraft
+! Vprecip1      Real           Output       vertical profile of precipitations
+! upwd1         Real           Output       total upward mass flux (adiab+mixed)
+! dnwd1         Real           Output       saturated downward mass flux (mixed)
+! dnwd01        Real           Output       unsaturated downward mass flux
+! qcondc1       Real           Output       in-cld mixing ratio of condensed water
+! wd1           Real           Output       downdraft velocity scale for sfc fluxes
+! cape1         Real           Output       CAPE
+! cin1          Real           Output       CIN
+! tvp1          Real           Output       adiab lifted parcell virt temp
+! ftd1          Real           Output       precip temp tend
+! fqt1          Real           Output       precip spec hum tend
+! Plim11        Real           Output
+! Plim21        Real           Output
+! asupmax1      Real           Output
+! supmax01      Real           Output
+! asupmaxmin1   Real           Output
+! ftd1          Real           Output  Array of temperature tendency due to precipitations (K/s) of dimension ND,
+!                                      defined at same grid levels as T, Q, QS and P.
+! fqd1          Real           Output  Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
+!                                      of dimension ND, defined at same grid levels as T, Q, QS and P.
+! wdtrainA1     Real           Output   precipitation detrained from adiabatic draught;
+!                                         used in tracer transport (cvltr)
+! wdtrainM1     Real           Output   precipitation detrained from mixed draughts;
+!                                         used in tracer transport (cvltr)
+! da1           Real           Output     used in tracer transport (cvltr)
+! phi1          Real           Output     used in tracer transport (cvltr)
+! mp1           Real           Output     used in tracer transport (cvltr)
+! phi21         Real           Output     used in tracer transport (cvltr)
+! d1a1          Real           Output     used in tracer transport (cvltr)
+! dam1          Real           Output     used in tracer transport (cvltr)
+! epmlmMm1      Real           Output     used in tracer transport (cvltr)
+! eplaMm1       Real           Output     used in tracer transport (cvltr)
+! evap1         Real           Output
+! ep1           Real           Output
+! sigij1        Real           Output     used in tracer transport (cvltr)
+! elij1         Real           Output
+! wghti1        Real           Output   final weight of the feeding layers,
+!                                         used in tracer transport (cvltr)
+! S. Bony, Mar 2002:
+! * Several modules corresponding to different physical processes
+! * Several versions of convect may be used:
+!         - iflag_con=3: version lmd  (previously named convect3)
+!         - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
+! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
+! S. Bony, Oct 2002:
+! * Vectorization of convect3 (ie version lmd)
+! ..............................END PROLOGUE.............................
   include "dimensions.h"
   ! cccc#include "dimphy.h"
+!!!!!#include "dimphy.h"
   include 'iniprint.h'
   ! Input
+! Input
   INTEGER len
   INTEGER nd
 …
   INTEGER iflag_ice_thermo
   INTEGER iflag_clos
+  LOGICAL ok_conserv_q
   REAL delt
   REAL t1(len, nd)
 …
   REAL p1(len, nd)
   REAL ph1(len, ndp1)
   REAL ale1(len)
   REAL alp1(len)
+  REAL Ale1(len)
+  REAL Alp1(len)
   REAL sig1feed1 ! pressure at lower bound of feeding layer
   REAL sig2feed1 ! pressure at upper bound of feeding layer
   REAL wght1(nd) ! weight density determining the feeding mixture
   ! Output
+! Output
   INTEGER iflag1(len)
   REAL ft1(len, nd)
 …
   REAL ma1(len, nd)
   REAL mip1(len, nd)
   ! real Vprecip1(len,nd)
+! real Vprecip1(len,nd)
   REAL vprecip1(len, nd+1)
   REAL upwd1(len, nd)
 …
   REAL tvp1(len, nd)
   ! AC!
   ! !      real da1(len,nd),phi1(len,nd,nd)
   ! !      real da(len,nd),phi(len,nd,nd)
   ! AC!
+!AC!
+!!      real da1(len,nd),phi1(len,nd,nd)
+!!      real da(len,nd),phi(len,nd,nd)
+!AC!
   REAL ftd1(len, nd)
   REAL fqd1(len, nd)
   REAL plim11(len)
   REAL plim21(len)
+  REAL Plim11(len)
+  REAL Plim21(len)
   REAL asupmax1(len, nd)
   REAL supmax01(len)
   REAL asupmaxmin1(len)
   INTEGER lalim_conv(len)
   ! RomP >>>
   REAL wdtraina1(len, nd), wdtrainm1(len, nd)
+! RomP >>>
+  REAL wdtrainA1(len, nd), wdtrainM1(len, nd)
   REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
   REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
+  REAL epmlmMm1(len, nd, nd), eplaMm1(len, nd)
   REAL evap1(len, nd), ep1(len, nd)
   REAL sigij1(len, nd, nd), elij1(len, nd, nd)
+!JYG,RL
+  REAL wghti1(len, nd) ! final weight of the feeding layers
+!JYG,RL
   REAL phi21(len, nd, nd)
   REAL d1a1(len, nd), dam1(len, nd)
+  ! RomP <<<
+  ! -------------------------------------------------------------------
+  ! Prolog by Kerry Emanuel.
+  ! -------------------------------------------------------------------
+  ! --- ARGUMENTS
+  ! -------------------------------------------------------------------
+  ! --- On input:
+  ! t:   Array of absolute temperature (K) of dimension ND, with first
+  ! index corresponding to lowest model level. Note that this array
+  ! will be altered by the subroutine if dry convective adjustment
+  ! occurs and if IPBL is not equal to 0.
+  ! q:   Array of specific humidity (gm/gm) of dimension ND, with first
+  ! index corresponding to lowest model level. Must be defined
+  ! at same grid levels as T. Note that this array will be altered
+  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
+  ! qs:  Array of saturation specific humidity of dimension ND, with first
+  ! index corresponding to lowest model level. Must be defined
+  ! at same grid levels as T. Note that this array will be altered
+  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
+  ! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
+  ! of dimension ND, with first index corresponding to lowest model level.
+  ! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
+  ! of dimension ND, with first index corresponding to lowest model level.
+  ! Must be defined at same grid levels as T.
+  ! qs_wake: Array of saturation specific humidity, seen by unsaturated
+  ! draughts,
+  ! of dimension ND, with first index corresponding to lowest model level.
+  ! Must be defined at same grid levels as T.
+  ! s_wake: Array of fractionnal area occupied by the wakes.
+  ! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
+  ! index corresponding with the lowest model level. Defined at
+  ! same levels as T. Note that this array will be altered if
+  ! dry convective adjustment occurs and if IPBL is not equal to 0.
+  ! v:   Same as u but for meridional velocity.
+  ! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
+  ! where NTRA is the number of different tracers. If no
+  ! convective tracer transport is needed, define a dummy
+  ! input array of dimension (ND,1). Tracers are defined at
+  ! same vertical levels as T. Note that this array will be altered
+  ! if dry convective adjustment occurs and if IPBL is not equal to 0.
+  ! p:   Array of pressure (mb) of dimension ND, with first
+  ! index corresponding to lowest model level. Must be defined
+  ! at same grid levels as T.
+  ! ph:  Array of pressure (mb) of dimension ND+1, with first index
+  ! corresponding to lowest level. These pressures are defined at
+  ! levels intermediate between those of P, T, Q and QS. The first
+  ! value of PH should be greater than (i.e. at a lower level than)
+  ! the first value of the array P.
+  ! ALE:  Available lifting Energy
+  ! ALP:  Available lifting Power
+  ! nl:  The maximum number of levels to which convection can penetrate, plus
+  ! 1.
+  ! NL MUST be less than or equal to ND-1.
+  ! delt: The model time step (sec) between calls to CONVECT
+  ! ----------------------------------------------------------------------------
+  ! ---   On Output:
+  ! iflag: An output integer whose value denotes the following:
+  ! VALUE   INTERPRETATION
+  ! -----   --------------
+  ! 0     Moist convection occurs.
+  ! 1     Moist convection occurs, but a CFL condition
+  ! on the subsidence warming is violated. This
+  ! does not cause the scheme to terminate.
+  ! 2     Moist convection, but no precip because ep(inb) lt 0.0001
+  ! 3     No moist convection because new cbmf is 0 and old cbmf is 0.
+  ! 4     No moist convection; atmosphere is not
+  ! unstable
+  ! 6     No moist convection because ihmin le minorig.
+  ! 7     No moist convection because unreasonable
+  ! parcel level temperature or specific humidity.
+  ! 8     No moist convection: lifted condensation
+  ! level is above the 200 mb level.
+  ! 9     No moist convection: cloud base is higher
+  ! then the level NL-1.
+  ! ft:   Array of temperature tendency (K/s) of dimension ND, defined at
+  ! same
+  ! grid levels as T, Q, QS and P.
+  ! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
+  ! defined at same grid levels as T, Q, QS and P.
+  ! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
+  ! defined at same grid levels as T.
+  ! fv:   Same as FU, but for forcing of meridional velocity.
+  ! ftra: Array of forcing of tracer content, in tracer mixing ratio per
+  ! second, defined at same levels as T. Dimensioned (ND,NTRA).
+  ! precip: Scalar convective precipitation rate (mm/day).
+  ! wd:   A convective downdraft velocity scale. For use in surface
+  ! flux parameterizations. See convect.ps file for details.
+  ! tprime: A convective downdraft temperature perturbation scale (K).
+  ! For use in surface flux parameterizations. See convect.ps
+  ! file for details.
+  ! qprime: A convective downdraft specific humidity
+  ! perturbation scale (gm/gm).
+  ! For use in surface flux parameterizations. See convect.ps
+  ! file for details.
+  ! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
+  ! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
+  ! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
+  ! by the calling program between calls to CONVECT.
+  ! det:   Array of detrainment mass flux of dimension ND.
+  ! -------------------------------------------------------------------
+  ! Local arrays
+! RomP <<<
+! -------------------------------------------------------------------
+! Prolog by Kerry Emanuel.
+! -------------------------------------------------------------------
+! --- ARGUMENTS
+! -------------------------------------------------------------------
+! --- On input:
+! t:   Array of absolute temperature (K) of dimension ND, with first
+! index corresponding to lowest model level. Note that this array
+! will be altered by the subroutine if dry convective adjustment
+! occurs and if IPBL is not equal to 0.
+! q:   Array of specific humidity (gm/gm) of dimension ND, with first
+! index corresponding to lowest model level. Must be defined
+! at same grid levels as T. Note that this array will be altered
+! if dry convective adjustment occurs and if IPBL is not equal to 0.
+! qs:  Array of saturation specific humidity of dimension ND, with first
+! index corresponding to lowest model level. Must be defined
+! at same grid levels as T. Note that this array will be altered
+! if dry convective adjustment occurs and if IPBL is not equal to 0.
+! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
+! of dimension ND, with first index corresponding to lowest model level.
+! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
+! of dimension ND, with first index corresponding to lowest model level.
+! Must be defined at same grid levels as T.
+! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
+! of dimension ND, with first index corresponding to lowest model level.
+! Must be defined at same grid levels as T.
+! s_wake: Array of fractionnal area occupied by the wakes.
+! u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
+! index corresponding with the lowest model level. Defined at
+! same levels as T. Note that this array will be altered if
+! dry convective adjustment occurs and if IPBL is not equal to 0.
+! v:   Same as u but for meridional velocity.
+! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
+! where NTRA is the number of different tracers. If no
+! convective tracer transport is needed, define a dummy
+! input array of dimension (ND,1). Tracers are defined at
+! same vertical levels as T. Note that this array will be altered
+! if dry convective adjustment occurs and if IPBL is not equal to 0.
+! p:   Array of pressure (mb) of dimension ND, with first
+! index corresponding to lowest model level. Must be defined
+! at same grid levels as T.
+! ph:  Array of pressure (mb) of dimension ND+1, with first index
+! corresponding to lowest level. These pressures are defined at
+! levels intermediate between those of P, T, Q and QS. The first
+! value of PH should be greater than (i.e. at a lower level than)
+! the first value of the array P.
+! ALE:  Available lifting Energy
+! ALP:  Available lifting Power
+! nl:  The maximum number of levels to which convection can penetrate, plus 1.
+!       NL MUST be less than or equal to ND-1.
+! delt: The model time step (sec) between calls to CONVECT
+! ----------------------------------------------------------------------------
+! ---   On Output:
+! iflag: An output integer whose value denotes the following:
+!       VALUE   INTERPRETATION
+!       -----   --------------
+!         0     Moist convection occurs.
+!         1     Moist convection occurs, but a CFL condition
+!               on the subsidence warming is violated. This
+!               does not cause the scheme to terminate.
+!         2     Moist convection, but no precip because ep(inb) lt 0.0001
+!         3     No moist convection because new cbmf is 0 and old cbmf is 0.
+!         4     No moist convection; atmosphere is not
+!               unstable
+!         6     No moist convection because ihmin le minorig.
+!         7     No moist convection because unreasonable
+!               parcel level temperature or specific humidity.
+!         8     No moist convection: lifted condensation
+!               level is above the 200 mb level.
+!         9     No moist convection: cloud base is higher
+!               then the level NL-1.
+! ft:   Array of temperature tendency (K/s) of dimension ND, defined at same
+!       grid levels as T, Q, QS and P.
+! fq:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
+!       defined at same grid levels as T, Q, QS and P.
+! fu:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
+!      defined at same grid levels as T.
+! fv:   Same as FU, but for forcing of meridional velocity.
+! ftra: Array of forcing of tracer content, in tracer mixing ratio per
+!       second, defined at same levels as T. Dimensioned (ND,NTRA).
+! precip: Scalar convective precipitation rate (mm/day).
+! wd:   A convective downdraft velocity scale. For use in surface
+!       flux parameterizations. See convect.ps file for details.
+! tprime: A convective downdraft temperature perturbation scale (K).
+!         For use in surface flux parameterizations. See convect.ps
+!         file for details.
+! qprime: A convective downdraft specific humidity
+!         perturbation scale (gm/gm).
+!         For use in surface flux parameterizations. See convect.ps
+!         file for details.
+! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
+!       BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
+!       ITS NEXT CALL. That is, the value of CBMF must be "remembered"
+!       by the calling program between calls to CONVECT.
+! det:   Array of detrainment mass flux of dimension ND.
+! -------------------------------------------------------------------
+! Local (non compressed) arrays
 …
   LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
   LOGICAL, SAVE :: debut = .TRUE.
   !$OMP THREADPRIVATE(debut)
+!$OMP THREADPRIVATE(debut)
   REAL tnk1(klon)
 …
   REAL p1feed1(len) ! pressure at lower bound of feeding layer
   REAL p2feed1(len) ! pressure at upper bound of feeding layer
+  REAL wghti1(len, nd) ! weights of the feeding layers
+  ! (local) compressed fields:
+!JYG,RL
+!!      real wghti1(len,nd) ! weights of the feeding layers
+!JYG,RL
+! (local) compressed fields:
   INTEGER nloc
   ! parameter (nloc=klon) ! pour l'instant
+! parameter (nloc=klon) ! pour l'instant
   INTEGER idcum(nloc)
 …
   REAL elij(nloc, klev, klev)
   REAL supmax(nloc, klev)
   REAL ale(nloc), alp(nloc), coef_clos(nloc)
+  REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
   REAL sigd(nloc)
   ! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
   ! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
   ! real b(nloc,klev), sigd(nloc)
   ! save mp,qp,up,vp,wt,water,evap,b
+! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
+! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
+! real b(nloc,klev), sigd(nloc)
+! save mp,qp,up,vp,wt,water,evap,b
   REAL, SAVE, ALLOCATABLE :: mp(:, :), qp(:, :), up(:, :), vp(:, :)
   REAL, SAVE, ALLOCATABLE :: wt(:, :), water(:, :), evap(:, :)
   REAL, SAVE, ALLOCATABLE :: ice(:, :), fondue(:, :), b(:, :)
   REAL, SAVE, ALLOCATABLE :: frac(:, :), faci(:, :)
   !$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
+!$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
   REAL ft(nloc, klev), fq(nloc, klev)
   REAL ftd(nloc, klev), fqd(nloc, klev)
 …
   REAL tps(nloc, klev), qprime(nloc), tprime(nloc)
   REAL precip(nloc)
   ! real Vprecip(nloc,klev)
+! real Vprecip(nloc,klev)
   REAL vprecip(nloc, klev+1)
   REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
   REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
   REAL qcondc(nloc, klev) ! cld
   REAL wd(nloc) ! gust
   REAL plim1(nloc), plim2(nloc)
+  REAL qcondc(nloc, klev)      ! cld
+  REAL wd(nloc)                ! gust
+  REAL Plim1(nloc), plim2(nloc)
   REAL asupmax(nloc, klev)
   REAL supmax0(nloc)
 …
   REAL hnk(nloc), unk(nloc), vnk(nloc)
   ! RomP >>>
   REAL wdtraina(nloc, klev), wdtrainm(nloc, klev)
+! RomP >>>
+  REAL wdtrainA(nloc, klev), wdtrainM(nloc, klev)
   REAL da(len, nd), phi(len, nd, nd)
   REAL epmlmmm(nloc, klev, klev), eplamm(nloc, klev)
+  REAL epmlmMm(nloc, klev, klev), eplaMm(nloc, klev)
   REAL phi2(len, nd, nd)
   REAL d1a(len, nd), dam(len, nd)
   ! RomP <<<
+! RomP <<<
   LOGICAL, SAVE :: first = .TRUE.
   !$OMP THREADPRIVATE(first)
+!$OMP THREADPRIVATE(first)
   CHARACTER (LEN=20) :: modname = 'cva_driver'
   CHARACTER (LEN=80) :: abort_message
   ! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
   ! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
   ! -------------------------------------------------------------------
   ! --- SET CONSTANTS AND PARAMETERS
   ! -------------------------------------------------------------------
+! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
+! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
+! -------------------------------------------------------------------
+! --- SET CONSTANTS AND PARAMETERS
+! -------------------------------------------------------------------
   IF (first) THEN
 …
     first = .FALSE.
   END IF
   ! -- set simulation flags:
   ! (common cvflag)
+! -- set simulation flags:
+! (common cvflag)
   CALL cv_flag(iflag_ice_thermo)
   ! -- set thermodynamical constants:
   ! (common cvthermo)
+! -- set thermodynamical constants:
+! (common cvthermo)
   CALL cv_thermo(iflag_con)
   ! -- set convect parameters
   ! includes microphysical parameters and parameters that
   ! control the rate of approach to quasi-equilibrium)
   ! (common cvparam)
+! -- set convect parameters
+! includes microphysical parameters and parameters that
+! control the rate of approach to quasi-equilibrium)
+! (common cvparam)
   IF (iflag_con==3) THEN
 …
   END IF
   ! ---------------------------------------------------------------------
   ! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
   ! ---------------------------------------------------------------------
+! ---------------------------------------------------------------------
+! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
+! ---------------------------------------------------------------------
   nword1 = len
   nword2 = len*nd
 …
   ftd1(:, :) = 0.
   fqd1(:, :) = 0.
   plim11(:) = 0.
   plim21(:) = 0.
+  Plim11(:) = 0.
+  Plim21(:) = 0.
   asupmax1(:, :) = 0.
   supmax01(:) = 0.
 …
   END IF
   ! RomP >>>
   wdtraina1(:, :) = 0.
   wdtrainm1(:, :) = 0.
+! RomP >>>
+  wdtrainA1(:, :) = 0.
+  wdtrainM1(:, :) = 0.
   da1(:, :) = 0.
   phi1(:, :, :) = 0.
   epmlmmm1(:, :, :) = 0.
   eplamm1(:, :) = 0.
+  epmlmMm1(:, :, :) = 0.
+  eplaMm1(:, :) = 0.
   mp1(:, :) = 0.
   evap1(:, :) = 0.
 …
   d1a1(:, :) = 0.
   dam1(:, :) = 0.
   ! RomP <<<
   ! ---------------------------------------------------------------------
   ! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
   ! ---------------------------------------------------------------------
+! RomP <<<
+! ---------------------------------------------------------------------
+! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
+! ---------------------------------------------------------------------
   DO il = 1, nloc
 …
   END DO
   ! --------------------------------------------------------------------
   ! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
   ! --------------------------------------------------------------------
+! --------------------------------------------------------------------
+! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
+! --------------------------------------------------------------------
   IF (iflag_con==3) THEN
 …
       PRINT *, 'Emanuel version 3 nouvelle'
     END IF
+    ! print*,'t1, q1 ',t1,q1
+    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1 & ! nd->na
+      , lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
+    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1 & !
+                                                               ! nd->na
+      , lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, h1_wake, bid, &
+      th1_wake)
+! print*,'t1, q1 ',t1,q1
+    CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, &           ! nd->na
+                    lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
+    CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
+                    lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
+                    h1_wake, bid, th1_wake)
   END IF
 …
   IF (iflag_con==4) THEN
     PRINT *, 'Emanuel version 4 '
     CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, &
       hm1)
   END IF
   ! --------------------------------------------------------------------
   ! --- CONVECTIVE FEED
   ! --------------------------------------------------------------------
   ! compute feeding layer potential temperature and mixing ratio :
   ! get bounds of feeding layer
   ! test niveaux couche alimentation KE
+    CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
+                   lv1, cpn1, tv1, gz1, h1, hm1)
+  END IF
+! --------------------------------------------------------------------
+! --- CONVECTIVE FEED
+! --------------------------------------------------------------------
+! compute feeding layer potential temperature and mixing ratio :
+! get bounds of feeding layer
+! test niveaux couche alimentation KE
   IF (sig1feed1==sig2feed1) THEN
     WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
 …
     p1feed1(i) = sig1feed1*ph1(i, 1)
     p2feed1(i) = sig2feed1*ph1(i, 1)
     ! test maf
     ! p1feed1(i)=ph1(i,1)
     ! p2feed1(i)=ph1(i,2)
     ! p2feed1(i)=ph1(i,3)
     ! testCR: on prend la couche alim des thermiques
     ! p2feed1(i)=ph1(i,lalim_conv(i)+1)
     ! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
+!test maf
+!   p1feed1(i)=ph1(i,1)
+!   p2feed1(i)=ph1(i,2)
+!   p2feed1(i)=ph1(i,3)
+!testCR: on prend la couche alim des thermiques
+!   p2feed1(i)=ph1(i,lalim_conv(i)+1)
+!   print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
   END DO
 …
   END IF
   DO i = 1, len
     ! print*,'avant cv3_feed plim',p1feed1(i),p2feed1(i)
+! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
   END DO
   IF (iflag_con==3) THEN
+    ! print*, 'IFLAG1 avant cv3_feed'
+    ! print*,'len,nd',len,nd
+    ! write(*,'(64i1)') iflag1(2:klon-1)
+    CALL cv3_feed(len, nd, t1, q1, u1, v1, p1, ph1, hm1, gz1 & !
+                                                               ! nd->na
+      , p1feed1, p2feed1, wght1, wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, &
+      vnk1, cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
+  END IF
+  ! print*, 'IFLAG1 apres cv3_feed'
+  ! print*,'len,nd',len,nd
+  ! write(*,'(64i1)') iflag1(2:klon-1)
+! print*, 'IFLAG1 avant cv3_feed'
+! print*,'len,nd',len,nd
+! write(*,'(64i1)') iflag1(2:klon-1)
+    CALL cv3_feed(len, nd, ok_conserv_q, &                 ! nd->na
+                  t1, q1, u1, v1, p1, ph1, hm1, gz1, &
+                  p1feed1, p2feed1, wght1, &
+                  wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
+                  cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
+  END IF
+! print*, 'IFLAG1 apres cv3_feed'
+! print*,'len,nd',len,nd
+! write(*,'(64i1)') iflag1(2:klon-1)
   IF (iflag_con==4) THEN
     CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
       iflag1, tnk1, qnk1, gznk1, plcl1)
   END IF
   ! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
   ! --------------------------------------------------------------------
   ! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
   ! (up through ICB for convect4, up through ICB+1 for convect3)
   ! Calculates the lifted parcel virtual temperature at nk, the
   ! actual temperature, and the adiabatic liquid water content.
   ! --------------------------------------------------------------------
+    CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
+                 nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
+  END IF
+! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
+! --------------------------------------------------------------------
+! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
+! (up through ICB for convect4, up through ICB+1 for convect3)
+! Calculates the lifted parcel virtual temperature at nk, the
+! actual temperature, and the adiabatic liquid water content.
+! --------------------------------------------------------------------
   IF (iflag_con==3) THEN
     CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1 & ! nd->na
       , gznk1, tp1, tvp1, clw1, icbs1)
+    CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
+                       gznk1, tp1, tvp1, clw1, icbs1)
   END IF
   IF (iflag_con==4) THEN
     CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, tp1, &
       tvp1, clw1)
   END IF
   ! -------------------------------------------------------------------
   ! --- TRIGGERING
   ! -------------------------------------------------------------------
   ! print *,' avant triggering, iflag_con ',iflag_con
+    CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
+                      tp1, tvp1, clw1)
+  END IF
+! -------------------------------------------------------------------
+! --- TRIGGERING
+! -------------------------------------------------------------------
+! print *,' avant triggering, iflag_con ',iflag_con
   IF (iflag_con==3) THEN
+    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1 & !
+                                                                       ! nd->na
+      , pbase1, buoybase1, iflag1, sig1, w01)
+    ! print*, 'IFLAG1 apres cv3_triger'
+    ! print*,'len,nd',len,nd
+    ! write(*,'(64i1)') iflag1(2:klon-1)
+    ! call dump2d(iim,jjm-1,sig1(2)
+    CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
+                      pbase1, buoybase1, iflag1, sig1, w01)
+! print*, 'IFLAG1 apres cv3_triger'
+! print*,'len,nd',len,nd
+! write(*,'(64i1)') iflag1(2:klon-1)
+! call dump2d(iim,jjm-1,sig1(2)
   END IF
 …
   ! =====================================================================
   ! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
   ! =====================================================================
+! =====================================================================
+! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
+! =====================================================================
   ncum = 0
 …
   END DO
   ! print*,'klon, ncum = ',len,ncum
+! print*,'klon, ncum = ',len,ncum
   IF (ncum>0) THEN
     ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     ! --- COMPRESS THE FIELDS
     ! (-> vectorization over convective gridpoints)
     ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! --- COMPRESS THE FIELDS
+!       (-> vectorization over convective gridpoints)
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     IF (iflag_con==3) THEN
+      ! print*,'ncum tv1 ',ncum,tv1
+      ! print*,'tvp1 ',tvp1
+      CALL cv3a_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
+        plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, wghti1, pbase1, &
+        buoybase1, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, u1, v1, &
+        gz1, th1, th1_wake, tra1, h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, &
+        tvp1, clw1, h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, sig1, &
+        w01, ptop21, ale1, alp1, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, &
+        hnk, unk, vnk, wghti, pbase, buoybase, t, q, qs, t_wake, q_wake, &
+        qs_wake, s_wake, u, v, gz, th, th_wake, tra, h, lv, lf, cpn, p, ph, &
+        tv, tp, tvp, clw, h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, sig, &
+        w0, ptop2, ale, alp)
+      ! print*,'tv ',tv
+      ! print*,'tvp ',tvp
+! print*,'ncum tv1 ',ncum,tv1
+! print*,'tvp1 ',tvp1
+      CALL cv3a_compress(len, nloc, ncum, nd, ntra, &
+                         iflag1, nk1, icb1, icbs1, &
+                         plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
+                         wghti1, pbase1, buoybase1, &
+                         t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
+                         u1, v1, gz1, th1, th1_wake, &
+                         tra1, &
+                         h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
+                         h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
+                         sig1, w01, ptop21, &
+                         Ale1, Alp1, &
+                         iflag, nk, icb, icbs, &
+                         plcl, tnk, qnk, gznk, hnk, unk, vnk, &
+                         wghti, pbase, buoybase, &
+                         t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
+                         u, v, gz, th, th_wake, &
+                         tra, &
+                         h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
+                         h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
+                         sig, w0, ptop2, &
+                         Ale, Alp)
+! print*,'tv ',tv
+! print*,'tvp ',tvp
     END IF
     IF (iflag_con==4) THEN
+      CALL cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
+        tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, &
+        tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, &
+        q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
+    END IF
+    ! -------------------------------------------------------------------
+    ! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
+    ! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+    ! ---   &
+    ! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
+    ! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
+    ! ---   &
+    ! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
+    ! -------------------------------------------------------------------
+      CALL cv_compress(len, nloc, ncum, nd, &
+                       iflag1, nk1, icb1, &
+                       cbmf1, plcl1, tnk1, qnk1, gznk1, &
+                       t1, q1, qs1, u1, v1, gz1, &
+                       h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
+                       iflag, nk, icb, &
+                       cbmf, plcl, tnk, qnk, gznk, &
+                       t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
+                       dph)
+    END IF
+! -------------------------------------------------------------------
+! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
+! ---   FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
+! ---   &
+! ---   COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
+! ---   FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
+! ---   &
+! ---   FIND THE LEVEL OF NEUTRAL BUOYANCY
+! -------------------------------------------------------------------
     IF (iflag_con==3) THEN
+      CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk & !na->nd
+        , tnk, qnk, gznk, hnk, t, q, qs, gz, p, h, tv, lv, lf, pbase, &
+        buoybase, plcl, inb, tp, tvp, clw, hp, ep, sigp, buoy, frac)
+      CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, &              !na->nd
+                         tnk, qnk, gznk, hnk, t, q, qs, gz, &
+                         p, h, tv, lv, lf, pbase, buoybase, plcl, &
+                         inb, tp, tvp, clw, hp, ep, sigp, buoy, &
+                         frac)
     END IF
     IF (iflag_con==4) THEN
+      CALL cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
+        gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
+    END IF
+    ! -------------------------------------------------------------------
+    ! --- MIXING(1)   (if iflag_mix .ge. 1)
+    ! -------------------------------------------------------------------
+      CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
+                        tnk, qnk, gznk, t, q, qs, gz, &
+                        p, dph, h, tv, lv, &
+                        inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
+    END IF
+! -------------------------------------------------------------------
+! --- MIXING(1)   (if iflag_mix .ge. 1)
+! -------------------------------------------------------------------
     IF (iflag_con==3) THEN
       IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
         WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', &
           ' but iflag_mix=', iflag_mix, '. Might as well stop here.'
+        WRITE (*, *) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
+          '. Might as well stop here.'
         STOP
       END IF
       IF (iflag_mix>=1) THEN
         CALL zilch(supmax, nloc*klev)
         CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
                                                                   ! na->nd
           , ph, t, q, qs, u, v, tra, h, lv, qnk, unk, vnk, hp, tv, tvp, ep, &
           clw, sig, ment, qent, hent, uent, vent, nent, sigij, elij, supmax, &
           ments, qents, traent)
         ! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
+        CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &           ! na->nd
+                         ph, t, q, qs, u, v, tra, h, lv, qnk, &
+                         unk, vnk, hp, tv, tvp, ep, clw, sig, &
+                         ment, qent, hent, uent, vent, nent, &
+                         sigij, elij, supmax, ments, qents, traent)
+! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
       ELSE
 …
       END IF
     END IF
     ! -------------------------------------------------------------------
     ! --- CLOSURE
     ! -------------------------------------------------------------------
+! -------------------------------------------------------------------
+! --- CLOSURE
+! -------------------------------------------------------------------
     IF (iflag_con==3) THEN
       IF (iflag_clos==0) THEN
+        CALL cv3_closure(nloc, ncum, nd, icb, inb & ! na->nd
+          , pbase, p, ph, tv, buoy, sig, w0, cape, m, iflag)
+        CALL cv3_closure(nloc, ncum, nd, icb, inb, &           ! na->nd
+                         pbase, p, ph, tv, buoy, &
+                         sig, w0, cape, m, iflag)
       END IF
 …
       IF (iflag_clos==1) THEN
         PRINT *, ' pas d appel cv3p_closure'
+        ! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              !
+        ! na->nd
+        ! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
+        ! c    :                       ,supmax
+        ! c    o                       ,sig,w0,ptop2,cape,cin,m)
+! c        CALL cv3p_closure(nloc,ncum,nd,icb,inb              ! na->nd
+! c    :                       ,pbase,plcl,p,ph,tv,tvp,buoy
+! c    :                       ,supmax
+! c    o                       ,sig,w0,ptop2,cape,cin,m)
       END IF
       IF (iflag_clos==2) THEN
+        CALL cv3p1_closure(nloc, ncum, nd, icb, inb & ! na->nd
+          , pbase, plcl, p, ph, tv, tvp, buoy, supmax, ok_inhib, ale, alp, &
+          sig, w0, ptop2, cape, cin, m, iflag, coef_clos, plim1, plim2, &
+          asupmax, supmax0, asupmaxmin, cbmf, plfc, wbeff)
+        CALL cv3p1_closure(nloc, ncum, nd, icb, inb, &         ! na->nd
+                           pbase, plcl, p, ph, tv, tvp, buoy, &
+                           supmax, ok_inhib, Ale, Alp, &
+                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
+                           Plim1, plim2, asupmax, supmax0, &
+                           asupmaxmin, cbmf, plfc, wbeff)
         PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
 …
     IF (iflag_con==4) THEN
+      CALL cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
+        cpn, iflag, cbmf)
+    END IF
+    ! print *,'cv_closure-> cape ',cape(1)
+    ! -------------------------------------------------------------------
+    ! --- MIXING(2)
+    ! -------------------------------------------------------------------
+      CALL cv_closure(nloc, ncum, nd, nk, icb, &
+                         tv, tvp, p, ph, dph, plcl, cpn, &
+                         iflag, cbmf)
+    END IF
+! print *,'cv_closure-> cape ',cape(1)
+! -------------------------------------------------------------------
+! --- MIXING(2)
+! -------------------------------------------------------------------
     IF (iflag_con==3) THEN
       IF (iflag_mix==0) THEN
+        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
+                                                                 ! na->nd
+          , ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, unk, vnk, hp, tv, &
+          tvp, ep, clw, m, sig, ment, qent, uent, vent, nent, sigij, elij, &
+          ments, qents, traent)
+        CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, &             ! na->nd
+                        ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
+                        unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
+                        ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
         CALL zilch(hent, nloc*klev*klev)
       ELSE
 …
     IF (iflag_con==4) THEN
+      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, ph, t, q, qs, u, v, &
+        h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, &
+        nent, sigij, elij)
+    END IF
+      CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
+                     ph, t, q, qs, u, v, h, lv, qnk, &
+                     hp, tv, tvp, ep, clw, cbmf, &
+                     m, ment, qent, uent, vent, nent, sigij, elij)
+    END IF
     IF (debut) THEN
       PRINT *, ' cv_mixing ->'
     END IF !(debut) THEN
     ! do i = 1,klev
     ! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
     ! enddo
     ! -------------------------------------------------------------------
     ! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
     ! -------------------------------------------------------------------
+! do i = 1,klev
+! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
+! enddo
+! -------------------------------------------------------------------
+! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
+! -------------------------------------------------------------------
     IF (iflag_con==3) THEN
       IF (debut) THEN
 …
       END IF !(debut) THEN
+      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag & !
+                                                                 ! na->nd
+        , t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, th_wake, tv_wake, &
+        lv_wake, lf_wake, cpn_wake, ep, sigp, clw, m, ment, elij, delt, plcl, &
+        coef_clos, mp, qp, up, vp, trap, wt, water, evap, fondue, ice, faci, &
+        b, sigd, wdtraina, wdtrainm) ! RomP
+      CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, &              ! na->nd
+                     t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
+                     th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
+                     ep, sigp, clw, &
+                     m, ment, elij, delt, plcl, coef_clos, &
+                     mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
+                     faci, b, sigd, &
+                     wdtrainA, wdtrainM)                                       ! RomP
     END IF
     IF (iflag_con==4) THEN
+      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, h, lv, &
+        ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
+      CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
+                     h, lv, ep, sigp, clw, m, ment, elij, &
+                     iflag, mp, qp, up, vp, wt, water, evap)
     END IF
 …
     END IF !(debut) THEN
     ! print *,'cv_unsat-> mp ',mp
     ! print *,'cv_unsat-> water ',water
     ! -------------------------------------------------------------------
     ! --- YIELD
     ! (tendencies, precipitation, variables of interface with other
     ! processes, etc)
     ! -------------------------------------------------------------------
+! print *,'cv_unsat-> mp ',mp
+! print *,'cv_unsat-> water ',water
+! -------------------------------------------------------------------
+! --- YIELD
+! (tendencies, precipitation, variables of interface with other
+! processes, etc)
+! -------------------------------------------------------------------
     IF (iflag_con==3) THEN
+      CALL cv3_yield(nloc, ncum, nd, nd, ntra & ! na->nd
+        , icb, inb, delt, t, q, t_wake, q_wake, s_wake, u, v, tra, gz, p, ph, &
+        h, hp, lv, lf, cpn, th, th_wake, ep, clw, m, tp, mp, qp, up, vp, &
+        trap, wt, water, ice, evap, fondue, faci, b, sigd, ment, qent, hent, &
+        iflag_mix, uent, vent, nent, elij, traent, sig, tv, tvp, wghti, &
+        iflag, precip, vprecip, ft, fq, fu, fv, ftra, cbmf, upwd, dnwd, &
+        dnwd0, ma, mip, tls, tps, qcondc, wd, ftd, fqd)
+      CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, &                      ! na->nd
+                     icb, inb, delt, &
+                     t, q, t_wake, q_wake, s_wake, u, v, tra, &
+                     gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
+                     ep, clw, m, tp, mp, qp, up, vp, trap, &
+                     wt, water, ice, evap, fondue, faci, b, sigd, &
+                     ment, qent, hent, iflag_mix, uent, vent, &
+                     nent, elij, traent, sig, &
+                     tv, tvp, wghti, &
+                     iflag, precip, vprecip, ft, fq, fu, fv, ftra, &
+                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
+                     tls, tps, qcondc, wd, &
+                     ftd, fqd)
     END IF
 …
     IF (iflag_con==4) THEN
+      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, t, q, u, v, gz, p, &
+        ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, &
+        evap, ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, &
+        tprime, precip, cbmf, ft, fq, fu, fv, ma, qcondc)
+    END IF
+    ! AC!
+    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+    ! --- passive tracers
+    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+      CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
+                     t, q, u, v, &
+                     gz, p, ph, h, hp, lv, cpn, &
+                     ep, clw, frac, m, mp, qp, up, vp, &
+                     wt, water, evap, &
+                     ment, qent, uent, vent, nent, elij, &
+                     tv, tvp, &
+                     iflag, wd, qprime, tprime, &
+                     precip, cbmf, ft, fq, fu, fv, ma, qcondc)
+    END IF
+!AC!
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+!--- passive tracers
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     IF (iflag_con==3) THEN
+      ! RomP >>>
+      CALL cv3_tracer(nloc, len, ncum, nd, nd, ment, sigij, da, phi, phi2, &
+        d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
+      ! RomP <<<
+    END IF
+    ! AC!
+    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+    ! --- UNCOMPRESS THE FIELDS
+    ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+!RomP >>>
+      CALL cv3_tracer(nloc, len, ncum, nd, nd, &
+                     ment, sigij, da, phi, phi2, d1a, dam, &
+                     ep, vprecip, elij, clw, epmlmMm, eplaMm, &
+                     icb, inb)
+!RomP <<<
+    END IF
+!AC!
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! --- UNCOMPRESS THE FIELDS
+! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     IF (iflag_con==3) THEN
+      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, icb, inb, &
+        precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, ft, fq, fu, fv, &
+        ftra, sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, qcondc, wd, cape, &
+        cin, tvp, ftd, fqd, plim1, plim2, asupmax, supmax0, asupmaxmin, da, &
+        phi, mp, phi2, d1a, dam, sigij & ! RomP
+        , clw, elij, evap, ep, epmlmmm, eplamm & ! RomP
+        , wdtraina, wdtrainm &     ! RomP
+        , iflag1, kbas1, ktop1, precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, &
+        w01, ptop21, ft1, fq1, fu1, fv1, ftra1, sigd1, ma1, mip1, vprecip1, &
+        upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1, cin1, tvp1, ftd1, fqd1, &
+        plim11, plim21, asupmax1, supmax01, asupmaxmin1, da1, phi1, mp1, &
+        phi21, d1a1, dam1, sigij1 & ! RomP
+        , clw1, elij1, evap1, ep1, epmlmmm1, eplamm1 & ! RomP
+        , wdtraina1, wdtrainm1) ! RomP
+      CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, &
+                           iflag, icb, inb, &
+                           precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
+                           ft, fq, fu, fv, ftra, &
+                           sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, &
+                           qcondc, wd, cape, cin, &
+                           tvp, &
+                           ftd, fqd, &
+                           Plim1, plim2, asupmax, supmax0, &
+                           asupmaxmin, &
+                           da, phi, mp, phi2, d1a, dam, sigij, &         ! RomP
+                           clw, elij, evap, ep, epmlmMm, eplaMm, &       ! RomP
+                           wdtrainA, wdtrainM, &                         ! RomP
+                           iflag1, kbas1, ktop1, &
+                           precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
+                           ft1, fq1, fu1, fv1, ftra1, &
+                           sigd1, ma1, mip1, vprecip1, upwd1, dnwd1, dnwd01, &
+                           qcondc1, wd1, cape1, cin1, &
+                           tvp1, &
+                           ftd1, fqd1, &
+                           Plim11, plim21, asupmax1, supmax01, &
+                           asupmaxmin1, &
+                           da1, phi1, mp1, phi21, d1a1, dam1, sigij1,  & ! RomP
+                           clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
+                           wdtrainA1, wdtrainM1)                         ! RomP
     END IF
     IF (iflag_con==4) THEN
+      CALL cv_uncompress(nloc, len, ncum, nd, idcum, iflag, precip, cbmf, ft, &
+        fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, &
+        ma1, qcondc1)
+      CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
+                           iflag, &
+                           precip, cbmf, &
+                           ft, fq, fu, fv, &
+                           ma, qcondc, &
+                           iflag1, &
+                           precip1,cbmf1, &
+                           ft1, fq1, fu1, fv1, &
+                           ma1, qcondc1)
     END IF
 …
     PRINT *, ' cv_compress -> '
     debut = .FALSE.
+  END IF !(debut) THEN
+  END IF  !(debut) THEN
   RETURN

LMDZ5/branches/testing/libf/phylmd/cvltr.F90

-                      r1910
+                      r2056
+!
 SUBROUTINE cvltr(pdtime, da, phi,phi2,d1a,dam, mpIN,epIN, &
+           sigd,sij,clw,elij,epmlmMm,eplaMm,              &
+!!           sigd,sij,clw,elij,epmlmMm,eplaMm,              &   !RL
+           sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,    &     !RL
            pmflxrIN,pmflxsIN,ev,te,wdtrainA,wdtrainM,     &
            paprs,it,tr,upd,dnd,inb,icb,                   &
 …
   REAL,DIMENSION(klon,klev),INTENT(IN)      :: te
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij        ! fraction dair de lenv
+  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd  ! weights of the layers feeding convection
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij       ! contenu en eau condensée spécifique/conc deau condensée massique
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm    ! eau condensee precipitee dans mel masse dair sat
 …
   REAL,DIMENSION(klon,klev,nbtr)    :: zmfd,zmfa
   REAL,DIMENSION(klon,klev,nbtr)    :: zmfp,zmfu
+  REAL,DIMENSION(klon,nbtr)         :: qfeed     ! tracer concentration feeding convection
   REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT)    :: zmfd1a
 …
    scavtrac = 0.
    uscavtrac = 0.
+   qfeed(:,it) = 0.              !RL
   DO j=1,klev
    DO i=1,klon
 …
 ! calcul des tendances liees aux courants satures   j <-> z ; k <-> z'
 ! =========================================
+!
+!RL
+!  Feeding concentrations
   DO j=1,klev
      DO i=1,klon
+        zmfa(i,j,it)=da(i,j)*(tr(i,1,it)-tr(i,j,it))                     ! da
+     END DO
+  END DO
+        qfeed(i,it)=qfeed(i,it)+wght_cvfd(i,j)*tr(i,j,it)
+     END DO
+  END DO
+!RL
+!
+  DO j=1,klev
+     DO i=1,klon
+!RL
+!!        zmfa(i,j,it)=da(i,j)*(tr(i,1,it)-tr(i,j,it))                     ! da
+        zmfa(i,j,it)=da(i,j)*(qfeed(i,it)-tr(i,j,it))                     ! da
+!RL
+     END DO
+  END DO
+!
   DO k=1,klev
      DO j=1,klev

LMDZ5/branches/testing/libf/phylmd/ener_conserv.F90

-                      r1910
+                      r2056
 ! From module
 USE phys_local_var_mod, ONLY : d_u_vdf,d_v_vdf,d_t_vdf,d_u_ajs,d_v_ajs,d_t_ajs,d_u_con,d_v_con,d_t_con,d_t_diss
+USE phys_output_var_mod, ONLY : bils_ec,bils_tke,bils_kinetic,bils_enthalp,bils_latent,bils_diss
+USE phys_local_var_mod, ONLY : d_t_eva,d_t_lsc,d_q_eva,d_q_lsc
+USE phys_output_var_mod, ONLY : bils_ec,bils_ech,bils_tke,bils_kinetic,bils_enthalp,bils_latent,bils_diss
 IMPLICIT none
 …
 REAL, DIMENSION(klon,klev+1) :: fluxu,fluxv,fluxt
 REAL, DIMENSION(klon,klev+1) :: dddu,dddv,dddt
 REAL, DIMENSION(klon,klev) :: d_u,d_v,d_t,zv,zu
+REAL, DIMENSION(klon,klev) :: d_u,d_v,d_t,zv,zu,d_t_ech
 REAL ZRCPD
 …
    do k=1,klev
       d_t_ec(:,k)=-(dddu(:,k)+dddu(:,k+1)+dddv(:,k)+dddv(:,k+1) &
    &  +rcpd*(dddt(:,k)+dddt(:,k+1)))/(2.*rcpd*masse(:,k))
+      d_t_ech(:,k)=-(rcpd*(dddt(:,k)+dddt(:,k+1)))/(2.*rcpd*masse(:,k))
+      d_t_ec(:,k)=-(dddu(:,k)+dddu(:,k+1)+dddv(:,k)+dddv(:,k+1))/(2.*rcpd*masse(:,k))+d_t_ech(:,k)
    enddo
-! d_t_ec=0.
 ENDIF
 …
 !  Computation of integrated enthalpie and kinetic energy variation
 !  FH (hourdin@lmd.jussieu.fr), 2013/04/25
+!  bils_ec : energie conservation term
+!  bils_ech : part of this term linked to temperature
+!  bils_tke : change of TKE
+!  bils_diss : dissipation of TKE (when activated)
+!  bils_kinetic : change of kinetic energie of the column
+!  bils_enthalp : change of enthalpie
+!  bils_latent  : change of latent heat. Computed between
+!          after reevaporation (at the beginning of the physics)
+!          and before large scale condensation (fisrtilp)
 !================================================================
 …
      &            -puo(:,k)*puo(:,k)-pvo(:,k)*pvo(:,k))
         bils_enthalp(:)= &
+     &  bils_enthalp(:)+masse(:,k)*(ptn(:,k)-pto(:,k)+d_t_ec(:,k))
+     &  bils_enthalp(:)+masse(:,k)*(ptn(:,k)-pto(:,k)+d_t_ec(:,k)-d_t_eva(:,k)-d_t_lsc(:,k))
+!    &  bils_enthalp(:)+masse(:,k)*(ptn(:,k)-pto(:,k)+d_t_ec(:,k))
         bils_latent(:)=bils_latent(:)+masse(:,k)* &
+     &             (pqn(:,k)-pqo(:,k))
+!    &             (pqn(:,k)-pqo(:,k))
+     &             (pqn(:,k)-pqo(:,k)-d_q_eva(:,k)-d_q_lsc(:,k))
       ENDDO
       bils_ec(:)=rcpd*bils_ec(:)/pdtphys
 …
       bils_enthalp(:)=rcpd*bils_enthalp(:)/pdtphys
       bils_latent(:)=rlvtt*bils_latent(:)/pdtphys
+IF (iflag_ener_conserv>=1) THEN
+      bils_ech(:)=0.
+      DO k=1,klev
+        bils_ech(:)=bils_ech(:)-d_t_ech(:,k)*masse(:,k)
+      ENDDO
+      bils_ech(:)=rcpd*bils_ech(:)/pdtphys
+ENDIF
 RETURN

LMDZ5/branches/testing/libf/phylmd/etat0_netcdf.F90

-                      r1910
+                      r2056
   USE netcdf, ONLY : NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
   USE indice_sol_mod
+  use exner_hyb_m, only: exner_hyb
+  use exner_milieu_m, only: exner_milieu
+  use test_disvert_m, only: test_disvert
 #endif
   IMPLICIT NONE
 …
   CHARACTER(LEN=80)                        :: x, fmt
   INTEGER                                  :: i, j, l, ji
   REAL,    DIMENSION(iip1,jjp1,llm)        :: alpha, beta, pk, pls, y
+  REAL,    DIMENSION(iip1,jjp1,llm)        :: pk, pls, y
   REAL,    DIMENSION(ip1jmp1)              :: pks
 …
   CALL iniconst()
+  if (pressure_exner) call test_disvert
   CALL inigeom()
 …
   CALL pression(ip1jmp1, ap, bp, psol, p3d)
   if (pressure_exner) then
     CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, y)
+    CALL exner_hyb(ip1jmp1, psol, p3d, pks, pk)
   else
     CALL exner_milieu(ip1jmp1,psol,p3d,beta,pks,pk,y)
+    CALL exner_milieu(ip1jmp1,psol,p3d, pks,pk)
   endif
   pls(:,:,:)=preff*(pk(:,:,:)/cpp)**(1./kappa)

LMDZ5/branches/testing/libf/phylmd/fisrtilp.F90

-                      r1910
+                      r2056
+  !
   USE dimphy
+  USE microphys_mod ! cloud microphysics (JBM 3/14)
   IMPLICIT none
   !======================================================================
 …
   include "tracstoke.h"
   include "fisrtilp.h"
+  include "nuage.h" ! JBM (3/14)
   include "iniprint.h"
 …
   REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
   REAL zoliqp(klon), zoliqi(klon)
+  REAL ztglace, zt(klon)
+  INTEGER nexpo ! exponentiel pour glace/eau
+  REAL zt(klon)
+! JBM (3/14) nexpo is replaced by exposant_glace
+! REAL nexpo ! exponentiel pour glace/eau
+! INTEGER, PARAMETER :: nexpo=6
+  INTEGER exposant_glace_old
+  REAL t_glace_min_old
   REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
   REAL zchau      ,zfroi      ,zfice(klon),zneb(klon)
 …
   !  nexpo regle la raideur de la transition eau liquide / eau glace.
+  !
+  ztglace = RTT - 15.0
+!AJ<
+  IF (ice_thermo) THEN
+    nexpo = 2
+  ELSE
+    nexpo = 6
+  IF (iflag_t_glace.EQ.0) THEN
+!   ztglace = RTT - 15.0
+    t_glace_min_old = RTT - 15.0
+    !AJ<
+    IF (ice_thermo) THEN
+!     nexpo = 2
+      exposant_glace_old = 2
+    ELSE
+!     nexpo = 6
+      exposant_glace_old = 6
+    ENDIF
   ENDIF
 !!  RLVTT = 2.501e6 ! pas de redefinition des constantes physiques (jyg)
 !!  RLSTT = 2.834e6 ! pas de redefinition des constantes physiques (jyg)
 …
         endif
      ELSE
+       IF (iflag_t_glace.EQ.0) THEN
          if (iflag_fisrtilp_qsat.lt.1) then
            DO i = 1, klon
               zfice(i) = 1.0 - (zt(i)-ztglace) / (273.15-ztglace)
+              zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (273.15-t_glace_min_old)
               zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+              zfice(i) = zfice(i)**nexpo
+              zfice(i) = zfice(i)**exposant_glace_old
+!             zfice(i) = zfice(i)**nexpo
               zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
                        +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
 …
          else
            DO i=1, klon
               zfice(i) = 1.0 - (zt(i)-ztglace) / (273.15-ztglace)
+              zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (273.15-t_glace_min_old)
               zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+              zfice(i) = zfice(i)**nexpo
+              zfice(i) = zfice(i)**exposant_glace_old
+!             zfice(i) = zfice(i)**nexpo
 !CR: ATTENTION zt different de Tbef: à corriger
               zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i))) &
 …
          endif
 !         print*,zt(i),zrfl(i),zifl(i),'temp1'
+       ELSE ! of IF (iflag_t_glace.EQ.0)
+         if (iflag_fisrtilp_qsat.lt.1) then
+           DO i = 1, klon
+! JBM: icefrac_lsc is now a function contained in microphys_mod
+              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
+                                     t_glace_max, exposant_glace)
+              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i)) &
+                       +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*zq(i))
+           ENDDO
+         else
+           DO i=1, klon
+! JBM: icefrac_lsc is now a function contained in microphys_mod
+              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
+                                     t_glace_max, exposant_glace)
+!CR: ATTENTION zt different de Tbef: à corriger
+              zt(i) = zt(i) + (1.-zfice(i))*zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i))) &
+                       +zfice(i)*zcond(i) * RLSTT/RCPD/(1.0+RVTMP2*(zq(i)+zcond(i)))
+           ENDDO
+         endif
+!         print*,zt(i),zrfl(i),zifl(i),'temp1'
+       ENDIF
      ENDIF
 !>AJ
 …
 !AJ<
      IF (.NOT. ice_thermo) THEN
+     DO i = 1, klon
+        IF (rneb(i,k).GT.0.0) THEN
+           zfice(i) = 1.0 - (zt(i)-ztglace) / (273.13-ztglace)
+           zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+           zfice(i) = zfice(i)**nexpo
+     !!      zfice(i)=0.
+        ENDIF
+     ENDDO
+       IF (iflag_t_glace.EQ.0) THEN
+         DO i = 1, klon
+            IF (rneb(i,k).GT.0.0) THEN
+               zfice(i) = 1.0 - (zt(i)-t_glace_min_old) / (273.13-t_glace_min_old)
+               zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+               zfice(i) = zfice(i)**exposant_glace_old
+!              zfice(i) = zfice(i)**nexpo
+         !!      zfice(i)=0.
+            ENDIF
+         ENDDO
+       ELSE ! of IF (iflag_t_glace.EQ.0)
+         DO i = 1, klon
+            IF (rneb(i,k).GT.0.0) THEN
+! JBM: icefrac_lsc is now a function contained in microphys_mod
+              zfice(i) = icefrac_lsc(zt(i), t_glace_min, &
+                                     t_glace_max, exposant_glace)
+            ENDIF
+         ENDDO
+       ENDIF
      ENDIF
      DO i = 1, klon
 …
         IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
            !AA lessivage nucleation LMD5 dans la couche elle-meme
+           if (t(i,k) .GE. ztglace) THEN
+          IF (iflag_t_glace.EQ.0) THEN
+           if (t(i,k) .GE. t_glace_min_old) THEN
               zalpha_tr = a_tr_sca(3)
            else
               zalpha_tr = a_tr_sca(4)
            endif
+          ELSE ! of IF (iflag_t_glace.EQ.0)
+           if (t(i,k) .GE. t_glace_min) THEN
+              zalpha_tr = a_tr_sca(3)
+           else
+              zalpha_tr = a_tr_sca(4)
+           endif
+          ENDIF
            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
            pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
 …
         DO i = 1, klon
            IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+              if (t(i,kk) .GE. ztglace) THEN
+             IF (iflag_t_glace.EQ.0) THEN
+              if (t(i,kk) .GE. t_glace_min_old) THEN
                  zalpha_tr = a_tr_sca(1)
               else
                  zalpha_tr = a_tr_sca(2)
               endif
+             ELSE ! of IF (iflag_t_glace.EQ.0)
+              if (t(i,kk) .GE. t_glace_min) THEN
+                 zalpha_tr = a_tr_sca(1)
+              else
+                 zalpha_tr = a_tr_sca(2)
+              endif
+             ENDIF
               zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
               pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)

LMDZ5/branches/testing/libf/phylmd/iophy.F90

-                      r1910
+                      r2056
     INCLUDE "temps.h"
     INCLUDE "clesphys.h"
+    INCLUDE "iniprint.h"
     INTEGER                          :: iff
 …
 #ifdef CPP_XIOS
+      IF ( var%flag(iff)<=lev_files(iff) ) THEN
         CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
         var%description, var%unit, var%flag(iff), typeecrit)
+        IF (prt_level >= 10) THEN
+          WRITE(lunout,*) 'histdef2d: call wxios_add_field_to_file var%name iff: ', &
+                          trim(var%name),iff
+        ENDIF
+      ENDIF
 #endif
 #ifndef CPP_NO_IOIPSL
 …
     END IF
   END SUBROUTINE histdef2d
   SUBROUTINE histdef3d (iff,var)
 …
     INCLUDE "temps.h"
     INCLUDE "clesphys.h"
+    INCLUDE "iniprint.h"
     INTEGER                          :: iff
 …
 #ifdef CPP_XIOS
+      IF ( var%flag(iff)<=lev_files(iff) ) THEN
         CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
         var%description, var%unit, var%flag(iff), typeecrit)
+        IF (prt_level >= 10) THEN
+          WRITE(lunout,*) 'histdef3d: call wxios_add_field_to_file var%name iff: ', &
+                          trim(var%name),iff
+        ENDIF
+      ENDIF
 #endif
 #ifndef CPP_NO_IOIPSL
 …
                                  nid_files
 #ifdef CPP_XIOS
   USE wxios, only: wxios_write_2D
+  USE xios, only: xios_send_field
 #endif
 …
     INTEGER :: iff, iff_beg, iff_end
+    LOGICAL, SAVE  :: firstx
+!$OMP THREADPRIVATE(firstx)
     REAL,DIMENSION(klon_mpi) :: buffer_omp
     INTEGER, allocatable, DIMENSION(:) :: index2d
 …
     REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
+    IF (prt_level >= 10) WRITE(lunout,*)'Begin histwrite2d_phy ',trim(var%name)
+    IF (prt_level >= 10) THEN
+      WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
+    ENDIF
 ! ug RUSTINE POUR LES STD LEVS.....
       IF (PRESENT(STD_iff)) THEN
 …
 ! La boucle sur les fichiers:
+      firstx=.true.
       DO iff=iff_beg, iff_end
             IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
+#ifdef CPP_XIOS
+               IF (firstx) THEN
+                  if (prt_level >= 10) then
+                     write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
+                                    iff,trim(var%name)
+                     write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
+                  endif
+                  CALL xios_send_field(var%name, Field2d)
+                  firstx=.false.
+               ENDIF
+#endif
                   IF(.NOT.clef_stations(iff)) THEN
                         ALLOCATE(index2d(iim*jj_nb))
 …
                         CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,iim*jj_nb,index2d)
 #endif
 #ifdef CPP_XIOS
                         IF (iff == iff_beg) THEN
                           if (prt_level >= 10) then
                             write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
                           endif
                           CALL wxios_write_2D(var%name, Field2d)
                         ENDIF
 #endif
+!#ifdef CPP_XIOS
+!                        IF (iff == iff_beg) THEN
+!                          if (prt_level >= 10) then
+!                            write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field"
+!                          endif
+!                          CALL xios_send_field(var%name, Field2d)
+!                        ENDIF
+!#endif
                   ELSE
                         ALLOCATE(fieldok(npstn))
 …
                                  nid_files
 #ifdef CPP_XIOS
   USE wxios, only: wxios_write_3D
+  USE xios, only: xios_send_field
 #endif
 …
     INTEGER :: iff, iff_beg, iff_end
+    LOGICAL, SAVE  :: firstx
+!$OMP THREADPRIVATE(firstx)
     REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
     REAL :: Field3d(iim,jj_nb,SIZE(field,2))
     INTEGER :: ip, n, nlev
+    INTEGER :: ip, n, nlev, nlevx
     INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
     REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
 …
     IF (SIZE(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
     nlev=SIZE(field,2)
+    if (nlev.eq.klev+1) then
+        nlevx=klev
+    else
+        nlevx=nlev
+    endif
     CALL Gather_omp(field,buffer_omp)
 …
 ! BOUCLE SUR LES FICHIERS
+     firstx=.true.
      DO iff=iff_beg, iff_end
             IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
+#ifdef CPP_XIOS
+              IF (firstx) THEN
+                if (prt_level >= 10) then
+                  write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
+                                  iff,nlev,klev, firstx
+                  write(lunout,*)'histwrite3d_phy: call xios_send_field for ', &
+                                  trim(var%name), ' with iim jjm nlevx = ', &
+                                  iim,jj_nb,nlevx
+                endif
+                CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
+                            firstx=.false.
+              ENDIF
+#endif
                 IF (.NOT.clef_stations(iff)) THEN
                         ALLOCATE(index3d(iim*jj_nb*nlev))
 …
 #endif
 #ifdef CPP_XIOS
                         IF (iff == 1) THEN
                               CALL wxios_write_3D(var%name, Field3d(:,:,1:klev))
                         ENDIF
 #endif
+!#ifdef CPP_XIOS
+!                        IF (iff == 1) THEN
+!                              CALL xios_send_field(var%name, Field3d(:,:,1:klev))
+!                        ENDIF
+!#endif
+!
                 ELSE
                         nlev=size(field,2)
 …
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 jj_nb, klon_mpi
   USE wxios, only: wxios_write_2D
+  USE xios, only: xios_send_field
 …
         CALL wxios_write_2D(field_name, Field2d)
+        CALL xios_send_field(field_name, Field2d)
     ELSE
 …
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 jj_nb, klon_mpi
   USE wxios, only: wxios_write_3D
+  USE xios, only: xios_send_field
 …
         ALLOCATE(index3d(iim*jj_nb*nlev))
         ALLOCATE(fieldok(iim*jj_nb,nlev))
         CALL wxios_write_3D(field_name, Field3d(:,:,1:klev))
+        CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
     ELSE

LMDZ5/branches/testing/libf/phylmd/newmicro.F90

-                      r1999
+                      r2056
     reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra
   USE phys_state_var_mod, ONLY: rnebcon, clwcon
+  USE microphys_mod ! cloud microphysics (JBM 3/14)
   IMPLICIT NONE
   ! ======================================================================
 …
   PARAMETER (seuil_neb=0.001)
+  INTEGER nexpo ! exponentiel pour glace/eau
+  PARAMETER (nexpo=6)
+  ! PARAMETER (nexpo=1)
+! JBM (3/14) nexpo is replaced by exposant_glace
+! INTEGER nexpo ! exponentiel pour glace/eau
+! PARAMETER (nexpo=6)
+! PARAMETER (nexpo=1)
+! if iflag_t_glace=0, the old values are used:
+  REAL, PARAMETER :: t_glace_min_old = 258.
+  REAL, PARAMETER :: t_glace_max_old = 273.13
   REAL rel, tc, rei
 …
   reice_pi = 0.
+  DO k = 1, klev
+    DO i = 1, klon
+      ! -layer calculation
+      rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
+      zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
+      dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
+      ! -Fraction of ice in cloud using a linear transition
+      zfice(i, k) = 1.0 - (t(i,k)-t_glace_min)/(t_glace_max-t_glace_min)
+      zfice(i, k) = min(max(zfice(i,k),0.0), 1.0)
+      ! -IM Total Liquid/Ice water content
+      xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
+      xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
+    END DO
+  END DO
+  IF (iflag_t_glace.EQ.0) THEN
+    DO k = 1, klev
+      DO i = 1, klon
+        ! -layer calculation
+        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
+        zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
+        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
+        ! -Fraction of ice in cloud using a linear transition
+        zfice(i, k) = 1.0 - (t(i,k)-t_glace_min_old)/(t_glace_max_old-t_glace_min_old)
+        zfice(i, k) = min(max(zfice(i,k),0.0), 1.0)
+        ! -IM Total Liquid/Ice water content
+        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
+        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
+      END DO
+    END DO
+  ELSE ! of IF (iflag_t_glace.EQ.0)
+    DO k = 1, klev
+      DO i = 1, klon
+        ! -layer calculation
+        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2
+        zrho(i, k) = pplay(i, k)/t(i, k)/rd ! kg/m3
+        dh(i, k) = rhodz(i, k)/zrho(i, k) ! m
+        ! JBM: icefrac_lsc is now a function contained in microphys_mod
+        zfice(i, k) = icefrac_lsc(t(i,k), t_glace_min, &
+                                  t_glace_max, exposant_glace)
+        ! -IM Total Liquid/Ice water content
+        xflwc(i, k) = (1.-zfice(i,k))*pqlwp(i, k)
+        xfiwc(i, k) = zfice(i, k)*pqlwp(i, k)
+      END DO
+    END DO
+  ENDIF
   IF (ok_cdnc) THEN

LMDZ5/branches/testing/libf/phylmd/nuage.F90

-                      r1999
+                      r2056
     cldtaupi, re, fl)
   USE dimphy
+  USE microphys_mod ! cloud microphysics (JBM 3/14)
   IMPLICIT NONE
   ! ======================================================================
 …
   include "YOMCST.h"
+  include "nuage.h" ! JBM 3/14
   ! ym#include "dimensions.h"
 …
   REAL zflwp, zradef, zfice, zmsac
+  REAL radius, rad_froid, rad_chaud, rad_chau1, rad_chau2
+  PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
+  REAL radius, rad_chaud
+! JBM (3/14) parameters already defined in nuage.h:
+! REAL rad_froid, rad_chau1, rad_chau2
+! PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
   ! cc      PARAMETER (rad_chaud=15.0, rad_froid=35.0)
   ! sintex initial      PARAMETER (rad_chaud=10.0, rad_froid=30.0)
   REAL coef, coef_froi, coef_chau
   PARAMETER (coef_chau=0.13, coef_froi=0.09)
+  REAL seuil_neb, t_glace
+  PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0)
+  INTEGER nexpo ! exponentiel pour glace/eau
+  PARAMETER (nexpo=6)
+  REAL seuil_neb
+  PARAMETER (seuil_neb=0.001)
+! JBM (3/14) nexpo is replaced by exposant_glace
+! REAL nexpo ! exponentiel pour glace/eau
+! PARAMETER (nexpo=6.)
+  REAL, PARAMETER :: t_glace_min_old = 258.
+  INTEGER, PARAMETER :: exposant_glace_old = 6
   ! jq for the aerosol indirect effect
 …
       pclc(i, k) = max(pclc(i,k), seuil_neb)
       zflwp = 1000.*pqlwp(i, k)/rg/pclc(i, k)*(paprs(i,k)-paprs(i,k+1))
+      zfice = 1.0 - (t(i,k)-t_glace)/(273.13-t_glace)
+      zfice = min(max(zfice,0.0), 1.0)
+      zfice = zfice**nexpo
+      IF (iflag_t_glace.EQ.0) THEN
+        zfice = 1.0 - (t(i,k)-t_glace_min_old)/(273.13-t_glace_min_old)
+        zfice = min(max(zfice,0.0), 1.0)
+        zfice = zfice**exposant_glace_old
+      ELSE ! of IF (iflag_t_glace.EQ.0)
+! JBM: icefrac_lsc is now a function contained in microphys_mod
+        zfice = icefrac_lsc(t(i,k), t_glace_min, &
+                            t_glace_max, exposant_glace)
+      ENDIF
       IF (ok_aie) THEN

LMDZ5/branches/testing/libf/phylmd/nuage.h

-                      r1910
+                      r2056
+!
       REAL rad_froid, rad_chau1, rad_chau2, t_glace_max, t_glace_min
+      REAL exposant_glace
       REAL rei_min,rei_max
+      INTEGER iflag_t_glace
       common /nuagecom/ rad_froid,rad_chau1, rad_chau2,t_glace_max,     &
+     &                  t_glace_min,rei_min,rei_max
+     &                  t_glace_min,exposant_glace,rei_min,rei_max,     &
+     &                  iflag_t_glace
 !$OMP THREADPRIVATE(/nuagecom/)

LMDZ5/branches/testing/libf/phylmd/oasis.F90

-                      r1999
+                      r2056
     USE surface_data, ONLY : version_ocean
     USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
+#ifdef CPP_XIOS
+    USE wxios, ONLY : wxios_context_init
+#endif
     INCLUDE "dimensions.h"
 …
 ! Define the model name
+!
     clmodnam = 'lmdz.x'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
+    clmodnam = 'LMDZ'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
 …
     ENDIF
+#ifdef CPP_XIOS
+    CALL wxios_context_init()
+#endif
 !$OMP END MASTER

LMDZ5/branches/testing/libf/phylmd/orografi_strato.F90

r1999	r2056
1873	1873	PRINT *, ' DANS SUGWD nktopg=', nktopg
1874	1874	PRINT *, ' DANS SUGWD nstra=', nstra
	1875	if (nstra == 0) call abort_gcm("sugwd_strato", "no level in stratosphere", 1)
1875	1876
1876	1877	gsigcr = 0.80

LMDZ5/branches/testing/libf/phylmd/phyetat0.F90

-                      r1999
+                      r2056
              'coherente ', i, zmasq(i) , pctsrf(i, is_oce) &
              , pctsrf(i, is_sic)
         WRITE(*, *) 'Je force la coherence zmasq=fractint'
         zmasq(i) = fractint(i)
+        WRITE(*, *) 'Je force la coherence zmasq=1.-fractint'
+        zmasq(i) = 1. - fractint(i)
      ENDIF
   END DO
 …
   CALL close_startphy
-  CALL init_iophy_new(rlat, rlon)
   ! Initialize module pbl_surface_mod
 …
   ENDIF
+  CALL init_iophy_new(rlat, rlon)
   ! Initilialize module fonte_neige_mod
   CALL fonte_neige_init(run_off_lic_0)

LMDZ5/branches/testing/libf/phylmd/phys_local_var_mod.F90

-                      r1999
+                      r2056
       allocate(topswcf_aero(klon,3), solswcf_aero(klon,3))
       allocate(d_u_hin(klon,klev),d_v_hin(klon,klev),d_t_hin(klon,klev))
+      allocate(tausum_aero(klon,nwave,naero_spc))
+      allocate(tau3d_aero(klon,klev,nwave,naero_spc))
+!      allocate(tausum_aero(klon,nwave,naero_spc))
+!      allocate(tau3d_aero(klon,klev,nwave,naero_spc))
+!--correction mini bug OB
+      allocate(tausum_aero(klon,nwave,naero_tot))
+      allocate(tau3d_aero(klon,klev,nwave,naero_tot))
       allocate(scdnc(klon, klev))
       allocate(cldncl(klon))

LMDZ5/branches/testing/libf/phylmd/phys_output_ctrlout_mod.F90

-                      r1999
+                      r2056
   USE phys_output_var_mod
   USE indice_sol_mod
   USE aero_mod, only : naero_spc,name_aero
+  USE aero_mod, only : naero_tot,name_aero_tau
 …
     'bils_diss', 'Surf. total heat flux', 'W/m2', (/ ('', i=1, 9) /))
   TYPE(ctrl_out), SAVE :: o_bils_ec = ctrl_out((/ 1, 2, 10, 5, 10, 10, 11, 11, 11 /), &
+    'bils_ec', 'Surf. total heat flux', 'W/m2', (/ ('', i=1, 9) /))
+    'bils_ec', 'Surf. total heat flux correction', 'W/m2', (/ ('', i=1, 9) /))
+  TYPE(ctrl_out), SAVE :: o_bils_ech = ctrl_out((/ 1, 2, 10, 5, 10, 10, 11, 11, 11 /), &
+    'bils_ech', 'Surf. total heat flux correction', 'W/m2', (/ ('', i=1, 9) /))
   TYPE(ctrl_out), SAVE :: o_bils_kinetic = ctrl_out((/ 1, 2, 10, 5, 10, 10, 11, 11, 11 /), &
     'bils_kinetic', 'Surf. total heat flux', 'W/m2', (/ ('', i=1, 9) /))
 …
     'solswai', 'AIE at SFR', 'W/m2', (/ ('', i=1, 9) /))
+!  type(ctrl_out),save,dimension(10) :: o_tausumaero  = (/ ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_ASBCM', &
+!    (/ ('', i=1, 9) /)), &
+  type(ctrl_out),save,dimension(11) :: o_tausumaero  =                           &
+  type(ctrl_out),save,dimension(naero_tot) :: o_tausumaero  =                           &
     (/ ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_ASBCM',                        &
       "Aerosol Optical depth at 550 nm "//name_aero(1),"1", (/ ('', i=1, 9) /)), &
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(1),"1", (/ ('', i=1, 9) /)), &
        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_ASPOMM',                       &
       "Aerosol Optical depth at 550 nm "//name_aero(2),"1", (/ ('', i=1, 9) /)), &
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"1", (/ ('', i=1, 9) /)), &
        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_ASSO4M',                       &
       "Aerosol Optical depth at 550 nm "//name_aero(3),"1", (/ ('', i=1, 9) /)), &
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(3),"1", (/ ('', i=1, 9) /)), &
        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_CSSO4M',                       &
       "Aerosol Optical depth at 550 nm "//name_aero(4),"1", (/ ('', i=1, 9) /)), &
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(4),"1", (/ ('', i=1, 9) /)), &
        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_SSSSM',                        &
       "Aerosol Optical depth at 550 nm "//name_aero(5),"1", (/ ('', i=1, 9) /)), &
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(5),"1", (/ ('', i=1, 9) /)), &
        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_ASSSM',                        &
       "Aerosol Optical depth at 550 nm "//name_aero(6),"1", (/ ('', i=1, 9) /)), &
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(6),"1", (/ ('', i=1, 9) /)), &
        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_CSSSM',                        &
       "Aerosol Optical depth at 550 nm "//name_aero(7),"1", (/ ('', i=1, 9) /)), &
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(7),"1", (/ ('', i=1, 9) /)), &
        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_CIDUSTM',                      &
       "Aerosol Optical depth at 550 nm "//name_aero(8),"1", (/ ('', i=1, 9) /)), &
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(8),"1", (/ ('', i=1, 9) /)), &
        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_AIBCM',                        &
       "Aerosol Optical depth at 550 nm "//name_aero(9),"1", (/ ('', i=1, 9) /)), &
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(9),"1", (/ ('', i=1, 9) /)), &
        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_AIPOMM',                       &
       "Aerosol Optical depth at 550 nm "//name_aero(10),"1", (/ ('', i=1, 9) /)),&
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(10),"1", (/ ('', i=1, 9) /)),&
        ctrl_out((/ 2, 2, 10, 10, 10, 10, 11, 11, 11 /),'OD550_STRAT',                        &
+      "Aerosol Optical depth at 550 nm "//name_aero(11),"1", (/ ('', i=1, 9) /)) /)
+      "Aerosol Optical depth at 550 nm "//name_aero_tau(11),"1", (/ ('', i=1, 9) /)) /)
+!
   TYPE(ctrl_out), SAVE :: o_od550aer = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /), &
     'od550aer', 'Total aerosol optical depth at 550nm', '-', (/ ('', i=1, 9) /))

LMDZ5/branches/testing/libf/phylmd/phys_output_mod.F90

-                      r1999
+                      r2056
   SUBROUTINE phys_output_open(rlon,rlat,pim,tabij,ipt,jpt,plon,plat, &
+       jjmp1,nlevSTD,clevSTD,rlevSTD,nbteta, &
+       ctetaSTD, dtime, ok_veget, &
+       jjmp1,nlevSTD,clevSTD,rlevSTD, dtime, ok_veget, &
        type_ocean, iflag_pbl,ok_mensuel,ok_journe, &
        ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, read_climoz, &
 …
     INTEGER                               :: jjmp1
     INTEGER                               :: nbteta, nlevSTD, radpas
+    INTEGER                               :: nlevSTD, radpas
     LOGICAL                               :: ok_mensuel, ok_journe, ok_hf, ok_instan
     LOGICAL                               :: ok_LES,ok_ade,ok_aie,flag_aerosol_strat
 …
     CHARACTER(LEN=2)                      :: bb3
     CHARACTER(LEN=6)                      :: type_ocean
-    CHARACTER(LEN=3)                      :: ctetaSTD(nbteta)
     INTEGER, DIMENSION(iim*jjmp1)         ::  ndex2d
     INTEGER, DIMENSION(iim*jjmp1*klev)    :: ndex3d
 …
 #ifdef CPP_XIOS
 !!! Ouverture de chaque fichier XIOS !!!!!!!!!!!
+    if (prt_level >= 10) then
+      print*,'phys_output_open: call wxios_add_file with phys_out_filenames(iff)=',trim(phys_out_filenames(iff))
+    endif
     CALL wxios_add_file(phys_out_filenames(iff),chtimestep(iff),lev_files(iff))
-    print*,'wxios_add_file phys_out_filenames(iff)',phys_out_filenames(iff)
 !!! Declaration des axes verticaux de chaque fichier:
+    print*,'Declaration des axes verticaux de chaque fichier '
+    if (prt_level >= 10) then
+      print*,'phys_output_open: Declare vertical axes for each file'
+    endif
    if (iff.le.6) then
     CALL wxios_add_vaxis("presnivs", phys_out_filenames(iff), &
+    CALL wxios_add_vaxis("presnivs", &
             levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff)))
     CALL wxios_add_vaxis("Ahyb", phys_out_filenames(iff), &
+    CALL wxios_add_vaxis("Ahyb", &
             levmax(iff) - levmin(iff) + 1, Ahyb)
     CALL wxios_add_vaxis("Bhyb", phys_out_filenames(iff), &
+    CALL wxios_add_vaxis("Bhyb", &
             levmax(iff) - levmin(iff) + 1, Bhyb)
     CALL wxios_add_vaxis("Ahyb", phys_out_filenames(iff), &
+    CALL wxios_add_vaxis("Alt", &
             levmax(iff) - levmin(iff) + 1, Alt)
    else
+    CALL wxios_add_vaxis("plev", phys_out_filenames(iff), &
+    ! NMC files
+    CALL wxios_add_vaxis("plev", &
             levmax(iff) - levmin(iff) + 1, rlevSTD(levmin(iff):levmax(iff)))
    endif
 …
           else IF (clef_stations(iff)) THEN
+             WRITE(lunout,*)'phys_output_mod phys_out_filenames=',phys_out_filenames(iff)
+             if (prt_level >= 10) then
+             WRITE(lunout,*)'phys_output_open: iff=',iff,'  phys_out_filenames(iff)=',phys_out_filenames(iff)
+             endif
              CALL histbeg_phy_all(rlon,rlat,pim,tabij,ipt,jpt,plon,plat,plon_bounds,plat_bounds, &
                   phys_out_filenames(iff), &
 …
     ecrit_ins = ecrit_files(6)
+    WRITE(lunout,*)'swaero_diag=',swaero_diag
+    WRITE(lunout,*)'Fin phys_output_mod.F90'
+    if (prt_level >= 10) then
+      WRITE(lunout,*)'swaero_diag=',swaero_diag
+      WRITE(lunout,*)'phys_output_open: ends here'
+    endif
   end SUBROUTINE phys_output_open

LMDZ5/branches/testing/libf/phylmd/phys_output_var_mod.F90

-                      r1999
+                      r2056
   !$OMP THREADPRIVATE(itau_con)
   REAL, ALLOCATABLE :: bils_ec(:) ! Contribution of energy conservation
+  REAL, ALLOCATABLE :: bils_ech(:) ! Contribution of energy conservation
   REAL, ALLOCATABLE :: bils_tke(:) ! Contribution of energy conservation
   REAL, ALLOCATABLE :: bils_diss(:) ! Contribution of energy conservation
 …
   REAL, ALLOCATABLE :: bils_enthalp(:) ! bilan de chaleur au sol
   REAL, ALLOCATABLE :: bils_latent(:) ! bilan de chaleur au sol
   !$OMP THREADPRIVATE(bils_ec,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent)
+  !$OMP THREADPRIVATE(bils_ec,bils_ech,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent)
 …
     allocate(snow_o(klon), zfra_o(klon))
     allocate(itau_con(klon))
     allocate (bils_ec(klon),bils_tke(klon),bils_diss(klon),bils_kinetic(klon),bils_enthalp(klon),bils_latent(klon))
+    allocate (bils_ec(klon),bils_ech(klon),bils_tke(klon),bils_diss(klon),bils_kinetic(klon),bils_enthalp(klon),bils_latent(klon))
     IF (ok_gwd_rando) allocate(zustr_gwd_rando(klon), zvstr_gwd_rando(klon))
 …
     deallocate(snow_o,zfra_o,itau_con)
     deallocate (bils_ec,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent)
+    deallocate (bils_ec,bils_ech,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent)
   END SUBROUTINE phys_output_var_end

LMDZ5/branches/testing/libf/phylmd/phys_output_write_mod.F90

-                      r1999
+                      r2056
        ok_ade, ok_aie, ivap, new_aod, ok_sync, &
        ptconv, read_climoz, clevSTD, ptconvth, &
        d_t, qx, d_qx, zmasse, flag_aerosol_strat)
+       d_t, qx, d_qx, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc)
     ! This subroutine does the actual writing of diagnostics that were
 …
          o_LWupSFC, o_LWdnSFC, o_LWupSFCclr, &
          o_LWdnSFCclr, o_bils, o_bils_diss, &
          o_bils_ec, o_bils_tke, o_bils_kinetic, &
+         o_bils_ec,o_bils_ech, o_bils_tke, o_bils_kinetic, &
          o_bils_latent, o_bils_enthalp, o_sens, &
          o_fder, o_ffonte, o_fqcalving, o_fqfonte, &
 …
     USE phys_output_var_mod, only: vars_defined, snow_o, zfra_o, bils_diss, &
          bils_ec, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
+         bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
          itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando
     USE indice_sol_mod, only: nbsrf
 …
     USE comgeomphy, only: airephy
     USE surface_data, only: type_ocean, ok_veget, ok_snow
+    USE aero_mod, only: naero_spc
+!    USE aero_mod, only: naero_spc
+    USE aero_mod, only: naero_tot
     USE ioipsl, only: histend, histsync
     USE iophy, only: set_itau_iophy, histwrite_phy
 …
 #ifdef CPP_XIOS
     ! ug Pour les sorties XIOS
+    USE wxios, only: wxios_update_calendar, wxios_closedef
+    USE xios, ONLY: xios_update_calendar
+    USE wxios, only: wxios_closedef
 #endif
     USE phys_cal_mod, only : mth_len
 …
     REAL, DIMENSION(klon, llm) :: zmasse
     LOGICAL :: flag_aerosol_strat
+    INTEGER :: flag_aerosol
+    LOGICAL :: ok_cdnc
     REAL, DIMENSION(3) :: freq_moyNMC
 …
        IF (vars_defined) THEN
           if (prt_level >= 10) then
              write(lunout,*)"phys_output_write: call wxios_update_calendar, itau_w=",itau_w
+             write(lunout,*)"phys_output_write: call xios_update_calendar, itau_w=",itau_w
           endif
           CALL wxios_update_calendar(itau_w)
+          CALL xios_update_calendar(itau_w)
        END IF
        !$OMP END MASTER
 …
        CALL histwrite_phy(o_bils_diss, bils_diss)
        CALL histwrite_phy(o_bils_ec, bils_ec)
+       IF (iflag_ener_conserv>=1) THEN
+         CALL histwrite_phy(o_bils_ech, bils_ech)
+       ENDIF
        CALL histwrite_phy(o_bils_tke, bils_tke)
        CALL histwrite_phy(o_bils_kinetic, bils_kinetic)
 …
        ! OD550 per species
        IF (new_aod .and. (.not. aerosol_couple)) THEN
           IF (ok_ade.OR.ok_aie) THEN
+          IF (flag_aerosol.GT.0) THEN
              CALL histwrite_phy(o_od550aer, od550aer)
              CALL histwrite_phy(o_od865aer, od865aer)
 …
              !--STRAT AER
           ENDIF
+          IF (ok_ade.OR.ok_aie.OR.flag_aerosol_strat) THEN
+             DO naero = 1, naero_spc
+          IF (flag_aerosol.GT.0.OR.flag_aerosol_strat) THEN
+!             DO naero = 1, naero_spc
+!--correction mini bug OB
+             DO naero = 1, naero_tot
                 CALL histwrite_phy(o_tausumaero(naero), &
                      tausum_aero(:,2,naero) )
 …
           CALL histwrite_phy(o_topswai, topswai_aero)
           CALL histwrite_phy(o_solswai, solswai_aero)
+       ENDIF
+       IF (flag_aerosol.GT.0.AND.ok_cdnc) THEN
           CALL histwrite_phy(o_scdnc, scdnc)
           CALL histwrite_phy(o_cldncl, cldncl)

LMDZ5/branches/testing/libf/phylmd/phys_state_var_mod.F90

-                      r1999
+                      r2056
       REAL,SAVE,ALLOCATABLE :: tau_aero(:,:,:,:), piz_aero(:,:,:,:), cg_aero(:,:,:,:)
 !$OMP THREADPRIVATE(tau_aero, piz_aero, cg_aero)
+      REAL,SAVE,ALLOCATABLE :: tau_aero_rrtm(:,:,:,:), piz_aero_rrtm(:,:,:,:), cg_aero_rrtm(:,:,:,:)
+!$OMP THREADPRIVATE(tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm)
       REAL,SAVE,ALLOCATABLE :: ccm(:,:,:)
 !$OMP THREADPRIVATE(ccm)
 …
       ALLOCATE(topswai(klon), solswai(klon))
       ALLOCATE(tau_aero(klon,klev,naero_grp,nbands),piz_aero(klon,klev,naero_grp,nbands),cg_aero(klon,klev,naero_grp,nbands))
+      ALLOCATE(tau_aero_rrtm(klon,klev,2,nbands_rrtm),piz_aero_rrtm(klon,klev,2,nbands_rrtm))
+      ALLOCATE(cg_aero_rrtm(klon,klev,2,nbands_rrtm))
       ALLOCATE(ccm(klon,klev,nbands))
 …
       deallocate(topswai, solswai)
       deallocate(tau_aero,piz_aero,cg_aero)
+      deallocate(tau_aero_rrtm,piz_aero_rrtm,cg_aero_rrtm)
       deallocate(ccm)
       if (ok_gwd_rando) deallocate(du_gwd_rando, dv_gwd_rando)

LMDZ5/branches/testing/libf/phylmd/physiq.F90

-                      r1999
+                      r2056
      flxmass_w, &
      d_u, d_v, d_t, d_qx, d_ps &
+     , dudyn &
+     , PVteta)
+     , dudyn)
   USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
 …
   USE indice_sol_mod
   USE phytrac_mod, ONLY : phytrac
+#ifdef CPP_RRTM
+  USE YOERAD   , ONLY : NRADLP
+#endif
   !IM stations CFMIP
 …
   !! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
   !! d_ps----output-R-tendance physique de la pression au sol
-  !!IM
-  !! PVteta--output-R-vorticite potentielle a des thetas constantes
   !!======================================================================
   include "dimensions.h"
 …
   ! Variables pour le transport convectif
   real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
+  real wght_cvfd(klon,klev)
   ! Variables pour le lessivage convectif
   ! RomP >>>
 …
   !IM definition dynamique o_trac dans phys_output_open
   !      type(ctrl_out) :: o_trac(nqtot)
+  !
+  !IM Amip2 PV a theta constante
+  !
+  INTEGER nbteta
+  PARAMETER(nbteta=3)
+  CHARACTER*3 ctetaSTD(nbteta)
+  DATA ctetaSTD/'350','380','405'/
+  SAVE ctetaSTD
+  !$OMP THREADPRIVATE(ctetaSTD)
+  REAL rtetaSTD(nbteta)
+  DATA rtetaSTD/350., 380., 405./
+  SAVE rtetaSTD
+  !$OMP THREADPRIVATE(rtetaSTD)
+  !
+  REAL PVteta(klon,nbteta)
+  !
+  !MI Amip2 PV a theta constante
+  !ym      INTEGER klevp1, klevm1
+  !ym      PARAMETER(klevp1=klev+1,klevm1=klev-1)
+  !ym      include "raddim.h"
+  !
+  !
+  !IM Amip2
   ! variables a une pression donnee
+  !
 …
   EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
   !AA
+  EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
+! JBM (3/14) fisrtilp_tr not loaded
+! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
   !                          ! stockage des coefficients necessaires au
   !                          ! lessivage OFF-LINE et ON-LINE
 …
      call phys_output_open(rlon,rlat,nCFMIP,tabijGCM, &
           iGCM,jGCM,lonGCM,latGCM, &
+          jjmp1,nlevSTD,clevSTD,rlevSTD, &
+          nbteta, ctetaSTD, dtime,ok_veget, &
+          jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, &
           type_ocean,iflag_pbl,ok_mensuel,ok_journe, &
           ok_hf,ok_instan,ok_LES,ok_ade,ok_aie,  &
 …
      IF (klon_glo==1) THEN
         CALL add_pbl_tend &
           (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,'vdf')
+          (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')
      ELSE
         CALL add_phys_tend &
           (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,'vdf')
+          (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')
      ENDIF
      !--------------------------------------------------------------------
 …
              ftd,fqd,lalim_conv,wght_th, &
              ev, ep,epmlmMm,eplaMm, &
              wdtrainA,wdtrainM)
+             wdtrainA,wdtrainM,wght_cvfd)
         ! RomP <<<
 …
   !-----------------------------------------------------------------------------------------
   ! ajout des tendances de la diffusion turbulente
   CALL add_phys_tend(d_u_con,d_v_con,d_t_con,d_q_con,dql0,'con')
+  CALL add_phys_tend(d_u_con,d_v_con,d_t_con,d_q_con,dql0,paprs,'con')
   !-----------------------------------------------------------------------------------------
 …
      d_t_wake(:,:)=dt_wake(:,:)*dtime
      d_q_wake(:,:)=dq_wake(:,:)*dtime
      CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,'wake')
+     CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,paprs,'wake')
      !-----------------------------------------------------------------------------------------
 …
            ENDIF
            !----Initialisations
            do i=1,klon
 …
                    s_trig,s2,n2
            ENDIF
+!Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
+           IF (iflag_trig_bl.eq.1) then
            !----Tirage al\'eatoire et calcul de ale_bl_trig
 …
               endif
            enddo
+           ELSE IF (iflag_trig_bl.eq.2) then
+           do i=1,klon
+              if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) )  then
+                 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
+                      (n2(i)*dtime/tau_trig(i))
+                 !        print *, 'proba_notrig(i) ',proba_notrig(i)
+                 if (random_notrig(i) .ge. proba_notrig(i)) then
+                    ale_bl_trig(i)=Ale_bl(i)
+                 else
+                    ale_bl_trig(i)=0.
+                 endif
+              else
+                 proba_notrig(i)=1.
+                 random_notrig(i)=0.
+                 ale_bl_trig(i)=0.
+              endif
+           enddo
+           ENDIF
+           !
            IF (prt_level .GE. 10) THEN
 …
         !-----------Statistical closure-----------
+        if (iflag_clos_bl.ge.1) then
+        if (iflag_clos_bl.eq.1) then
+           do i=1,klon
+!CR: alp probabiliste
+               if (ale_bl_trig(i).gt.0.) then
+                  alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
+               endif
+           enddo
+        else if (iflag_clos_bl.eq.2) then
+!CR: alp calculee dans thermcell_main
            do i=1,klon
               alp_bl(i)=alp_bl_stat(i)
 …
         do i=1,klon
+           zmax_th(i)=pphi(i,lmax_th(i))/rg
+!           zmax_th(i)=pphi(i,lmax_th(i))/rg
+!CR:04/05/12:correction calcul zmax
+         zmax_th(i)=zmax0(i)
         enddo
 …
         !-----------------------------------------------------------------------------------------
         ! ajout des tendances de l'ajustement sec ou des thermiques
         CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,'ajsb')
+        CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,paprs,'ajsb')
         d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
         d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
 …
   !-----------------------------------------------------------------------------------------
   ! ajout des tendances de la diffusion turbulente
   CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,'lsc')
+  CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,paprs,'lsc')
   !-----------------------------------------------------------------------------------------
   DO k = 1, klev
 …
      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
      IF (flag_aerosol .gt. 0) THEN
+        IF (.NOT. aerosol_couple) &
+        IF (.NOT. aerosol_couple) THEN
+           IF (iflag_rrtm .EQ. 0) THEN !--old radiation
+!
              CALL readaerosol_optic( &
              debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
 …
              tau_aero, piz_aero, cg_aero,  &
              tausum_aero, tau3d_aero)
+!
+           ELSE                       ! RRTM radiation
+!
+#ifdef CPP_RRTM
+             CALL readaerosol_optic_rrtm( &
+             debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
+             pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
+             mass_solu_aero, mass_solu_aero_pi,  &
+             tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,  &
+             tausum_aero, tau3d_aero)
+#else
+            abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
+            call abort_gcm(modname,abort_message,1)
+#endif
+!
+           ENDIF
+        ENDIF
      ELSE
         tausum_aero(:,:,:) = 0.
+        tau_aero(:,:,:,:) = 0.
+        piz_aero(:,:,:,:) = 0.
+        cg_aero(:,:,:,:)  = 0.
+        IF (iflag_rrtm .EQ. 0) THEN !--old radiation
+          tau_aero(:,:,:,:) = 0.
+          piz_aero(:,:,:,:) = 0.
+          cg_aero(:,:,:,:)  = 0.
+        ELSE
+          tau_aero_rrtm(:,:,:,:)=0.0
+          piz_aero_rrtm(:,:,:,:)=0.0
+          cg_aero_rrtm(:,:,:,:)=0.0
+        ENDIF
      ENDIF
+     !
 …
      IF (flag_aerosol_strat) THEN
         PRINT *,'appel a readaerosolstrat', mth_cur
+        CALL readaerosolstrato(debut)
+        IF (iflag_rrtm.EQ.0) THEN
+         CALL readaerosolstrato(debut)
+        ELSE
+#ifdef CPP_RRTM
+         CALL readaerosolstrato_rrtm(debut)
+#else
+         abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
+         call abort_gcm(modname,abort_message,1)
+#endif
+        ENDIF
      ENDIF
      !--fin STRAT AEROSOL
 …
   if (ok_newmicro) then
+     IF (iflag_rrtm.NE.0) THEN
+#ifdef CPP_RRTM
+       IF (ok_cdnc.AND.NRADLP.NE.3) THEN
+         abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 pour ok_cdnc'
+         call abort_gcm(modname,abort_message,1)
+       endif
+#else
+       abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
+       call abort_gcm(modname,abort_message,1)
+#endif
+     ENDIF
      CALL newmicro (ok_cdnc, bl95_b0, bl95_b1, &
           paprs, pplay, t_seri, cldliq, cldfra, &
 …
              flag_aerosol_strat, &
              tau_aero, piz_aero, cg_aero, &
+             tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,&     ! Rajoute par OB pour RRTM
              cldtaupirad,new_aod, &
              zqsat, flwc, fiwc, &
 …
                    flag_aerosol_strat, &
                    tau_aero, piz_aero, cg_aero, &
+                   tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,&     ! Rajoute par OB pour RRTM
                    cldtaupi,new_aod, &
                    zqsat, flwc, fiwc, &
 …
      !-----------------------------------------------------------------------------------------
      ! ajout des tendances de la trainee de l'orographie
      CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,'oro')
+     CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,paprs,'oro')
      !-----------------------------------------------------------------------------------------
+     !
 …
      !-----------------------------------------------------------------------------------------
      ! ajout des tendances de la portance de l'orographie
      CALL add_phys_tend(d_u_lif,d_v_lif,d_t_lif,dq0,dql0,'lif')
+     CALL add_phys_tend(d_u_lif,d_v_lif,d_t_lif,dq0,dql0,paprs,'lif')
      !-----------------------------------------------------------------------------------------
+     !
 …
+     !
      !  ajout des tendances
      CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,'hin')
+     CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,paprs,'hin')
   ENDIF
 …
           rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
           du_gwd_rando, dv_gwd_rando)
      CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, &
+     CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0,paprs, &
           'flott_gwd_rando')
   end if
 …
        pmflxr,   pmflxs,    prfl,     psfl, &
        da,       phi,       mp,       upwd, &
        phi2,     d1a,       dam,      sij, &        !<<RomP
+       phi2,     d1a,       dam,      sij, wght_cvfd, &        !<<RomP+RL
        wdtrainA, wdtrainM,  sigd,     clw,elij, &   !<<RomP
        ev,       ep,        epmlmMm,  eplaMm, &     !<<RomP
 …
        ptconv, read_climoz, clevSTD,                   &
        ptconvth, d_t, qx, d_qx, zmasse,                &
        flag_aerosol_strat)
+       flag_aerosol, flag_aerosol_strat, ok_cdnc)

LMDZ5/branches/testing/libf/phylmd/phytrac_mod.F90

-                      r1910
+                      r2056
 CONTAINS
 SUBROUTINE phytrac(                            &
      nstep,     julien,   gmtime,   debutphy,  &
      lafin,     pdtphys,  u, v,     t_seri,    &
      paprs,     pplay,    pmfu,     pmfd,      &
      pen_u,     pde_u,    pen_d,    pde_d,     &
      cdragh,    coefh,    fm_therm, entr_therm,&
      yu1,       yv1,      ftsol,    pctsrf,    &
      ustar,     u10m,      v10m,               &
      wstar,     ale_bl,      ale_wake,         &
      xlat,      xlon,                          &
      frac_impa,frac_nucl,beta_fisrt,beta_v1,   &
      presnivs,  pphis,    pphi,     albsol,    &
      sh,        rh,       cldfra,   rneb,      &
      diafra,    cldliq,   itop_con, ibas_con,  &
      pmflxr,    pmflxs,   prfl,     psfl,      &
      da,        phi,      mp,       upwd,      &
      phi2,      d1a,      dam,      sij,       &   ! RomP
      wdtrainA,  wdtrainM, sigd,     clw,elij,  &   ! RomP
      evap,      ep,       epmlmMm,  eplaMm,    &   ! RomP
      dnwd,      aerosol_couple,     flxmass_w, &
      tau_aero,  piz_aero,  cg_aero, ccm,       &
      rfname,                                   &
      d_tr_dyn,                                 &   ! RomP
+SUBROUTINE phytrac(                                 &
+     nstep,     julien,   gmtime,   debutphy,       &
+     lafin,     pdtphys,  u, v,     t_seri,         &
+     paprs,     pplay,    pmfu,     pmfd,           &
+     pen_u,     pde_u,    pen_d,    pde_d,          &
+     cdragh,    coefh,    fm_therm, entr_therm,     &
+     yu1,       yv1,      ftsol,    pctsrf,         &
+     ustar,     u10m,      v10m,                    &
+     wstar,     ale_bl,      ale_wake,              &
+     xlat,      xlon,                               &
+     frac_impa,frac_nucl,beta_fisrt,beta_v1,        &
+     presnivs,  pphis,    pphi,     albsol,         &
+     sh,        rh,       cldfra,   rneb,           &
+     diafra,    cldliq,   itop_con, ibas_con,       &
+     pmflxr,    pmflxs,   prfl,     psfl,           &
+     da,        phi,      mp,       upwd,           &
+     phi2,      d1a,      dam,      sij, wght_cvfd, &   ! RomP +RL
+     wdtrainA,  wdtrainM, sigd,     clw, elij,      &   ! RomP
+     evap,      ep,       epmlmMm,  eplaMm,         &   ! RomP
+     dnwd,      aerosol_couple,     flxmass_w,      &
+     tau_aero,  piz_aero,  cg_aero, ccm,            &
+     rfname,                                        &
+     d_tr_dyn,                                      &   ! RomP
      tr_seri)
+!
 …
   REAL,DIMENSION(klon,klev),INTENT(IN)      :: ep
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
+  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd          !RL
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
   REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
 …
+!
           CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep,              &
+               sigd,sij,clw,elij,epmlmMm,eplaMm,                        &
+!!               sigd,sij,clw,elij,epmlmMm,eplaMm,                        &   !RL
+               sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,              &     !RL
                pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM,             &
                paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con,            &
 …
                zmfd1a,zmfphi2,zmfdam)
         else  !pas de lessivage convectif ou n'est pas un aerosol
+           CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,&
+                    upwd,dnwd,d_tr_cv)
+!!           CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,&      !jyg
+!!                    upwd,dnwd,d_tr_cv)                                      !jyg
+           CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,pplay, &  !jyg
+                    tr_seri,upwd,dnwd,d_tr_cv)                                !jyg
         endif
         END IF

LMDZ5/branches/testing/libf/phylmd/radlwsw_m.F90

Property svn:keywords set to Author Date Id Revi

-                      r1999
+                      r2056
+!
+! $Id$
+!
 module radlwsw_m
 …
    flag_aerosol_strat,&
    tau_aero, piz_aero, cg_aero,&
+   tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,& ! rajoute par OB pour RRTM
    cldtaupi, new_aod, &
    qsat, flwc, fiwc, &
 …
 !    &    RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF, RLINLI
       USE YOERDU   , ONLY : NUAER  ,NTRAER ,REPLOG ,REPSC  ,REPSCW ,DIFF
       USE YOETHF   , ONLY : RTICE
+!      USE YOETHF   , ONLY : RTICE
       USE YOERRTWN , ONLY : DELWAVE   ,TOTPLNK
       USE YOMPHY3  , ONLY : RII0
 …
   REAL,    INTENT(in)  :: piz_aero(KLON,KLEV,9,2)                        ! aerosol optical properties (see aeropt.F)
   REAL,    INTENT(in)  :: cg_aero(KLON,KLEV,9,2)                         ! aerosol optical properties (see aeropt.F)
+!--OB
+  REAL,    INTENT(in)  :: tau_aero_rrtm(KLON,KLEV,2,NSW)                 ! aerosol optical properties RRTM
+  REAL,    INTENT(in)  :: piz_aero_rrtm(KLON,KLEV,2,NSW)                 ! aerosol optical properties RRTM
+  REAL,    INTENT(in)  :: cg_aero_rrtm(KLON,KLEV,2,NSW)                  ! aerosol optical properties RRTM
+!--OB fin
   REAL,    INTENT(in)  :: cldtaupi(KLON,KLEV)                            ! cloud optical thickness for pre-industrial aerosol concentrations
   LOGICAL, INTENT(in)  :: new_aod                                        ! flag pour retrouver les resultats exacts de l'AR4 dans le cas ou l'on ne travaille qu'avec les sulfates
 …
       REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted)
       REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted)
+!--OB
+      REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted)
+      REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted)
+!--end OB
       REAL(KIND=8) paprs_i(klon,klev+1)
       REAL(KIND=8) pplay_i(klon,klev)
 …
       REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1)
       REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1)
+      REAL(KIND=8) PPIZA_DST(klon,klev,NSW)
+      REAL(KIND=8) PCGA_DST(klon,klev,NSW)
+      REAL(KIND=8) PTAUREL_DST(klon,klev,NSW)
+      REAL(KIND=8) PPIZA_TOT(klon,klev,NSW)
+      REAL(KIND=8) PCGA_TOT(klon,klev,NSW)
+      REAL(KIND=8) PTAU_TOT(klon,klev,NSW)
+      REAL(KIND=8) PPIZA_NAT(klon,klev,NSW)
+      REAL(KIND=8) PCGA_NAT(klon,klev,NSW)
+      REAL(KIND=8) PTAU_NAT(klon,klev,NSW)
       REAL(KIND=8) PSFSWDIR(klon,NSW)
       REAL(KIND=8) PSFSWDIF(klon,NSW)
 …
 !      REAL(KIND=8) SUN_FRACT(2)
   real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
+!--OB
+      REAL tau(6), alt, zdz, zrho
+      character (len=20) :: modname='radlwsw'
+      character (len=80) :: abort_message
+  CHARACTER (LEN=80) :: abort_message
+  CHARACTER (LEN=80) :: modname='radlwsw_m'
   call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
 …
       ENDDO
       ENDDO
+!
+!--OB Valeurs de tau(NSW) calculees par O.Boucher (MPL 20130417)
+!-- voir aod_2bands.F90, aod_4bands.F90, aod_6bands.F90 dans BENCH48x36x19
+      SELECT CASE (NSW)
+      CASE (2)
+       tau(1)=0.22017828
+       tau(2)=0.110565394
+      CASE (4)
+       tau(1)=0.22017743
+       tau(2)=0.12738435
+       tau(3)=0.07157799
+       tau(4)=0.03301198
+      CASE (6)
+       tau(1)=0.49999997
+       tau(2)=0.28593913
+       tau(3)=0.20057647
+       tau(4)=0.12738435
+       tau(5)=0.07157799
+       tau(6)=0.03301198
+      END SELECT
+!     tau1=0.2099  ! anciennes valeurs de Nicolas Huneeus (20130326)
+!     tau2=0.1022
+!     tau(1)=1.0e-15
+!     tau(2)=1.0e-15
+!     tau(3)=1.0e-15
+!     tau(4)=1.0e-15
+!     tau(5)=1.0e-15
+!     tau(6)=1.0e-15
+      print *,'Radlwsw: NSW tau= ',NSW,tau(:)
+      DO i = 1, kdlon
+      alt=0.0
+!
+!--OB
+!--aerosol TOT  - anthropogenic+natural
+!--aerosol NAT  - natural only
+!
+      DO i = 1, kdlon
       DO k = 1, kflev
-      zrho=pplay(i,k)/t(i,k)/RD
-      zdz=(paprs(i,k)-paprs(i,k+1))/zrho/RG
       DO kk=1, NSW
+      PTAUREL_DST(i,kflev+1-k,kk)=(tau(kk)/2000.0)*max(0.0,min(zdz,2000.0-alt))
+      PTAUREL_DST(i,kflev+1-k,kk)=MAX(PTAUREL_DST(i,kflev+1-k,kk), 1e-15)
+      ENDDO
+      alt=alt+zdz
+      ENDDO
+      ENDDO
+!
+      DO k = 1, kflev
+      DO i = 1, kdlon
+      DO kk = 1, NSW
+!     PPIZA_DST(i,k,kk)=1.0
+      PPIZA_DST(i,k,kk)=0.8
+      PCGA_DST(i,k,kk)=0.7
+      ENDDO
+      ENDDO
+      ENDDO
+!
+      PTAU_TOT(i,kflev+1-k,kk)=tau_aero_rrtm(i,k,2,kk)
+      PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_rrtm(i,k,2,kk)
+      PCGA_TOT(i,kflev+1-k,kk)=cg_aero_rrtm(i,k,2,kk)
+!
+      PTAU_NAT(i,kflev+1-k,kk)=tau_aero_rrtm(i,k,1,kk)
+      PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_rrtm(i,k,1,kk)
+      PCGA_NAT(i,kflev+1-k,kk)=cg_aero_rrtm(i,k,1,kk)
+!
+      ENDDO
+      ENDDO
+      ENDDO
+!-end OB
+!
+!
       DO i = 1, kdlon
 …
             ref_liq_i(1:klon,k) =ref_liq(1:klon,klev+1-k)
             ref_ice_i(1:klon,k) =ref_ice(1:klon,klev+1-k)
+!-OB
+            ref_liq_pi_i(1:klon,k) =ref_liq_pi(1:klon,klev+1-k)
+            ref_ice_pi_i(1:klon,k) =ref_ice_pi(1:klon,klev+1-k)
          enddo
          do k=1,kflev
 …
 ! Nouvel appel a RECMWF (celui du cy32t0)
          CALL RECMWF (ist , iend, klon , ktdia  , klev   , kmode ,&
+         CALL RECMWF_AERO (ist , iend, klon , ktdia  , klev   , kmode ,&
          PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2   , cldfra_i,&
          POZON_i  , PAER_i  , PDP_i   , PEMIS   , rmu0   ,&
           q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,&
          ref_liq_i, ref_ice_i, &
+         ref_liq_pi_i, ref_ice_pi_i, &   ! rajoute par OB pour diagnostiquer effet indirect
          ZEMTD_i  , ZEMTU_i , ZTRSO_i ,&
          ZTH_i    , ZCTRSO  , ZCEMTR  , ZTRSOD  ,&
          ZLWFC    , ZLWFT_i , ZSWFC   , ZSWFT_i ,&
          PSFSWDIR , PSFSWDIF, PFSDNN  , PFSDNV  ,&
+         PPIZA_DST, PCGA_DST,PTAUREL_DST,ZFLUX_i  , ZFLUC_i ,&
+         ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i)
+         PPIZA_TOT, PCGA_TOT,PTAU_TOT,&
+         PPIZA_NAT, PCGA_NAT,PTAU_NAT,           &  ! rajoute par OB pour diagnostiquer effet direct
+         ZFLUX_i  , ZFLUC_i ,&
+         ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i,&
+         ZTOPSWADAERO,ZSOLSWADAERO,&  ! rajoute par OB pour diagnostics
+         ZTOPSWAD0AERO,ZSOLSWAD0AERO,&
+         ZTOPSWAIAERO,ZSOLSWAIAERO, &
+         ZTOPSWCF_AERO,ZSOLSWCF_AERO, &
+         ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat) ! flags aerosols
          print *,'RADLWSW: apres RECMWF'
 …
         CALL writefield_phy('pfsdnn',PFSDNN,1)
         CALL writefield_phy('pfsdnv',PFSDNV,1)
         CALL writefield_phy('ppiza_dst',PPIZA_DST,klev)
         CALL writefield_phy('pcga_dst',PCGA_DST,klev)
         CALL writefield_phy('ptaurel_dst',PTAUREL_DST,klev)
+        CALL writefield_phy('ppiza_dst',PPIZA_TOT,klev)
+        CALL writefield_phy('pcga_dst',PCGA_TOT,klev)
+        CALL writefield_phy('ptaurel_dst',PTAU_TOT,klev)
         CALL writefield_phy('zflux_i',ZFLUX_i,klev+1)
         CALL writefield_phy('zfluc_i',ZFLUC_i,klev+1)
 …
 !  ZSWFC        (KPROMA,2)       ; CLEAR-SKY SHORTWAVE FLUXES
 !  ZSWFT        (KPROMA,KLEV+1)  ; TOTAL-SKY SHORTWAVE FLUXES
+!  PPIZA_DST    (KPROMA,KLEV,NSW); Single scattering albedo of dust
+!  PCGA_DST     (KPROMA,KLEV,NSW); Assymetry factor for dust
+!  PTAUREL_DST  (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm
+!  PPIZA_TOT    (KPROMA,KLEV,NSW); Single scattering albedo of total aerosols
+!  PCGA_TOT     (KPROMA,KLEV,NSW); Assymetry factor for total aerosols
+!  PTAU_TOT     (KPROMA,KLEV,NSW); Optical depth of total aerosols
+!  PPIZA_NAT    (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosols
+!  PCGA_NAT     (KPROMA,KLEV,NSW); Assymetry factor for natural aerosols
+!  PTAU_NAT     (KPROMA,KLEV,NSW); Optical depth of natiral aerosols
 !  PSFSWDIR     (KPROMA,NSW)     ;
 !  PSFSWDIF     (KPROMA,NSW)     ;
 …
          ENDDO
       ENDDO
+!--ajout OB
+      ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:)
+      ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:)
+      ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:)
+      ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:)
+      ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:)
+      ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:)
+      ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:)
+      ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:)
+      ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:)
+      ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:)
+      ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:)
+      ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:)
 !     print*,'SW_RRTM ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)

LMDZ5/branches/testing/libf/phylmd/readaerosol_optic.F90

Property svn:keywords set to Author Date Id Revision

-                      r1910
+                      r2056
   REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
   REAL, DIMENSION(klon,klev,naero_grp,nbands), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
+  REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT)       :: tausum_aero
+  REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT)  :: tau3d_aero
+!  REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT)       :: tausum_aero
+!  REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT)  :: tau3d_aero
+!--correction mini bug OB
+  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)       :: tausum_aero
+  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
 ! Local variables

LMDZ5/branches/testing/libf/phylmd/rrtm/eq_regions_mod.F90

-                      r1999
+                      r2056
 integer(kind=jpim) :: my_region_ew
 integer(kind=jpim),allocatable :: n_regions(:)
+!$OMP THREADPRIVATE(l_regions_debug,my_region_ew,my_region_ns,n_regions_ew,n_regions_ns,pi,n_regions)
 CONTAINS

LMDZ5/branches/testing/libf/phylmd/rrtm/gfl_subs.F90

-                      r1999
+                      r2056
 TYPE(TYPE_GFL_COMP)  :: YCPF_SAVE ! For saving status of cloud fields
 LOGICAL :: L_CLD_DEACT=.FALSE.
+!$OMP THREADPRIVATE(l_cld_deact,ya_save,ycpf_save,yi_save,yl_save,ylastgflc,yptrc,yr_save,ys_save)
 #include "abor1.intfb.h"
 …
 LOGICAL,SAVE :: LLFIRSTCALL = .TRUE.
 REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!$OMP THREADPRIVATE(llfirstcall)
 !-------------------------------------------------------------------------

LMDZ5/branches/testing/libf/phylmd/rrtm/lwu.F90

Property svn:keywords set to Author Date Id Revi

-                      r1999
+                      r2056
+!
+! $Id$
+!
 SUBROUTINE LWU &
  & ( KIDIA, KFDIA, KLON, KLEV,&
 …
  & ALWT     ,BLWT     ,RO3T     ,RT1      ,TREF     ,&
  & RVGCO2   ,RVGH2O   ,RVGO3
 USE YOERDI   , ONLY : RCH4     ,RN2O     ,RCFC11   ,RCFC12
+!USE YOERDI   , ONLY : RCH4     ,RN2O     ,RCFC11   ,RCFC12
 USE YOERDU   , ONLY : R10E     ,REPSCO   ,REPSCQ
 IMPLICIT NONE
 …
 REAL(KIND=JPRB)   ,INTENT(IN)    :: PWV(KLON,KLEV)
 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PABCU(KLON,NUA,3*KLEV+1)
+#include "clesphys.h"
 !-----------------------------------------------------------------------
 …
  & ZUPMH2O, ZUPMO3, ZZABLY
 REAL(KIND=JPRB) :: ZHOOK_HANDLE
 !-----------------------------------------------------------------------
 …
 !      print *,'END OF LWU'
 !-----------------------------------------------------------------------

LMDZ5/branches/testing/libf/phylmd/rrtm/mod_const_para.F90

-                      r1999
+                      r2056
   INTEGER :: COMM_LMDZ
   INTEGER :: MPI_REAL_LMDZ
+!$OMP THREADPRIVATE(comm_lmdz,mpi_real_lmdz)
 CONTAINS

LMDZ5/branches/testing/libf/phylmd/rrtm/radlsw.F90

-                      r1999
+                      r2056
  & RLILIA   ,RLILIB
 USE YOERDU        , ONLY : NUAER    ,NTRAER   ,REPLOG   ,REPSC    ,REPSCW   ,DIFF
 USE YOETHF        , ONLY : RTICE
+!USE YOETHF        , ONLY : RTICE
 USE YOEPHLI       , ONLY : LPHYLIN
 USE YOERRTWN      , ONLY :                     DELWAVE   ,TOTPLNK
 …
 include "clesphys.h"
+include "YOETHF.h"
 INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
 INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV

LMDZ5/branches/testing/libf/phylmd/rrtm/rrtm_ecrt_140gp.F90

Property svn:keywords set to Author Date Id Revi

-                      r1999
+                      r2056
+!
+! $Id$
+!
 !****************** SUBROUTINE RRTM_ECRT_140GP **************************
 …
  & JPINPX
 USE YOERAD   , ONLY : NOVLP
 USE YOERDI   , ONLY :    RCH4     ,RN2O    ,RCFC11  ,RCFC12
+!USE YOERDI   , ONLY :    RCH4     ,RN2O    ,RCFC11  ,RCFC12
 USE YOESW    , ONLY : RAER
 !------------------------------Arguments--------------------------------
 IMPLICIT NONE
+#include "clesphys.h"
 INTEGER(KIND=JPIM),INTENT(IN)    :: KLON! Number of atmospheres (longitudes)
 INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV! Number of atmospheric layers
 …
 !     ------------------------------------------------------------------
 IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP',1,ZHOOK_HANDLE)
 END SUBROUTINE RRTM_ECRT_140GP

LMDZ5/branches/testing/libf/phylmd/rrtm/rrtm_taumol1.F90

-                      r1999
+                      r2056
 IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL1',0,ZHOOK_HANDLE)
+!--ajout OB
+IF (K_LAYTROP.GT.100) THEN
+PRINT *,'ATTENTION KLAY_TROP > 100 PROBLEME ARRAY DANS RRTM ON ARRETE'
+STOP
+!--fin ajout OB
+ENDIF
 DO I_LAY = 1, K_LAYTROP
   IND0(I_LAY) = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(1) + 1

LMDZ5/branches/testing/libf/phylmd/rrtm/srtm_srtm_224gp.F90

Property svn:keywords set to Author Date Id Revi

-                      r1999
+                      r2056
+!
+! $Id$
+!
 SUBROUTINE SRTM_SRTM_224GP &
  & ( KIDIA , KFDIA  , KLON  , KLEV  , KSW , KOVLP ,&
 …
 USE PARSRTM  , ONLY : JPLAY
 USE YOERDI   , ONLY : RCH4   , RN2O
+!USE YOERDI   , ONLY : RCH4   , RN2O
 USE YOERAD   , ONLY : NAER
 USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA
 …
 USE YOMCST   , ONLY : RI0
 IMPLICIT NONE
+#include "clesphys.h"
 !-- Input arguments

LMDZ5/branches/testing/libf/phylmd/rrtm/sucst.F90

-                      r1999
+                      r2056
   WRITE(KULOUT,'(10(1X,E10.4))') (ESW(RTT+10._JPRB*J),J=-4,4)
   WRITE(KULOUT,'(10(1X,E10.4))') (ESS(RTT+10._JPRB*J),J=-4,4)
   call flush()       !!!!! A REVOIR (MPL) les 7 lignes qui suivent
+!  call flush(0)       !!!!! A REVOIR (MPL) les 7 lignes qui suivent
    do j=1,9
      print*,'TEST J',j
 …
      print*,'ES(RTT...',ES(RTT+10._JPRB*(J-5))
    enddo
   call flush()
+  call flush(0)
   WRITE(KULOUT,'(10(1X,E10.4))') (ES (RTT+10._JPRB*J),J=-4,4)

LMDZ5/branches/testing/libf/phylmd/rrtm/suecrad.F90

Property svn:keywords set to Author Date Id Revi

-                      r1999
+                      r2056
+!
+! $Id$
+!
 SUBROUTINE SUECRAD (KULOUT, KLEV, PETAH )
 …
 !       LECMWF = .FALSE.
 ENDIF
+!LRRTM  = .FALSE.
 !- SRTM as SW scheme
 !!!!! A REVOIR (MPL) verifier signification de LSRTM
 …
 !     ------------------------------------------------------------------
 IF (LHOOK) CALL DR_HOOK('SUECRAD',1,ZHOOK_HANDLE)
 END SUBROUTINE SUECRAD

LMDZ5/branches/testing/libf/phylmd/rrtm/suphec.F90

-                      r1999
+                      r2056
 USE YOMCST   , ONLY : RD       ,RV       ,RCPD     ,&
  & RLVTT    ,RLSTT    ,RLMLT    ,RTT      ,RATM
 USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
  & R4IES    ,R5LES    ,R5IES    ,RVTMP2   ,RHOH2O   ,&
  & R5ALVCP  ,R5ALSCP  ,RALVDCP  ,RALSDCP  ,RALFDCP  ,&
  & RTWAT    ,RTBER    ,RTBERCU  ,RTICE    ,RTICECU  ,&
  & RTWAT_RTICE_R      ,RTWAT_RTICECU_R    ,&
  & RKOOP1   ,RKOOP2
+!USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
+! & R4IES    ,R5LES    ,R5IES    ,RVTMP2   ,RHOH2O   ,&
+! & R5ALVCP  ,R5ALSCP  ,RALVDCP  ,RALSDCP  ,RALFDCP  ,&
+! & RTWAT    ,RTBER    ,RTBERCU  ,RTICE    ,RTICECU  ,&
+! & RTWAT_RTICE_R      ,RTWAT_RTICECU_R    ,&
+! & RKOOP1   ,RKOOP2
 USE YOMPHY   , ONLY : LRAYFM15
 !USE YOERAD   , ONLY : NSW      ,NTSW     ,&
 …
 IMPLICIT NONE
+include "YOETHF.h"
 include "clesphys.h"

LMDZ5/branches/testing/libf/phylmd/rrtm/surdi.F90

Property svn:keywords set to Author Date Id Revi

-                      r1999
+                      r2056
+!
+! $Id$
+!
 SUBROUTINE SURDI
 …
 USE YOERDI   , ONLY : RRAE     ,&
+ & RCARDI   ,RCH4     ,RN2O     ,RO3      ,RCFC11   ,&
+ & RCFC12   ,REPCLC   ,REPH2O   ,RSUNDUR  ,&
+! & RCARDI   ,RCH4     ,RN2O     ,RO3      ,RCFC11   ,&
+ & RCFC12, &
+ & REPCLC   ,REPH2O   ,RSUNDUR  ,&
  & RCCO2    ,RCCH4    ,RCN2O    ,RCCFC11  ,RCCFC12
 IMPLICIT NONE
+!#include "clesphys.h"
 REAL(KIND=JPRB) :: ZAIRMWG, ZC11MWG, ZC12MWG, ZCH4MWG, ZCO2MWG, ZN2OMWG, ZO3MWG
 REAL(KIND=JPRB) :: ZHOOK_HANDLE
 …
 !RCFC12  = 484.E-12_JPRB*ZC12MWG/ZAIRMWG
+RCARDI  = RCCO2   * ZCO2MWG/ZAIRMWG
+RCH4    = RCCH4   * ZCH4MWG/ZAIRMWG
+RN2O    = RCN2O   * ZN2OMWG/ZAIRMWG
+RO3     = 1.E-06_JPRB*ZO3MWG /ZAIRMWG
+RCFC11  = RCCFC11 * ZC11MWG/ZAIRMWG
+RCFC12  = RCCFC12 * ZC12MWG/ZAIRMWG
+!RCARDI  = RCCO2   * ZCO2MWG/ZAIRMWG
+!RCH4    = RCCH4   * ZCH4MWG/ZAIRMWG
+!RN2O    = RCN2O   * ZN2OMWG/ZAIRMWG
+!RO3     = 1.E-06_JPRB*ZO3MWG /ZAIRMWG
+!RCFC11  = RCCFC11 * ZC11MWG/ZAIRMWG
+!RCFC12  = RCCFC12 * ZC12MWG/ZAIRMWG
 REPCLC=1.E-12_JPRB
 REPH2O=1.E-12_JPRB
 !     -----------------------------------------------------------------

LMDZ5/branches/testing/libf/phylmd/rrtm/surface_fields.F90

-                      r1999
+                      r2056
 TYPE(TYPE_SFL_VEXTR2)  :: YSD_X2
+!$OMP THREADPRIVATE(ndimsurf,ndimsurfl,nofftraj,nofftraj_cst,nprogsurf)
+!$OMP THREADPRIVATE(nprogsurfl,nptrsurf,nstrajgrib,nsurf,nsurfl,ysd_va,ysd_vad)
+!$OMP THREADPRIVATE(ysd_vc,ysd_vcd,ysd_vd,ysd_vdd,ysd_vf,ysd_vfd,ysd_vh,ysd_vhd)
+!$OMP THREADPRIVATE(ysd_vn,ysd_vnd,ysd_vp,ysd_vpd,ysd_vv,ysd_vvd,ysd_vx,ysd_vxd)
+!$OMP THREADPRIVATE(ysd_ws,ysd_wsd,ysd_x2,ysd_x2d,ysd_xa,ysd_xad,ysp_ci,ysp_cid)
+!$OMP THREADPRIVATE(ysp_ep,ysp_epd,ysp_rr,ysp_rrd,ysp_sb,ysp_sbd,ysp_sg,ysp_sgd)
+!$OMP THREADPRIVATE(ysp_x2,ysp_x2d)
+!$OMP THREADPRIVATE(sd_va,sd_vc,sd_vd,sd_vf,sd_vh,sd_vn,sd_vp,sd_vv,sd_vx,sd_ws)
+!$OMP THREADPRIVATE(sd_x2,sd_xa,sp_ci,sp_ep,sp_rr,sp_sb,sp_sg,sp_x2,surf_store_array)
 !-------------------------------------------------------------------------

LMDZ5/branches/testing/libf/phylmd/rrtm/susw15.F90

r1999	r2056
62	62	REAL(KIND=JPRB) :: ZPRH2O=30000._JPRB
63	63	REAL(KIND=JPRB) :: ZPRUMG=30000._JPRB
	64
	65	!$OMP THREADPRIVATE(zpdh2o,zpdumg,zprh2o,zprumg)
64	66
65	67	REAL(KIND=JPRB) :: ZH2O, ZUMG

LMDZ5/branches/testing/libf/phylmd/rrtm/sw.F90

r1999	r2056
80	80
81	81	integer, save :: icount=0
	82	!$OMP THREADPRIVATE(icount)
82	83	INTEGER(KIND=JPIM),INTENT(IN) :: KLON
83	84	INTEGER(KIND=JPIM),INTENT(IN) :: KLEV

LMDZ5/branches/testing/libf/phylmd/rrtm/swclr.F90

-                      r1999
+                      r2056
  & PRK   , PRMU0 , PTAUAZ, PTRA1 , PTRA2 , PTRCLR, &
 !++MODIFCODE
   & LRDUST,PPIZA_DST, PCGA_DST, PTAUREL_DST )
+  & LDDUST,PPIZA_DST, PCGA_DST, PTAU_DST )
 !--MODIFCODE
 …
 !        Y.Seity 05-10-10 : add add 3 optional arg. for dust SW properties
 !        Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests
+!        O.Boucher fev.2014: modification sur les aerosols pour utiliser les variables DST
 !     ------------------------------------------------------------------
 …
 IMPLICIT NONE
+include "clesphys.h"
+INCLUDE "clesphys.h"
 INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
 …
 REAL(KIND=JPRB)   ,INTENT(IN)    :: PSEC(KLON)
 !++MODIFCODE
 LOGICAL           ,INTENT(IN)    :: LRDUST                   ! flag for DUST
+LOGICAL           ,INTENT(IN)    :: LDDUST                   ! flag for DUST
 REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_DST(KLON,KLEV)
 REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_DST(KLON,KLEV)
 REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUREL_DST(KLON,KLEV)
+REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_DST(KLON,KLEV)
 !--MODIFCODE
 REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCGAZ(KLON,KLEV)
 …
 !++MODIFCODE
+!--OB on fait passer les aerosols LMDZ dans la variable DST
   IF(NOVLP < 5)THEN !ECMWF VERSION
   DO JAE=1,6
+!  DO JAE=1,6
       DO JL = KIDIA,KFDIA
+        PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL,JAE,IKL)*RTAUA(KNU,JAE)
+        PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JAE,IKL)&
+         & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE)
+        PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JAE,IKL)&
+         & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
+!        PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL,JAE,IKL)*RTAUA(KNU,JAE)
+        PTAUAZ(JL,JK)=PTAU_DST(JL,IKL)
+!        PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JAE,IKL)&
+!         & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE)
+        PPIZAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)
+!        PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JAE,IKL)&
+!         & * RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
+        PCGAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
       ENDDO
     ENDDO
+!    ENDDO
   ELSE ! MESONH VERSION
+     DO JAE=1,6
+!--OB on utilise directement les aerosols LMDZ
+!     DO JAE=1,6
         DO JL = KIDIA,KFDIA
            !Special optical properties for dust
            IF (LRDUST.AND.(JAE==3)) THEN
+!           IF (LDDUST.AND.(JAE==3)) THEN
            !Ponderation of aerosol optical properties:first step
            !ti
+            PTAUAZ(JL,JK)=PTAUAZ(JL,JK) + PAER(JL,JAE,IKL) * PTAUREL_DST(JL,IKL)
+!            PTAUAZ(JL,JK)=PTAUAZ(JL,JK) + PAER(JL,JAE,IKL) * PTAUREL_DST(JL,IKL)
+            PTAUAZ(JL,JK)= PTAU_DST(JL,IKL)
            !wi*ti
+             PPIZAZ(JL,JK)=PPIZAZ(JL,JK) + PAER(JL,JAE,IKL)  &
+                   & *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL)
+!             PPIZAZ(JL,JK)=PPIZAZ(JL,JK) + PAER(JL,JAE,IKL)  &
+!                   & *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL)
+             PPIZAZ(JL,JK)=PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)
            !wi*ti*gi
+             PCGAZ(JL,JK) = PCGAZ(JL,JK) + PAER(JL,JAE,IKL) &
+                &  *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
+!             PCGAZ(JL,JK) = PCGAZ(JL,JK) + PAER(JL,JAE,IKL) &
+!                &  *PTAUREL_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
+             PCGAZ(JL,JK) = PTAU_DST(JL,IKL)*PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)
            !wi*ti*(gi**2)
+             ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)&
+                & *PTAUREL_DST(JL,IKL) *PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)*&
+!             ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)&
+!                & *PTAUREL_DST(JL,IKL) *PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)*&
+!                & PCGA_DST(JL,IKL)
+             ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+&
+                & PTAU_DST(JL,IKL) *PPIZA_DST(JL,IKL)*PCGA_DST(JL,IKL)*&
                 & PCGA_DST(JL,IKL)
            ELSE
+!           ELSE
            !Ponderation of aerosol optical properties:first step
            !ti
              PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL, JAE, IKL)*RTAUA(KNU,JAE)
+!             PTAUAZ(JL,JK)=PTAUAZ(JL,JK)+PAER(JL, JAE, IKL)*RTAUA(KNU,JAE)
            !wi*ti
              PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL, JAE, IKL)&
                 &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)
+!             PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL, JAE, IKL)&
+!                &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)
            !wi*ti*gi
              PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL, JAE, IKL)&
                 &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
+!             PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL, JAE, IKL)&
+!                &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
            !wi*ti*(gi**2)
              ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)&
                 &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)*RCGA(KNU,JAE)
            ENDIF
+!             ZFACOA_NEW(JL,JK)= ZFACOA_NEW(JL,JK)+PAER(JL, JAE, IKL)&
+!                &* RTAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)*RCGA(KNU,JAE)
+!           ENDIF
         ENDDO
      ENDDO
+!     ENDDO
   ENDIF
 !--MODIFCODE
 …
 !-- bug-fix: ZRATIO must be defined from the transformed value of optical thickness
 ! MPLFH : ZTRAY N'EST PAS INITIALISE !!!!! A REVOIR (MPL)
       ZTRAY=0.
+      ZTRAY= PRAYL(JL) * PDSIG(JL,JK)
 !     print *,'>>>>>>> swclr: ZTRAY ',ZTRAY
       ZDENB = ZTRAY + PTAUAZ(JL,JK)*(1.0_JPRB-PPIZAZ(JL,JK)*ZFF)

LMDZ5/branches/testing/libf/phylmd/rrtm/swr.F90

-                      r1999
+                      r2056
 !++MODIFCODE
   IF (NOVLP >= 5) THEN !MESONH VERSION
    stop'provisoire pour verifier option novlp=1'
+   stop 'provisoire pour verifier option novlp=1'
    ZFACOA =PTAUAZ(JL,IKL)
    ZFACOC = 1.0_JPRB - POMEGA(JL,KNU,IKL) * PCG(JL,KNU,IKL)* PCG(JL,KNU,IKL)
 …
     ZCLOUD(JL) = ZSS1(JL)
   ELSEIF (NOVLP == 2) THEN
    stop'provisoire pour verifier option novlp=1b'
+   stop 'provisoire pour verifier option novlp=1b'
 !* maximum
     ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
 …
 !++MODIFCODE
   ELSEIF ((NOVLP == 3).OR.((NOVLP  >=  5).AND.(NOVLP /= 8))) THEN
    stop'provisoire pour verifier option novlp=1c'
+   stop 'provisoire pour verifier option novlp=1c'
 !--MODIFCODE
 !* random
 …
     ZC1I(JL,IKL) = ZCLOUD(JL)
   ELSEIF (NOVLP == 4) THEN
    stop'provisoire pour verifier option novlp=1d'
+   stop 'provisoire pour verifier option novlp=1d'
 !* Hogan & Illingworth, 2001
     ZCLEAR(JL)=ZCLEAR(JL)*( &

LMDZ5/branches/testing/libf/phylmd/rrtm/tpm_dim.F90

-                      r1999
+                      r2056
 TYPE(DIM_TYPE),POINTER     :: R
+!$OMP THREADPRIVATE(r)
+!$OMP THREADPRIVATE(dim_resol)
 END MODULE TPM_DIM

LMDZ5/branches/testing/libf/phylmd/rrtm/tpm_distr.F90

-                      r1999
+                      r2056
 TYPE(DISTR_TYPE),POINTER     :: D
+!$OMP THREADPRIVATE(d,leq_regions,mtagdistgp,mtagdistsp,mtaggl,mtagletr)
+!$OMP THREADPRIVATE(mtaglg,mtaglm,mtagml,mtagpart,myproc,mysetv,mysetw)
+!$OMP THREADPRIVATE(ncombflen,nprgpew,nprgpns,nproc,nprtrns,nprtrv,nprtrw)
+!$OMP THREADPRIVATE(distr_resol)
 END MODULE TPM_DISTR

LMDZ5/branches/testing/libf/phylmd/rrtm/tpm_fft.F90

r1999	r2056
14	14	TYPE(FFT_TYPE),POINTER :: T
15	15
	16	!$OMP THREADPRIVATE(t)
	17
16	18	END MODULE TPM_FFT

LMDZ5/branches/testing/libf/phylmd/rrtm/tpm_gen.F90

r1999	r2056
23	23	LOGICAL :: LMPOFF ! true: switch off message passing
24	24
	25	!$OMP THREADPRIVATE(lalloperm,limp,limp_noolap,lmpoff,msetup0,ncur_resol)
	26	!$OMP THREADPRIVATE(ndef_resol,nerr,nmax_resol,nout,nprintlev,npromatr)
	27
25	28	END MODULE TPM_GEN

LMDZ5/branches/testing/libf/phylmd/rrtm/tpm_geometry.F90

r1999	r2056
19	19	TYPE(GEOM_TYPE),POINTER :: G
20	20
	21	!$OMP THREADPRIVATE(g)
	22	!$OMP THREADPRIVATE(geom_resol)
	23
21	24	END MODULE TPM_GEOMETRY

LMDZ5/branches/testing/libf/phylmd/rrtm/tpm_trans.F90

-                      r1999
+                      r2056
 INTEGER(KIND=JPIM) :: NGPBLKS ! Number of NPROMA blocks
+!$OMP THREADPRIVATE(ldivgp,lscders,luvder,lvorgp,nf_sc2,nf_sc3a,nf_sc3b,ngpblks,nproma)
+!$OMP THREADPRIVATE(foubuf_in,foubuf)
 END MODULE TPM_TRANS

LMDZ5/branches/testing/libf/phylmd/rrtm/yoe_mcica.F90

r1999	r2056
12	12
13	13	!------------------------------------------------------------------------------
	14
	15	!$OMP THREADPRIVATE(nmci1,nmci2,xcw)
	16
14	17	END MODULE YOE_McICA

LMDZ5/branches/testing/libf/phylmd/rrtm/yoe_tile_prop.F90

r1999	r2056
19	19	REAL(KIND=JPRB),ALLOCATABLE :: RTSKTI (:,:,:) ! SKIN TEMPERATURE
20	20
	21	!$OMP THREADPRIVATE(rahfsti,revapti,rtskti,rustrti,rvstrti)
21	22	END MODULE YOE_TILE_PROP

LMDZ5/branches/testing/libf/phylmd/rrtm/yoe_uvrad.F90

-                      r1999
+                      r2056
 REAL(KIND=JPRB) :: RFCAER, RFCOZO, RMUZUV
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(ipuv,jcop,juvlam,luvdbg,luvproc,luvtdep,nraduv,nuv,nuvtim,rasa,rasb)
+!$OMP THREADPRIVATE(rasc,rasd,rase,rasf,rayuvb,rcguva,rcieas,rfa0,rfa1,rfb0,rfb1,rfb2,rfb3)
+!$OMP THREADPRIVATE(rfc0,rfc1,rfc2,rfc3,rfcaer,rfcozo,rfd0,rfd1,rfd2,rfd3,rk250,rmuzuv,rpiuva)
+!$OMP THREADPRIVATE(rsuvb,rsuvb0,rtauva,rtuv1,rtuv2,ruvlam,rxpl,rxpo)
 END MODULE YOE_UVRAD

LMDZ5/branches/testing/libf/phylmd/rrtm/yoeaeratm.F90

-                      r1999
+                      r2056
 ! LAER6SDIA  : .T. if radiance diagnostics with 6S
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(indbg,laer6sdia,laerclimg,laerclimz,laerclist,laerdrydp)
+!$OMP THREADPRIVATE(laergbud,laerngat,laerprnt,laerscav,laersedim,laersurf)
+!$OMP THREADPRIVATE(ndd1,nss1,repscaer,rmasse,rmfmin)
 END MODULE YOEAERATM

LMDZ5/branches/testing/libf/phylmd/rrtm/yoeaerd.F90

-                      r1999
+                      r2056
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(raedc,raeds,raelc,raels,raesc,raess,raeuc,raeus)
+!$OMP THREADPRIVATE(rcaeadk,rcaeadm,rcaeopd,rcaeopl,rcaeops,rcaeopu)
+!$OMP THREADPRIVATE(rcaeros,rcstbga,rctrbga,rctrpt,rcvobga)
+!$OMP THREADPRIVATE(cvdaed,cvdael,cvdaes,cvdaeu)
 END MODULE YOEAERD

LMDZ5/branches/testing/libf/phylmd/rrtm/yoeaerop.F90

-                      r1999
+                      r2056
 ! OMG is pizero, the single scattering albedo        ND
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(alf_bc,alf_dd,alf_fa,alf_om,alf_ss,alf_su,asy_bc,asy_dd)
+!$OMP THREADPRIVATE(asy_fa,asy_om,asy_ss,asy_su,omg_bc,omg_dd,omg_fa,omg_om,omg_ss,omg_su)
 END MODULE YOEAEROP

LMDZ5/branches/testing/libf/phylmd/rrtm/yoeaersnk.F90

-                      r1999
+                      r2056
 ! RVSEDLIC   :
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(nbrh,r_r,r_s,ralphar,ralphas,rfraer,rfrbc,rfrdd,rfrgas)
+!$OMP THREADPRIVATE(rfrif,rfrom,rfrso4,rfrss,rho_ice,rho_wat,rmmd_dd,rmmd_ss)
+!$OMP THREADPRIVATE(rrhmax,rrho_dd,rrho_ss,rrhtab,rssgrow,rvdplic,rvdplnd)
+!$OMP THREADPRIVATE(rvdpoce,rvdpsic,rvsedlic,rvsedlnd,rvsedoce,rvsedsic)
 END MODULE YOEAERSNK

LMDZ5/branches/testing/libf/phylmd/rrtm/yoeaersrc.F90

-                      r1999
+                      r2056
 ! JDDUST     : 1 =LSCE, 2 =based on MODIS
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(jkbin,jktyp,laerextr,lepaero,nbinaer,nddust,nindaer)
+!$OMP THREADPRIVATE(nmaxtaer,ntaer,ntypaer,rclonv,rdclonv,rdglav,rdgmuv)
+!$OMP THREADPRIVATE(rdslonv,rgelav,rgemuv,rlatvol,rlonvol,rslonv,rssflx)
 END MODULE YOEAERSRC

LMDZ5/branches/testing/libf/phylmd/rrtm/yoecld.F90

-                      r1999
+                      r2056
 !  LOMEGA:  LOGICAL  SWITCH FOR OMEGA-FILTER ON MIDDLE CLOUD
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(lomega,ranva,ranvb,ranvh,rcca,rccb,rccc,rcfct)
+!$OMP THREADPRIVATE(rclwmr,rcscal,repscr,repsec,retahb,retamb,rgammas)
+!$OMP THREADPRIVATE(rloia,rloib,rloic,rloid,rlonia,rlonib,rrhh,rrhl,rrhm)
+!$OMP THREADPRIVATE(ceta)
 END MODULE YOECLD

LMDZ5/branches/testing/libf/phylmd/rrtm/yoeclop.F90

-                      r1999
+                      r2056
 ! RRIW   :  REAL   : TRANSITION RANGE
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(raswca,raswcb,raswcc,raswcd,raswce,raswcf,rebcua)
+!$OMP THREADPRIVATE(rebcub,rebcuc,rebcud,rebcue,rebcuf,rebcug,rebcuh)
+!$OMP THREADPRIVATE(rebcui,rebcuj,reffia,reffib,rriw,rtiw,ryfwca)
+!$OMP THREADPRIVATE(ryfwcb,ryfwcc,ryfwcd,ryfwce,ryfwcf)
 END MODULE YOECLOP

LMDZ5/branches/testing/libf/phylmd/rrtm/yoecnd.F90

-                      r1999
+                      r2056
 ! REPQMI :  Minimum specific humidity (security within QNEGAT)
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(repflm,repfls,repqmi)
+!$OMP THREADPRIVATE(cevapcu)
 END MODULE YOECND

LMDZ5/branches/testing/libf/phylmd/rrtm/yoedbug.F90

-                      r1999
+                      r2056
 INTEGER(KIND=JPIM) :: KSTPDBG(3)
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(kstpdbg)
 END MODULE YOEDBUG

LMDZ5/branches/testing/libf/phylmd/rrtm/yoelw.F90

-                      r1999
+                      r2056
 !  RVGO3 :  REAL     RESIDUAL PRESSURE FOR O3  VOIGT LINE HALF-WIDTH
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(alwt,blwt,mxixt,ng1,ng1p1,nipd,nipd2,nsil,ntr,ntra,nua)
+!$OMP THREADPRIVATE(pdga,pdgb,retype,rntnu,ro1h,ro2h,ro3t,rpialf0,rptype,rt1)
+!$OMP THREADPRIVATE(rvgco2,rvgh2o,rvgo3,tintp,tref,tstand,tstp,wg1,xp)
 END MODULE YOELW

LMDZ5/branches/testing/libf/phylmd/rrtm/yoeovlp.F90

r1999	r2056
21	21
22	22	! ------------------------------------------------------------------
	23	!$OMP THREADPRIVATE(ra1ovlp)
23	24	END MODULE YOEOVLP

LMDZ5/branches/testing/libf/phylmd/rrtm/yoephli.F90

-                      r1999
+                      r2056
 !                          ACTIVATED
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(lenopert,leppcfls,lphylin,lraisanen,rlpal1,rlpal2,rlpbb)
+!$OMP THREADPRIVATE(rlpbeta,rlpcc,rlpdd,rlpdrag,rlpevap,rlpmixl,rlpp00,rlptrc)
 END MODULE YOEPHLI

LMDZ5/branches/testing/libf/phylmd/rrtm/yoephy.F90

-                      r1999
+                      r2056
 ! LE4ALB : LOGICAL  : MODIS ALBEDO (UV-Vis+NIR)x(direct+diffuse)
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(lagphy,lbud23,le4alb,leco2diu,lecond,lecumf,lecurr,ledcld)
+!$OMP THREADPRIVATE(leevap,legwdg,lemethox,lemwave,leo3ch,leocco,leocsa,leocwa)
+!$OMP THREADPRIVATE(leozoc,lepcld,lephys,leqngt,lera40,leradi,lerads,lerain)
+!$OMP THREADPRIVATE(leshcv,lesice,lesurf,levdif,lmftrac,lvdftrac,nephys_pcfull)
+!$OMP THREADPRIVATE(nphproma,nphyint,rthrfrti)
 END MODULE YOEPHY

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerad.F90

-                      r1999
+                      r2056
 !                     2: McICA w generalized overlap in cloud generator
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(crtabledir,crtablefil,lccnl,lccno,ldiffc,leco2var,lecsrad)
+!$OMP THREADPRIVATE(ledbug,lepo3ra,lerad1h,leradhs,lhghg,lhvolca,lnewaer,lnotroaer)
+!$OMP THREADPRIVATE(lonewsw,loptrproma,lradlb,lrayl,lrrtm,lsrtm,naer,ncsradf,nhincsol)
+!$OMP THREADPRIVATE(niceopt,ninhom,nlayinh,nliqopt,nlngr1h,nlw,nmcica,nmode,novlp,nozocl)
+!$OMP THREADPRIVATE(npertaer,npertoz,nradfr,nradint,nradip,nradlp,nradnfr,nradpfr,nradpla)
+!$OMP THREADPRIVATE(nradres,nradsfr,nrint,nrproma,nscen,nswnl,nswtl,ntsw,nuv,raovlp)
+!$OMP THREADPRIVATE(rbovlp,rccnlnd,rccnsea,rlwinhf,rpertoz,rre2de,rswinhf)
 END MODULE YOERAD

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerdi.F90

-                      r1999
+                      r2056
 !          TO BE MORE THAN THE RESPECTIVE VALUE AT SATURATION.
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(rcardi,rccfc11,rccfc12,rcch4,rcco2,rcfc11,rcfc12,rch4)
+!$OMP THREADPRIVATE(rcn2o,repclc,reph2o,rfvar,rhvar,rincsol,rn2o,ro3,rrae)
+!$OMP THREADPRIVATE(rsolinc,rsundur)
 END MODULE YOERDI

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerdu.F90

-                      r1999
+                      r2056
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(diff,nimp,nout,ntraer,nuaer,r10e,rcday,replog,repsc,repsco,repscq,repsct,repscw)
 END MODULE YOERDU

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrtab.F90

-                      r1999
+                      r2056
 ! BPADE  :  REAL
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(bpade,trans)
 END MODULE YOERRTAB

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrtbg2.F90

r1999	r2056
26	26	! CORR2 : REAL :
27	27	! -------------------------------------------------------------------
	28	!$OMP THREADPRIVATE(corr1,corr2)
	29
28	30	END MODULE YOERRTBG2
29	31

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrtftr.F90

-                      r1999
+                      r2056
 !  WT    : REAL    :
 !    -------------------------------------------------------------------
+!$OMP THREADPRIVATE(ngb,ngc,ngm,ngn,ngs,wt)
 END MODULE YOERRTFTR

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto1.F90

r1999	r2056
33	33	! SELFREFO: REAL
34	34	! -----------------------------------------------------------------
	35	!$OMP THREADPRIVATE(forrefo,fracrefao,fracrefbo,kao,kbo,selfrefo)
35	36	END MODULE YOERRTO1

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto10.F90

r1999	r2056
32	32	! KB : REAL
33	33	! -----------------------------------------------------------------
	34
	35	!$OMP THREADPRIVATE(fracrefao,fracrefbo,kao,kbo)
	36
34	37	END MODULE YOERRTO10

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto11.F90

r1999	r2056
34	34	! SELFREF : REAL
35	35	! -----------------------------------------------------------------
	36
	37	!$OMP THREADPRIVATE(fracrefao,fracrefbo,kao,kbo,selfrefo)
36	38	END MODULE YOERRTO11

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto12.F90

r1999	r2056
29	29	! SELFREF : REAL
30	30	! -----------------------------------------------------------------
	31
	32	!$OMP THREADPRIVATE(fracrefao,kao,selfrefo)
	33
31	34	END MODULE YOERRTO12

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto13.F90

r1999	r2056
30	30	! SELFREF : REAL
31	31	! -----------------------------------------------------------------
	32	!$OMP THREADPRIVATE(fracrefao,kao,selfrefo)
32	33	END MODULE YOERRTO13

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto14.F90

r1999	r2056
34	34	! SELFREF : REAL
35	35	! -----------------------------------------------------------------
	36	!$OMP THREADPRIVATE(fracrefao,fracrefbo,kao,kbo,selfrefo)
36	37	END MODULE YOERRTO14

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto15.F90

r1999	r2056
30	30	! SELFREF : REAL
31	31	! -----------------------------------------------------------------
	32	!$OMP THREADPRIVATE(fracrefao,kao,selfrefo)
32	33	END MODULE YOERRTO15

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto16.F90

r1999	r2056
30	30	! SELFREF : REAL
31	31	! -----------------------------------------------------------------
	32	!$OMP THREADPRIVATE(fracrefao,kao,selfrefo)
32	33	END MODULE YOERRTO16

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto2.F90

r1999	r2056
35	35	! FORREFO : REAL
36	36	! -----------------------------------------------------------------
	37	!$OMP THREADPRIVATE(forrefo,fracrefao,fracrefbo,kao,kbo,selfrefo)
37	38	END MODULE YOERRTO2

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto3.F90

r1999	r2056
39	39	! SELFREFO: REAL
40	40	! -----------------------------------------------------------------
	41	!$OMP THREADPRIVATE(absn2oao,absn2obo,forrefo,fracrefao,fracrefbo,kao,kbo,selfrefo)
41	42	END MODULE YOERRTO3

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto4.F90

r1999	r2056
32	32	! SELFREF : REAL
33	33	! -----------------------------------------------------------------
	34	!$OMP THREADPRIVATE(fracrefao,fracrefbo,kao,kbo,selfrefo)
34	35	END MODULE YOERRTO4

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto5.F90

r1999	r2056
35	35	! SELFREF : REAL
36	36	! -----------------------------------------------------------------
	37	!$OMP THREADPRIVATE(ccl4o,fracrefao,fracrefbo,kao,kbo,selfrefo)
37	38	END MODULE YOERRTO5

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto6.F90

r1999	r2056
34	34	! SELFREF : REAL
35	35	! -----------------------------------------------------------------
	36	!$OMP THREADPRIVATE(absco2o,cfc11adjo,cfc12o,fracrefao,kao,selfrefo)
36	37	END MODULE YOERRTO6

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto7.F90

r1999	r2056
35	35	! SELFREF : REAL
36	36	! -----------------------------------------------------------------
	37	!$OMP THREADPRIVATE(absco2o,fracrefao,fracrefbo,kao,kbo,selfrefo)
37	38	END MODULE YOERRTO7

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto8.F90

r1999	r2056
46	46	! SELFREF : REAL
47	47	! -----------------------------------------------------------------
	48	!$OMP THREADPRIVATE(absco2ao,absco2bo,absn2oao,absn2obo,cfc12o,cfc22adjo,fracrefao,fracrefbo,kao,kbo,selfrefo)
48	49	END MODULE YOERRTO8

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrto9.F90

r1999	r2056
42	42	! SELFREF : REAL
43	43	! -----------------------------------------------------------------
	44	!$OMP THREADPRIVATE(absn2oo,fracrefao,fracrefbo,kao,kbo,selfrefo)
44	45	END MODULE YOERRTO9

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrtrf.F90

r1999	r2056
26	26	! TREF : REAL
27	27	! -----------------------------------------------------------------
	28	!$OMP THREADPRIVATE(pref,preflog,tref)
28	29	END MODULE YOERRTRF

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrtrwt.F90

r1999	r2056
32	32	! RWT : REAL :
33	33	! -------------------------------------------------------------------
	34	!$OMP THREADPRIVATE(frefa,frefadf,frefb,frefbdf,rwgt)
34	35	END MODULE YOERRTRWT

LMDZ5/branches/testing/libf/phylmd/rrtm/yoerrtwn.F90

r1999	r2056
36	36	! TOTPLK16: REAL :
37	37	! -----------------------------------------------------------------
	38	!$OMP THREADPRIVATE(delwave,ng,nspa,nspb,totplk16,totplnk,wavenum1,wavenum2)
38	39	END MODULE YOERRTWN

LMDZ5/branches/testing/libf/phylmd/rrtm/yoesat.F90

r1999	r2056
53	53	! RGEAS : REAL : LATITUDE OF EAST LIMIT OF FIELD OF VIEW
54	54	! -----------------------------------------------------------------
	55	!$OMP THREADPRIVATE(lgeose,lgeosw,lgms,lindsa,lmto,lnoaa,lnoab,lnoac,lnoad,ngeo,npolo,rgalt,rgeas,rgnad,rgnor,rgsou,rgwst)
55	56	END MODULE YOESAT

LMDZ5/branches/testing/libf/phylmd/rrtm/yoesrtaer.F90

r1999	r2056
32	32
33	33	! -----------------------------------------------------------------
	34	!$OMP THREADPRIVATE(rsrasya,rsrpiza,rsrtaua)
34	35	END MODULE YOESRTAER
35	36

LMDZ5/branches/testing/libf/phylmd/rrtm/yoesrtcop.F90

-                      r1999
+                      r2056
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(rsaswa,rsaswb,rsaswc,rsaswd,rsaswe,rsaswf,rsecia,rsecib)
+!$OMP THREADPRIVATE(rsecic,rsecid,rsecie,rsecif,rsfla0,rsfla1,rsflb0,rsflb1)
+!$OMP THREADPRIVATE(rsflb2,rsflb3,rsflc0,rsflc1,rsflc2,rsflc3,rsfld0,rsfld1)
+!$OMP THREADPRIVATE(rsfld2,rsfld3,rsfua0,rsfua1,rsfub0,rsfub1,rsfub2,rsfub3)
+!$OMP THREADPRIVATE(rsfuc0,rsfuc1,rsfuc2,rsfuc3,rsssia,rsssie,rsssif,rsssig)
+!$OMP THREADPRIVATE(rsssih,rsssik,rsyfwa,rsyfwb,rsyfwc,rsyfwd,rsyfwe,rsyfwf)
 END MODULE YOESRTCOP

LMDZ5/branches/testing/libf/phylmd/rrtm/yoesrtop.F90

-                      r1999
+                      r2056
 !                    FU, 1996, J. CLIM., 9,
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(abscld1,abscoice,abscoliq,asyice2,asyice3,asyliq1,extcoice)
+!$OMP THREADPRIVATE(extcoliq,extice2,extice3,extliq1,fdelta,fdlice3,forwice,forwliq)
+!$OMP THREADPRIVATE(gice,gliq,ssacoice,ssacoliq,ssaice2,ssaice3,ssaliq1)
 END MODULE YOESRTOP

LMDZ5/branches/testing/libf/phylmd/rrtm/yoesrtwn.F90

r1999	r2056
61	61	! RWGT : REAL :
62	62	! -----------------------------------------------------------------
	63	!$OMP THREADPRIVATE(delwave,ng,ngbsw,ngc,ngm,ngn,ngs,nmpsrtm,nspa,nspb)
	64	!$OMP THREADPRIVATE(pref,preflog,rwgt,tref,wavenum1,wavenum2,wt,wtsm)
63	65	END MODULE YOESRTWN
64	66

LMDZ5/branches/testing/libf/phylmd/rrtm/yoesw.F90

-                      r1999
+                      r2056
 ! NMPSRTM: INTEGER  : Indices for mapping SW[1:6] albedo into SRTM[1:14]
 !     -----------------------------------------------------------------
+!$OMP THREADPRIVATE(apad,bpad,d,nexpo3,nmpsrtm,ntyps,radjust,raer,raswca)
+!$OMP THREADPRIVATE(raswcb,raswcc,raswcd,raswce,raswcf,rcga,rebcua,rebcub)
+!$OMP THREADPRIVATE(rebcuc,rebcud,rebcue,rebcuf,rebcug,rebcuh,rebcui,rebcuj)
+!$OMP THREADPRIVATE(reffia,reffib,rexpo3,rflaa0,rflaa1,rflbb0,rflbb1,rflbb2)
+!$OMP THREADPRIVATE(rflbb3,rflcc0,rflcc1,rflcc2,rflcc3,rfldd0,rfldd1,rfldd2)
+!$OMP THREADPRIVATE(rfldd3,rfuaa0,rfuaa1,rfubb0,rfubb1,rfubb2,rfubb3,rfucc0)
+!$OMP THREADPRIVATE(rfucc1,rfucc2,rfucc3,rfueta,rfuetb,rfuetc,rfulio,rhsavi)
+!$OMP THREADPRIVATE(rhsra,rhsrb,rhsrc,rhsrd,rhsre,rhsrf,rhsrta,rhsrtb,rlilia)
+!$OMP THREADPRIVATE(rlilib,rpdh1,rpdu1,rpiza,rpnh,rpnu,rrasy,rray,rriw,rroma)
+!$OMP THREADPRIVATE(rromb,rsusha,rsushc,rsushd,rsushe,rsushf,rsushfa,rsushg)
+!$OMP THREADPRIVATE(rsushh,rsushk,rswce,rswcp,rtaua,rtdh2o,rtdumg,rth2o,rtiw)
+!$OMP THREADPRIVATE(rtumg,rtweight,rweight,rweigs,rweigv,ryfwca,ryfwcb,ryfwcc,ryfwcd,ryfwce,ryfwcf)
 END MODULE YOESW

LMDZ5/branches/testing/libf/phylmd/rrtm/yoethf.F90

r1999	r2056
60	60
61	61	! ----------------------------------------------------------------
	62	!$OMP THREADPRIVATE(r2es,r3ies,r3les,r4ies,r4les,r5alscp,r5alvcp,r5ies,r5les)
	63	!$OMP THREADPRIVATE(ralfdcp,ralsdcp,ralvdcp,rhoh2o,rkoop1,rkoop2,rtber,rtbercu)
	64	!$OMP THREADPRIVATE(rtice,rticecu,rtwat,rtwat_rtice_r,rtwat_rticecu_r,rvtmp2)
62	65	END MODULE YOETHF

LMDZ5/branches/testing/libf/phylmd/rrtm/yoevdf.F90

r1999	r2056
42	42	! RPARSRF REAL *DEPTH OF SURFACE LAYER AS FRACTION OF PBL-H
43	43	! ------------------------------------------------------------------
	44	!$OMP THREADPRIVATE(nvtypes,rentr,repdu2,rkap,rlam,rpar,rpar1,rparsrf,rvdifts)
44	45	END MODULE YOEVDF

LMDZ5/branches/testing/libf/phylmd/rrtm/yoewcou.F90

r1999	r2056
112	112
113	113	! ------------------------------------------------------------------
	114	!$OMP THREADPRIVATE(cbegdat,lwcou,lwcou2w,lwcounorms,lwvin_mask_not_set,lwvin_uninitialised,mwvin_recvtot)
	115	!$OMP THREADPRIVATE(mwvin_sendtot,ndurat,nlat1w,nlatw,nlon1w,nlonw,nnorxw,nresum,nstpw,rdegrew,rnortw,rsoutw)
114	116	END MODULE YOEWCOU

LMDZ5/branches/testing/libf/phylmd/rrtm/yom_phys_grid.F90

r1999	r2056
110	110	TYPE(TYPE_DYN_POINT),ALLOCATABLE :: YDYNPOI(:)
111	111
	112	!$OMP THREADPRIVATE(dyn_grid,dyn_sl,phys_grid,phys_sl)
	113	!$OMP THREADPRIVATE(ydynpoi,yphypoi)
112	114	END MODULE YOM_PHYS_GRID

LMDZ5/branches/testing/libf/phylmd/rrtm/yom_ygfl.F90

-                      r1999
+                      r2056
 !------------------------------------------------------------------
+!$OMP THREADPRIVATE(laerosfc,lghgsfc,lsf6sfc,nactaero,naero,ngfl_ext,ngfl_ezdiag,ngfl_forc,nghg,ngrg)
+!$OMP THREADPRIVATE(ntrac,ya,ya_nl,yaero,yaero_nl,ycpf,ycpf_nl,ycvgq,ycvgq_nl,ycvv,ycvv_nl,ydal,ydal_nl)
+!$OMP THREADPRIVATE(ydom,ydom_nl,yext,yext_nl,yezdiag,yezdiag_nl,yforc,yforc_nl,yg,yg_nl,ygfl,ygflc,yghg)
+!$OMP THREADPRIVATE(yghg_nl,ygrg,ygrg_nl,yi,yi_nl,yl,yl_nl,yo3,yo3_nl,yq,yq_nl,yqva,yqva_nl,yr,yr_nl,ys)
+!$OMP THREADPRIVATE(ys_nl,ysdsat,ysdsat_nl,yspf,yspf_nl,ysrc,ysrc_nl,ytke,ytke_nl,ytrac,ytrac_nl,yual)
+!$OMP THREADPRIVATE(yual_nl,yuen,yuen_nl,yunebh,yunebh_nl,yuom,yuom_nl)
 END MODULE YOM_YGFL

LMDZ5/branches/testing/libf/phylmd/rrtm/yomaer15.F90

r1999	r2056
32	32	REAL(KIND=JPRB) :: RAER15 (5,6)
33	33
	34	!$OMP THREADPRIVATE(raer15,rcga15,rpiza15,taua15)
34	35	END MODULE YOMAER15

LMDZ5/branches/testing/libf/phylmd/rrtm/yomaerd15.F90

r1999	r2056
70	70	! RCAEROS15 REAL *BACKGROUND VALUE IN ABSENCE OF AEROSOLS.
71	71	! ------------------------------------------------------------------
	72	!$OMP THREADPRIVATE(raedc15,raeds15,raelc15,raels15,raesc15,raess15,raeuc15,raeus15,rcaeadk15,rcaeadm15)
	73	!$OMP THREADPRIVATE(rcaeopd15,rcaeopf15,rcaeopl15,rcaeops15,rcaeopu15,rcaeros15,rcstbga15,rctrbga15,rctrpt15,rcvobga15)
	74	!$OMP THREADPRIVATE(cvdaed15,cvdaef15,cvdael15,cvdaes15,cvdaeu15)
72	75	END MODULE YOMAERD15

LMDZ5/branches/testing/libf/phylmd/rrtm/yomarar.F90

-                      r1999
+                      r2056
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(larobu_enable,ldiagwmax,losigmas,losubg_aucv,losubg_cond,lowarm,lsquall)
+!$OMP THREADPRIVATE(macprg,macprr,macprs,malbdir,malbsca,mfrthds,mgz0,mgz0h,minprg,minprr,minprs)
+!$OMP THREADPRIVATE(mpabsm,mpsurf,mqvm,mrain,mrhodref,msfrv,msfsv,msfth,msfu,msfv,msnow,mswdif)
+!$OMP THREADPRIVATE(mswdir,mtm,mum,mvemis,mvm,mvqs,mvts,mzz,ndiagfr,ndiagwmax,ndtchem,ngpar)
+!$OMP THREADPRIVATE(nprintfr,nptp,nrefroi1,nrefroi2,nrr,nrri,nrrl,nsplitr,nsv,nswb_mnh,vsquall)
+!$OMP THREADPRIVATE(nbuproc,njbudg1,njbudg2,xsw_bands)
 END MODULE YOMARAR

LMDZ5/branches/testing/libf/phylmd/rrtm/yomarphy.F90

r1999	r2056
41	41	CHARACTER(LEN=1) :: CCOUPLING
42	42	! -------------------------------------------------------------------
	43	!$OMP THREADPRIVATE(ccoupling,lbuflux,lkfbconv,lkfbd,lkfbs,lmicro,lmpa,lmse,lorilam,lrdust,lturb,lusechem)
43	44	END MODULE YOMARPHY
44	45

LMDZ5/branches/testing/libf/phylmd/rrtm/yomcape.F90

r1999	r2056
44	44
45	45	! ------------------------------------------------------------------
	46	!$OMP THREADPRIVATE(gcapepsd,gcaperet,ncapeiter,netapes)
46	47	END MODULE YOMCAPE

LMDZ5/branches/testing/libf/phylmd/rrtm/yomcli.F90

-                      r1999
+                      r2056
 REAL(KIND=JPRB) :: SZZ0D
+!$OMP THREADPRIVATE(edlat,edlon,elatne,elatsw,elonne,elonsw,lglobe,lieee,ndatx,ndaty)
+!$OMP THREADPRIVATE(nglobx,ngloby,npint,nslice,ntpdes,ntpgla,ntplac,ntpmer,salbb,salbd)
+!$OMP THREADPRIVATE(salbg,salbm,salbn,salbx,sargd,sargn,sargx,sdepd,sdepn,sdepx,semib)
+!$OMP THREADPRIVATE(semid,semig,semim,semin,semix,sfcz0,smanq,smask,srsmd,srsmn,srsmx)
+!$OMP THREADPRIVATE(ssabd,ssabn,ssabx,sther,str,sveg,swr,szz0b,szz0d,szz0m,szz0n,szz0u)
 END MODULE YOMCLI

LMDZ5/branches/testing/libf/phylmd/rrtm/yomclop15.F90

r1999	r2056
67	67	! RRIW15 : REAL : TRANSITION RANGE
68	68	! -----------------------------------------------------------------
	69	!$OMP THREADPRIVATE(rebcua15,rebcub15,rebcuc15,rebcud15,rebcue15,rebcuf15,rebcug15,rebcuh15)
	70	!$OMP THREADPRIVATE(reffia15,reffib15,reffwia15,rriw15,rtiw15,ryfwca15,ryfwcb15,ryfwcc15,ryfwcd15,ryfwce15,ryfwcf15)
69	71	END MODULE YOMCLOP15

LMDZ5/branches/testing/libf/phylmd/rrtm/yomcoaphy.F90

r1999	r2056
21	21	CHARACTER (LEN = 256) :: CPTABLEDIR
22	22
	23	!$OMP THREADPRIVATE(cptabledir,cptablefil,nphyint,phys_gppbuf)
23	24	END MODULE YOMCOAPHY

LMDZ5/branches/testing/libf/phylmd/rrtm/yomcst.F90

-                      r1999
+                      r2056
 !    ------------------------------------------------------------------
+!$OMP THREADPRIVATE(r,r1sa,ra,ralpd,ralps,ralpw,ratm,rbetd,rbets,rbetw,rclum,rcpd,rcpv,rcs,rcvd,rcvv,rcw)
+!$OMP THREADPRIVATE(rd,rday,rdt,rea,repsm,restt,retv,rg,rgamd,rgams,rgamw,rhpla,ri0,rkappa,rkbol,rlmlt)
+!$OMP THREADPRIVATE(rlstt,rlszer,rlvtt,rlvzer,rmch4,rmco,rmco2,rmd,rmhcho,rmn2o,rmno2,rmo3,rmra,rmsf6)
+!$OMP THREADPRIVATE(rmso2,rmv,rnavo,romega,rpi,rsiday,rsigma,rsiyea,rtt,rv)
 END MODULE YOMCST

LMDZ5/branches/testing/libf/phylmd/rrtm/yomct0.F90

-                      r1999
+                      r2056
 LOGICAL ::  LSFORC
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(cfclass,cfdirlst,cfpncf,cndispp,cnmexp,cnppath,ctype,l_screen_call,l_split_screen,lallopr,lalltc)
+!$OMP THREADPRIVATE(laprxpk,larome,larpegef,larpegef_rdgp_init,larpegef_rdgp_trajbg,larpegef_rdgp_trajhr)
+!$OMP THREADPRIVATE(larpegef_trajbg,larpegef_trajhr,lbackg,lcanari,lcasig,lelam,lfbdap,lfdbop,lfpart2,lfpos)
+!$OMP THREADPRIVATE(lgrbop,lguess,lifsmin,lifstraj,lminim,lmpdiag,lmpoff,lnf,lnhdyn,lnobgon,lobs,lobsc1,lobsref)
+!$OMP THREADPRIVATE(loldpp,lopdis,loutput,lpc_full,lpc_nesc,lpc_old,lrefgen,lrefout,lregeta,lretcfou,lrfoutcnorm)
+!$OMP THREADPRIVATE(lrfric,lrgptcnorm,lrough,lrplane,lrubc,lscmec,lscreen,lscreen_openmp,lsfcflx,lsforc,lsimob)
+!$OMP THREADPRIVATE(lsitric,lslag,lsmssig,lsprt,ltenc,ltwotl,lvercor,lwrtcfou,n2dini,n3dini,n_regions_ew,n_regions_ns)
+!$OMP THREADPRIVATE(ncntvar,nconf,ncycle,ndhfdts,ndhfgts,ndhfzts,ndhpts,nfrco,nfrcorm,nfrdhfd,nfrdhfg,nfrdhfz,nfrdhp)
+!$OMP THREADPRIVATE(nfrgdi,nfrhis,nfrisp,nfrmasscon,nfrpos,nfrsdi,ngdits,nhists,ninterpincr,ninterpincrlimit)
+!$OMP THREADPRIVATE(ninterpincrorder,ninterptraj,ninterptrajlimit,ninterptrajorder,nmasscons,noutput,npisps,nposts)
+!$OMP THREADPRIVATE(nprgpew,nprgpns,nprintlev,nproc,nprtrm,nprtrn,nprtrns,nprtrv,nprtrw,nquad,nsdits,nsppr,nstart)
+!$OMP THREADPRIVATE(nstepini,nstop,ntasks,rextlhf,rextshf,rextz0h,rextz0m,rtenc)
+!$OMP THREADPRIVATE(n_regions)
 END MODULE YOMCT0

LMDZ5/branches/testing/libf/phylmd/rrtm/yomct0b.F90

r1999	r2056
16	16
17	17	! ------------------------------------------------------------------
	18	!$OMP THREADPRIVATE(lecmwf)
18	19	END MODULE YOMCT0B

LMDZ5/branches/testing/libf/phylmd/rrtm/yomct3.F90

r1999	r2056
22	22
23	23	! ------------------------------------------------------------------
	24	!$OMP THREADPRIVATE(lgpqinsp,lrecall_suhdf_in_cnt4,lspc_from_di,nstep)
24	25	END MODULE YOMCT3

LMDZ5/branches/testing/libf/phylmd/rrtm/yomcver.F90

r1999	r2056
46	46	! -----------------------------------------------------------------------------
47	47
	48	!$OMP THREADPRIVATE(lsvtsm,lvertfe,lvsplip,nvsch)
	49	!$OMP THREADPRIVATE(rderi,rfaa,rfbb,rfcc,rfdd,rinte,rvspc,rvsptri,vrdetar)
48	50	END MODULE YOMCVER

LMDZ5/branches/testing/libf/phylmd/rrtm/yomdim.F90

-                      r1999
+                      r2056
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(lader,loptproma,lspt,luvder,lvor,ncmax,ncpec,ncpec2,ndgenfph)
+!$OMP THREADPRIVATE(ndgeng,ndgenh,ndgenl,ndglg,ndgll,ndgnh,ndgsafph,ndgsag,ndgsah)
+!$OMP THREADPRIVATE(ndgsal,ndgsur,ndgung,ndgunl,ndguxg,ndguxl,ndlon,ndlsm,ndlsur)
+!$OMP THREADPRIVATE(ndlung,ndluxg,ndsur1,nf3d,nfaux,nfc2d,nfd2d,nfgpnh,nflen,nflevg)
+!$OMP THREADPRIVATE(nflevl,nflevlmx,nflsa,nflsul,nflsur,nfppye,nfppyx,nfther,ngpblks)
+!$OMP THREADPRIVATE(nmsmax,nmtcmax,nppm,nproma,npromb,npromc,nprome,npromm,npromnh)
+!$OMP THREADPRIVATE(npromnh_gwadv,npromp,npromv,npromvc,nrlevx,ns1d,ns2d,ns3d,nsaux)
+!$OMP THREADPRIVATE(nsefre,nsmax,nsmin,nspec,nspec2,nspec2g,nspec2mx,nspecg,ntcmax,ntmax)
+!$OMP THREADPRIVATE(ntpec2,numcp,nump,numtp,numxp,nundefld,nvarmax,nxmax,nxpec,nxpecg)
+!$OMP THREADPRIVATE(ndlunl,ndluxl)
 END MODULE YOMDIM

LMDZ5/branches/testing/libf/phylmd/rrtm/yomdphy.F90

r1999	r2056
68	68	LOGICAL :: LTPROF
69	69	! ------------------------------------------------------------------
	70	!$OMP THREADPRIVATE(ltprof,ncextr,nchac,nchin,ncsi,ncsnec,ncxp,nloa,nloe,nsira,ntiles,ntoz1d,ntoz2d,ntoz3d,ntsl,ntssg)
	71	!$OMP THREADPRIVATE(ntvg,nvclis,nvextr,nvextrdyn,nvtend,nvxp,nvxp2,nvxtr2)
70	72	END MODULE YOMDPHY

LMDZ5/branches/testing/libf/phylmd/rrtm/yomdyn.F90

-                      r1999
+                      r2056
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(alphint,betadt,flccri,frandh,gammax,gammax0,hdirdiv,hdiro3,hdirpd,hdirq,hdirsp,hdirt)
+!$OMP THREADPRIVATE(hdirvd,hdirvor,hdsrdiv,hdsrvd,hdsrvor,hdtime_strhd,hrdirdiv,hrdiro3,hrdirpd,hrdirq)
+!$OMP THREADPRIVATE(hrdirsp,hrdirt,hrdirvd,hrdirvor,hrdsrdiv,hrdsrvd,hrdsrvor,l2tlff,ladvf,ladvfw,lchdif)
+!$OMP THREADPRIVATE(ldry_ecmwf,leltra,lfrein,lfreinf,limpf,lnewhd,lpc_xidt,lqmhp,lqmhpd,lqmht,lqmhvd,lqmhw)
+!$OMP THREADPRIVATE(lqmp,lqmpd,lqmt,lqmvd,lqmw,lrephd,lrhdi_lastiterpc,lrspline_p,lrspline_spd,lrspline_svd)
+!$OMP THREADPRIVATE(lrspline_t,lrspline_w,lsettls,lsidg,lsl_unlphy_f,lstrhd,lverave_hluv,lverflt,ncomp_cvgq)
+!$OMP THREADPRIVATE(ncurrent_iter,ndlnpr,nitmp,nlevvf,nrubc,nsiter,nspdlag,nsrefdh,nsvdlag,ntlag,nvlag,nwlag)
+!$OMP THREADPRIVATE(rcmslp0,rdampdiv,rdampdivs,rdamphds,rdampo3,rdamppd,rdampq,rdampsp,rdampt,rdampvd,rdampvds)
+!$OMP THREADPRIVATE(rdampvor,rdampvors,refgeo,reps1,reps2,repsm1,repsm2,repsp1,repsvfdi,repsvfvo,rexpdh,rexpdhs)
+!$OMP THREADPRIVATE(rfrein,rhydr0,rrdxtau,rtemrb,rw2tlff,sdred,sipr,siprub,sirprg,sirprn,sitime,sitr,sitra,sitrub)
+!$OMP THREADPRIVATE(slevdh,slevdh2,slevdh3,slevdhs,slevdhs2,slhda0,slhdb,slhdkmax,tdt,tstep,vcak,vcpr,vctr,vesl)
+!$OMP THREADPRIVATE(vetaon,vetaox,vmax1,vmax2,vnorm,xidt)
+!$OMP THREADPRIVATE(gmr,rcordif,rcordih,rcordit,rdhi,rdhs,rdidiv,rdigfl,rdipd,rdisp,rditg,rdivd,rdivor,rdsdiv)
+!$OMP THREADPRIVATE(rdsvd,rdsvor,rkrf,s2eta,scgmap,sialph,sib,sidelp,sidphi,sifac,sifaci,siheg,siheg2,sihegb)
+!$OMP THREADPRIVATE(sihegb2,silnpr,simi,simo,sirdel,sirub,sitlaf,sitlah,sitrica,sitricb,sitricc,sivp,slhda,slhdd0)
 END MODULE YOMDYN

LMDZ5/branches/testing/libf/phylmd/rrtm/yomfa.F90

-                      r1999
+                      r2056
 TYPE(FAD) :: YFAQVA  ! Total humidity amplitude variation of Q+L+I
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(nbitcs,nbitpg,npulap,nstron,nvgrib,yfaclf,yfacpf,yfacvgq,yfacvv,yfadal,yfadom,yfafsp1)
+!$OMP THREADPRIVATE(yfafsp2,yfafsp3,yfafsp4,yfafsp5,yfag,yfai,yfakhi,yfal,yfao3,yfaorog,yfapd,yfapsi,yfaq)
+!$OMP THREADPRIVATE(yfaqva,yfar,yfas,yfasdsat,yfasp,yfaspf,yfasrc,yfat,yfatke,yfaual,yfauen,yfaugeo)
+!$OMP THREADPRIVATE(yfaunebh,yfauom,yfavd,yfavgeo)
 END MODULE YOMFA

LMDZ5/branches/testing/libf/phylmd/rrtm/yomfpc.F90

-                      r1999
+                      r2056
 INTEGER(KIND=JPIM) :: NFPMASK
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(c1fp2df,c1fp3df,c1fp3dfh,c1fp3dfp,c1fp3dfs,c1fp3dft,c1fp3dfv,c1fpcfu,c1fpdom,c1fpphy,c1fpxfu)
+!$OMP THREADPRIVATE(cfp2df,cfp3df,cfp3dfh,cfp3dfp,cfp3dfs,cfp3dft,cfp3dfv,cfpcfu,cfpdir,cfpdom,cfpfmt,cfpiden)
+!$OMP THREADPRIVATE(cfpphy,cfpxfu,fpbl,lasq,lfitp,lfitt,lfitv,lfpcnt,lfplosp,lfpmois,lfpnhpd,lfpnhvd,lfpnhvw)
+!$OMP THREADPRIVATE(lfpq,lfprh100,lfpspec,lmoconvar,ltracefp,mfp2df,mfp2dyn,mfp3dfh,mfp3dfp,mfp3dfs,mfp3dft)
+!$OMP THREADPRIVATE(mfp3dfv,mfp3dyn,mfpphy,nfp2df,nfp3df,nfp3dfh,nfp3dfp,nfp3dfs,nfp3dft,nfp3dfv,nfp3h,nfp3p)
+!$OMP THREADPRIVATE(nfp3pv,nfp3s,nfp3th,nfpcape,nfpcfu,nfpcli,nfpdom,nfpdphy,nfpgrib,nfpincr,nfpindyn,nfpinphy)
+!$OMP THREADPRIVATE(nfplake,nfplnpr,nfpmask,nfpphy,nfpsurfex,nfpxfu,nfpxlev,nrfp3s,rfp3h,rfp3p,rfp3pv,rfp3th)
+!$OMP THREADPRIVATE(rfpcd2,rfpcorr,rfpcsab,rfpvcap,wdxi,wdxo,wsxi,wsxo)
 END MODULE YOMFPC

LMDZ5/branches/testing/libf/phylmd/rrtm/yomgc.F90

r1999	r2056
63	63
64	64	! ----------------------------------------------------------------
	65
	66	!$OMP THREADPRIVATE(gaw,geclo,gelam,gelat,gemu,geslo,gm,gnordl,gnordlcl,gnordm,gnordmcl,gnordmcm,gomvrl)
	67	!$OMP THREADPRIVATE(gomvrm,gsqm2,ngplat,nuniquegp,orog,orogl,orogll,oroglm,orogm,orogmm,rcori,rcoric)
65	68	END MODULE YOMGC

LMDZ5/branches/testing/libf/phylmd/rrtm/yomgem.F90

-                      r1999
+                      r2056
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(nbeegp,nbnegp,ngptot,ngptot_cap,ngptotg,ngptotmx,nhtyp,nsttyp,r4jp,rc2m1,rc2p1,rcor0)
+!$OMP THREADPRIVATE(rcor1,rcor2,reflcape,reflkuo,reflrhc,rlocen,rmucen,rnlginc,rstret,teqc,teqh,teqk,toppres,vp00,vrlevx)
+!$OMP THREADPRIVATE(ndglu,nestagp,ngptotl,nloen,nloeng,nmen,nmeng,nmentc,nstagp,ntstagp,nvautf,nvauth,ratath,ratatx)
+!$OMP THREADPRIVATE(rcolon,rindx,rindy,rsilon,vaf,vah,valh,vbf,vbh,vc,vcuico,vcuicoh,vdela,vdelb,vetaf,vetah,vrdetah)
 END MODULE YOMGEM

LMDZ5/branches/testing/libf/phylmd/rrtm/yomgrb.F90

-                      r1999
+                      r2056
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(mbitsgg,mbitssh,mensfnb,mgrbs2,mgrbs3,mjdiag,mjdomai,mjiter,mlocgrb,msec0,msec1,msec2spm,msec2spp)
+!$OMP THREADPRIVATE(msec3,msec4,msmaxnp,mtotens,nbitsgg,nbitssh,ncalval,nconsensus,ndwd,nensfnb,ngrb080,ngrb081)
+!$OMP THREADPRIVATE(ngrb082,ngrb083,ngrb084,ngrb085,ngrb086,ngrb087,ngrb088,ngrb089,ngrb090,ngrb091,ngrb092,ngrb093)
+!$OMP THREADPRIVATE(ngrb094,ngrb095,ngrb096,ngrb097,ngrb098,ngrb099,ngrb100,ngrb101,ngrb102,ngrb103,ngrb104,ngrb105)
+!$OMP THREADPRIVATE(ngrb106,ngrb107,ngrb108,ngrb109,ngrb10fg,ngrb10u,ngrb10v,ngrb110,ngrb111,ngrb112,ngrb113,ngrb114)
+!$OMP THREADPRIVATE(ngrb115,ngrb116,ngrb117,ngrb118,ngrb119,ngrb120,ngrb149,ngrb150,ngrb153,ngrb154,ngrb207,ngrb21)
+!$OMP THREADPRIVATE(ngrb214,ngrb215,ngrb216,ngrb217,ngrb218,ngrb219,ngrb22,ngrb222,ngrb223,ngrb224,ngrb225,ngrb226)
+!$OMP THREADPRIVATE(ngrb227,ngrb23,ngrb241,ngrb242,ngrb249,ngrb250,ngrb251,ngrb252,ngrb253,ngrb254,ngrb255,ngrb2d)
+!$OMP THREADPRIVATE(ngrb2t,ngrbaerdep,ngrbaergn01,ngrbaergn02,ngrbaergn03,ngrbaergn04,ngrbaergn05,ngrbaergn06)
+!$OMP THREADPRIVATE(ngrbaergn07,ngrbaergn08,ngrbaergn09,ngrbaergn10,ngrbaergn11,ngrbaergn12,ngrbaergn13,ngrbaergn14)
+!$OMP THREADPRIVATE(ngrbaergn15,ngrbaerlg,ngrbaerls01,ngrbaerls02,ngrbaerls03,ngrbaerls04,ngrbaerls05,ngrbaerls06)
+!$OMP THREADPRIVATE(ngrbaerls07,ngrbaerls08,ngrbaerls09,ngrbaerls10,ngrbaerls11,ngrbaerls12,ngrbaerls13,ngrbaerls14)
+!$OMP THREADPRIVATE(ngrbaerls15,ngrbaerlts,ngrbaermr01,ngrbaermr02,ngrbaermr03,ngrbaermr04,ngrbaermr05,ngrbaermr06)
+!$OMP THREADPRIVATE(ngrbaermr07,ngrbaermr08,ngrbaermr09,ngrbaermr10,ngrbaermr11,ngrbaermr12,ngrbaermr13,ngrbaermr14)
+!$OMP THREADPRIVATE(ngrbaermr15,ngrbaerpr,ngrbaerscc,ngrbaersm,ngrbal,ngrbalnid,ngrbalnip,ngrbaluvd,ngrbaluvp,ngrbanor)
+!$OMP THREADPRIVATE(ngrbaodlg,ngrbaodpr,ngrbaodsm,ngrbasn,ngrbat,ngrbbld,ngrbblh,ngrbbv,ngrbcape,ngrbcc,ngrbccc)
+!$OMP THREADPRIVATE(ngrbchar,ngrbci,ngrbciwc,ngrbclwc,ngrbco2a,ngrbco2b,ngrbco2o,ngrbcp,ngrbcsf,ngrbcvh,ngrbcvl,ngrbd)
+!$OMP THREADPRIVATE(ngrbe,ngrbemis,ngrbes,ngrbewov,ngrbewss,ngrbfal,ngrbflsr,ngrbfsr,ngrbgh,ngrbghg,ngrbgrg,ngrbgwd)
+!$OMP THREADPRIVATE(ngrbhcc,ngrbie,ngrbiews,ngrbinss,ngrbishf,ngrbisor,ngrbistl1,ngrbistl2,ngrbistl3,ngrbistl4,ngrblcc)
+!$OMP THREADPRIVATE(ngrblgws,ngrblnsp,ngrblsf,ngrblsm,ngrblsp,ngrblspf,ngrblsrh,ngrbmaxxtra,ngrbmcc,ngrbmgws)
+!$OMP THREADPRIVATE(ngrbminxtra,ngrbmn2t,ngrbmont,ngrbmsl,ngrbmx2t,ngrbneov,ngrbnsov,ngrbnsss,ngrbnwov,ngrbo3,ngrbpaw)
+!$OMP THREADPRIVATE(ngrbpthpv,ngrbpv,ngrbq,ngrbr,ngrbro,ngrbrsn,ngrbs2,ngrbs3,ngrbsd,ngrbsdfor,ngrbsdor,ngrbsf,ngrbsf6)
+!$OMP THREADPRIVATE(ngrbskt,ngrbslhf,ngrbslor,ngrbsmlt,ngrbsp,ngrbspar,ngrbsparc,ngrbspd,ngrbsr,ngrbsrc,ngrbsshf,ngrbssr)
+!$OMP THREADPRIVATE(ngrbssrc,ngrbssrd,ngrbsst,ngrbstinc,ngrbstl1,ngrbstl2,ngrbstl3,ngrbstl4,ngrbstr,ngrbstrc,ngrbstrd)
+!$OMP THREADPRIVATE(ngrbsund,ngrbsuvb,ngrbsvd,ngrbswl1,ngrbswl2,ngrbswl3,ngrbswl4,ngrbt,ngrbtbt,ngrbtcc,ngrbtcghg)
+!$OMP THREADPRIVATE(ngrbtcgrg,ngrbtciw,ngrbtclw,ngrbtco3,ngrbtctrac,ngrbtcw,ngrbtcwv,ngrbth,ngrbtp,ngrbtrac,ngrbtsn)
+!$OMP THREADPRIVATE(ngrbtsp,ngrbtsr,ngrbtsrc,ngrbttr,ngrbttrc,ngrbtvh,ngrbtvl,ngrbu,ngrbv,ngrbveg,ngrbvimd,ngrbvo)
+!$OMP THREADPRIVATE(ngrbvso,ngrbw,ngrbz,njdiag,njdomai,njiter,nleg,nlocgrb,nmethod,nmfr,nncep,nreference,nsec0,nsec1)
+!$OMP THREADPRIVATE(nsec2spm,nsec2spp,nsec3,nsec4,nsmaxnp,nsteplpp,nstream,nsystem,ntotens,nukm,rsec3,ssec3)
+!$OMP THREADPRIVATE(msec2gg,ngrbgp2,ngrbgp3,ngrbsp2,ngrbsp3,nsec2gg,rsec2,ssec2)
 END MODULE YOMGRB

LMDZ5/branches/testing/libf/phylmd/rrtm/yomgstats.F90

-                      r1999
+                      r2056
 INTEGER(KIND=JPIM) :: NPRNT_STATS=3
+!$OMP THREADPRIVATE(ccdesc,cctype,lbarrier_stats,ldetailed_stats,lgstats_label,lstats,lstats_alloc)
+!$OMP THREADPRIVATE(lstats_comms,lstats_mem,lstats_omp,lstatscpu,lsyncstats,ltrace_stats,myproc_stats)
+!$OMP THREADPRIVATE(ncalls,ncalls_total,nprnt_stats,nproc_stats,nstats_mem,ntmem,ntrace_stats,thistcpu)
+!$OMP THREADPRIVATE(thistime,thisvcpu,time_last_call,timelcall,timemax,timesqsum,timesum,timesumb)
+!$OMP THREADPRIVATE(ttcpulcall,ttcpusum,tvcpulcall,tvcpusum)
+!$OMP THREADPRIVATE(ncall_trace,nprcids_stats,time_start,time_trace)
 END MODULE YOMGSTATS

LMDZ5/branches/testing/libf/phylmd/rrtm/yomjfh.F90

r1999	r2056
13	13	! -----------------------------------------------------------------
14	14
	15	!$OMP THREADPRIVATE(n_vmass)
15	16	END MODULE YOMJFH

LMDZ5/branches/testing/libf/phylmd/rrtm/yomleg.F90

r1999	r2056
38	38	REAL(KIND=JPRB),ALLOCATABLE:: RIPI2(:)
39	39
	40	!$OMP THREADPRIVATE(r1mu2,r1mua,r1mui,r1qm2,racthe,ripi0,ripi1,ripi2,rlati,rlatig,rmu,rsqm2,rw)
40	41	END MODULE YOMLEG

LMDZ5/branches/testing/libf/phylmd/rrtm/yomlun.F90

-                      r1999
+                      r2056
 INTEGER(KIND=JPIM) :: NULTRAJBG
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(nbias,ncmafl,nefls,neflss,negash,nfgigg,nfgish,ninigg,ninish,ninmsh,npdirl,npoddh,npossh)
+!$OMP THREADPRIVATE(npppsh,nscasig,nscaspe,nscatab,nscrtch,ntcsr,ntide,ntrjsh,nulase,nulass,nulcl1,nulcl2,nulco)
+!$OMP THREADPRIVATE(nulcont,nuldila,nulfp01,nulfp02,nulfp03,nulfp04,nulfp05,nulfp06,nulfp07,nulfp08,nulfp09)
+!$OMP THREADPRIVATE(nulfp10,nulfp11,nulfp12,nulfp13,nulfp14,nulfp15,nulfpos,nulhwf,nulrad,nulrcf,nulref,nulrotc)
+!$OMP THREADPRIVATE(nulrtl,nulstat,nultmp,nultrajbg,nultrajhr,nulusr1,nulusr2,nulusr3,nulusr4,nulusr5,nuo3ch1,nuo3ch2)
 END MODULE YOMLUN

LMDZ5/branches/testing/libf/phylmd/rrtm/yomlun_ifsaux.F90

r1999	r2056
18	18
19	19	! ------------------------------------------------------------------
	20	!$OMP THREADPRIVATE(nulerr,nulout)
20	21	END MODULE YOMLUN_IFSAUX

LMDZ5/branches/testing/libf/phylmd/rrtm/yomlw15.F90

r1999	r2056
77	77	! RVGO315 : REAL RESIDUAL PRESSURE FOR O3 VOIGT LINE HALF-WIDTH
78	78	! ------------------------------------------------------------------
	79	!$OMP THREADPRIVATE(at15,bt15,ga15,gb15,mxixt15,ng115,ng1p115,nint15,nipd15,nipd215)
	80	!$OMP THREADPRIVATE(ntr15,ntra15,nua15,o1h15,o2h15,oct15,rntnu15,rpialf015,rt115,rvgco215)
	81	!$OMP THREADPRIVATE(rvgh2o15,rvgo315,tintp15,tref15,tstand15,tstp15,wg115,xp15)
79	82	END MODULE YOMLW15

LMDZ5/branches/testing/libf/phylmd/rrtm/yommddh.F90

-                      r1999
+                      r2056
 ! ---- DDH
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(bdeddh,fnoddh,hdsfgl,ndhaend,ndhaenp,ndhahkd,ndhahkp,ndhamcd)
+!$OMP THREADPRIVATE(ndhamcp,ndhavd,ndhavp,ndhbend,ndhbenp,ndhbhkd,ndhbhkp,ndhbmcd)
+!$OMP THREADPRIVATE(ndhbmcp,ndhbpu,ndhbpx,ndhbvd,ndhbvp,ndhcs,ndhcssu,ndhcv,ndhcvsu)
+!$OMP THREADPRIVATE(ndhcvsul,ndhcvsun,ndhddx,ndhfend,ndhfenp,ndhffs,ndhfhkd,ndhfhkp)
+!$OMP THREADPRIVATE(ndhfiis,ndhfmcd,ndhfmcp,ndhfsd,ndhfsp,ndhfsss,ndhftis,ndhftls)
+!$OMP THREADPRIVATE(ndhftss,ndhftts,ndhfvd,ndhfvp,ndhfwls,ndhidh,ndhkd,ndhnom,ndhnpu)
+!$OMP THREADPRIVATE(ndhten,ndhthk,ndhtmc,ndhven,ndhvfs,ndhvhk,ndhviis,ndhvmc,ndhvs)
+!$OMP THREADPRIVATE(ndhvsss,ndhvtis,ndhvtls,ndhvtss,ndhvtts,ndhvv,ndhvwls,ndhzpr)
+!$OMP THREADPRIVATE(hdsf,hdsfdu,hdsfla,nddhi,nddhla,nddhpu,nlrddh,nlxddh,nurddh,nuxddh)
 END MODULE YOMMDDH

LMDZ5/branches/testing/libf/phylmd/rrtm/yommp.F90

-                      r1999
+                      r2056
 ! ----------------------------------------------------------------------
+!$OMP THREADPRIVATE(leq_regions,limp,limp_noolap,lockio,lsplit,lsplitout,mbx_size,mp_type,my_region_ew,my_region_ns)
+!$OMP THREADPRIVATE(myfrstactlat,mylstactlat,myproc,myseta,mysetb,mysetm,mysetn,mysetv,mysetw,nafpb1,napsets,narib1)
+!$OMP THREADPRIVATE(narob1,naslb1,nblkout,nbsetsp,ncombflen,ncpec2v,nfldin,nfldout,nfpmpbufsz,nfpprocs,nfprpt,nfpspt)
+!$OMP THREADPRIVATE(nfrstloff,ngathout,nintype,nouttype,npsp,nptrfloff,nrimpbufsz,nriprocs,nrirpt,nrispt,nrompbufsz)
+!$OMP THREADPRIVATE(nroprocs,nrorpt,nrospt,nslmpbufsz,nslpad,nslprocs,nslrpt,nslspt,nspec2v,nspec2vf,nstrin,nstrout)
+!$OMP THREADPRIVATE(ntpec2v,numxp,nwrtout)
+!$OMP THREADPRIVATE(lsplitlat,mylats,mylevs,nallms,nbsetlev,nfpcomm,nfpcore,nfpext,nfpoff,nfponl,nfprecvpos,nfprecvptr)
+!$OMP THREADPRIVATE(nfpsendpos,nfpsendptr,nfpsta,nfrstlat,nglobalindex,nglobalproc,ngpset2pe,nlocalindex,nlstlat,noboff)
+!$OMP THREADPRIVATE(nobonl,nobsta,nonl,nprcids,nprocm,npsurf,nptrcv,nptrfrstlat,nptrlat,nptrll,nptrls,nptrlstlat,nptrmf)
+!$OMP THREADPRIVATE(nptrms,nptrsv,nptrsvf,nptrtv,nrecvptr,nricomm,nricore,nriext,nrioff,nrionl,nrirecvpos,nrirecvptr)
+!$OMP THREADPRIVATE(nrisendpos,nrisendptr,nrista,nrocomm,nrocore,nroext,nrooff,nroonl,nrorecvpos,nrorecvptr,nrosendpos)
+!$OMP THREADPRIVATE(nrosendptr,nrosta,nsendptr,nslcomm,nslcore,nslext,nsloff,nslonl,nslrecvpos,nslsendpos,nslsta)
+!$OMP THREADPRIVATE(nspstaf,nsta,numll,numpp,numprocfp,numvmo,numvmojb,numxpp,nvmodist)
 END MODULE YOMMP

LMDZ5/branches/testing/libf/phylmd/rrtm/yomoml.F90

-                      r1999
+                      r2056
 LOGICAL :: OML_DEBUG = .FALSE.
+!$OMP THREADPRIVATE(OML_DEBUG)
 PUBLIC OML_WAIT_EVENT, OML_SET_EVENT, OML_INCR_EVENT, &
 …
 !-- Note: Still JPIM !!
 INTEGER(KIND=JPIM) :: M_EVENT = 0
+!$OMP THREADPRIVATE(M_EVENT)
 !-- Note: OML_LOCK_KIND, not JPIM !!
 INTEGER(KIND=OML_LOCK_KIND) :: M_LOCK(2) = (/-1, -1/)
+!$OMP THREADPRIVATE(M_LOCK)
 CONTAINS

LMDZ5/branches/testing/libf/phylmd/rrtm/yomphy.F90

-                      r1999
+                      r2056
 INTEGER(KIND=JPIM), PARAMETER  ::  JPHYARO =   3  ! for AROME physics
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(cgmixlen,l1drhcri,l2phys,l3mt,ladjcld,laerodes,laerolan,laerosea,laerosoo,laerosul)
+!$OMP THREADPRIVATE(laerovol,lajucv,lautoneb,lbccond,lblvar,lcape,lcddpro,lclsatur,lcollec,lcondwt,lcvcas)
+!$OMP THREADPRIVATE(lcvdd,lcvlis,lcvpgy,lcvpp,lcvppkf,lcvpro,lcvra,lcvrav3,ldifcons,lect,lectfl,levapp,lfgel)
+!$OMP THREADPRIVATE(lfgels,lfpcor,lglt,lgwd,lgwdc,lgwrhcri,lhmto,lhucn,lhuneg,lmphys,lnd2diff,lnebco,lnebgr)
+!$OMP THREADPRIVATE(lnebgy,lnebn,lnebnxr,lnebr,lnebt,lneige,lnewd,lnewstat,lnoias,lnsmlis,lo3abc,lozone,lpble)
+!$OMP THREADPRIVATE(lphcdpi,lphspsh,lpil,lprgml,lprocld,lptke,lqxrtgh,lrautoev,lray,lrayfm,lrayfm15,lraylu)
+!$OMP THREADPRIVATE(lraypl,lreasur,lrelaxt,lrelaxw,lrews,lrmix,lrnumx,lrprox,lrrgust,lrrmes,lrstab,lrtdl)
+!$OMP THREADPRIVATE(lrtpp,lscmf,lsfhyd,lslc,lsmnimbt,lsmrot,lsmtps,lsnv,lsolv,lsrcon,lsrcont,lssd,lstra)
+!$OMP THREADPRIVATE(lstrapro,lstras,lthermo,lvdif,lvfull,lvgsn,lvoigt,lz0hsrel,nbiter,ndpsfi,noir,nphy)
+!$OMP THREADPRIVATE(nphyrep,nprac,nprag,nprri,nsmdneb,nsmtbot)
 END MODULE YOMPHY

LMDZ5/branches/testing/libf/phylmd/rrtm/yomphy0.F90

-                      r1999
+                      r2056
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(a0ml_at,a0ml_au,a0ml_bt,a0ml_bu,acbrphim,acg,adise,adisi,aecls3,aecls4,aercs1,aercs3,aercs5)
+!$OMP THREADPRIVATE(agre1,agre2,agref,agreke,agrericr,ahclpv,aj1meps,aj1peps,ajbumin,akn,ald,alfx,almav,almave)
+!$OMP THREADPRIVATE(alphae,alphat,arsb2,arsc1,arsc2,arsch,arscq,arsct,bedifv,ecmnp,ecmnpi,ectmin,edb,edc,edd,edk)
+!$OMP THREADPRIVATE(eps,etacut,evap,fentrt,fevapc,fnebc,font,fqlic,galp,gamap1,gamtke,gccsv,gcismin,gcomod,gcvachi)
+!$OMP THREADPRIVATE(gcvadmw,gcvads,gcvalfa,gcvalmx,gcvbee,gcvbeta,gcveex,gcvmlt,gcvnu,gcvpsi,gcvpsie,gcvsqdcx)
+!$OMP THREADPRIVATE(gcvsqdn,gcvsqdr,gddbeta,gddeva,gddevf,gddsde,gddwpf,gfric,gpblhk0,gpblhra,grcvpp,grhcmod,grrinte)
+!$OMP THREADPRIVATE(grrmina,gwbfaut,gwdamp,gwdbc,gwdcco,gwdcd,gwdlt,gwdprof,gwdse,gwdvali,hcmin,hobst,hucoe,hucoe2)
+!$OMP THREADPRIVATE(hutil,hutil1,hutil2,najiter,npclo1,npclo2,nrhcri,nsmtpa,nsmtpb,nuptke,qsmin,qsnebc,qsnebs,qssc)
+!$OMP THREADPRIVATE(qssusc,qssuss,qssusv,qsusxc,qsusxs,qxral,qxrdel,qxrhx,qxrr,qxrtgh,raccef,raggef,rauitn,rauitx)
+!$OMP THREADPRIVATE(rauiuste,rautefr,rautefs,rautsbet,rcin,rcoflm,rcoll,rcvevap,rdphic,rdtfac,retamin,revgsl,rfacnsm)
+!$OMP THREADPRIVATE(rfalll,rhcrit1,rhcrit2,rhevap,ricret,ricrlm,rkdn,rnegat,rnintr,rnints,rnlcurv,rphi0,rphir,rqcrns)
+!$OMP THREADPRIVATE(rqicrmax,rqicrmin,rqicrsn,rqicrt1,rqicrt2,rqicvmax,rqicvmin,rqlcr,rqlcv,rrgamma,rrimef,rrscale)
+!$OMP THREADPRIVATE(rsmdnebx,rsmdtx,rtcape,rwbf1,rwbf2,sco,sensl,snnbco,spnbco,sttbmin,sxnbco,tca,tct,tctc,tcw,tddbu)
+!$OMP THREADPRIVATE(tddfr,tddgp,tentr,tentrd,tentrvl,tentrx,tfvr,tfvs,trentrv,tudbu,tudfr,tudgp,turb,tvf,tvfc,tym)
+!$OMP THREADPRIVATE(ucwstar,udect,ueteps,uhdifv,untier,upreclp,upretmax,upretmin,usdmlt,ushearm,usuprc,usuric,usurice)
+!$OMP THREADPRIVATE(usuricl,usurid,usuride,utilgust,vchrnk,vkarmn,vvn,vvx,vz0cm,vziustar0,xblm,xklm,xmaxlm,xminlm)
+!$OMP THREADPRIVATE(xnbmax,xwsalm,xwsblm)
+!$OMP THREADPRIVATE(rhcri)
 END MODULE YOMPHY0

LMDZ5/branches/testing/libf/phylmd/rrtm/yomphy1.F90

-                      r1999
+                      r2056
 INTEGER(KIND=JPIM) :: NCHSP
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(alb1,alb2,albgla,albmax,albmed,albmer,albmin,alcrin,alrcn1,alrcn2,ea,ec2ref,emcrin,emmgla)
+!$OMP THREADPRIVATE(emmmer,ewfc,ewwilt,g1b,g1c1sat,g1cgsat,g1p,g1wsat,g2b,g2c1sat,g2cgsat,g2p,g2wsat,g3cgsat)
+!$OMP THREADPRIVATE(ga,gc1,gc1s1,gc1s2,gc1s3,gc1s4,gc1y1,gc2,gc2ref,gc3,gc31,gc32,gcgel,gcgels,gconv,gcz0h,gf1)
+!$OMP THREADPRIVATE(gf3,gf4,glaimx,glaimxs,gneimx,gneimxs,gsnc1,gsnc2,gtsvap,gvegmx,gvegmxs,gwfc,gwlex,gwlmx)
+!$OMP THREADPRIVATE(gwpimx,gwwilt,hsol,hsolit0,hsoliwr,lc1vap,limc,limw,nchsp,ntvgla,ntvmer,omtpro,omwpro,rc1max)
+!$OMP THREADPRIVATE(rcgmax,rctgla,rctveg,rd1,rd2gla,rd2mer,rgl,rhomax,rhomin,rlai,rlaimx,rsmax,rtiner,rz0gla)
+!$OMP THREADPRIVATE(rz0mer,rzhgla,rzhmer,rzhz0g,rzhz0m,sodelx,tmergl,toexp,tolin,tref4,wcrin,wcrinc,wcring)
+!$OMP THREADPRIVATE(wnew,wpmx,wsmx,xcrinr,xcrinv)
 END MODULE YOMPHY1

LMDZ5/branches/testing/libf/phylmd/rrtm/yomphy2.F90

r1999	r2056
65	65	LOGICAL :: LMULAF
66	66	! ------------------------------------------------------------------
	67	!$OMP THREADPRIVATE(facraf,gz0raf,hclp,htcls,htshm,htsml,hvcls,lmulaf,lraftur,ntshm,ntsml,ripblc,tsphy)
	68	!$OMP THREADPRIVATE(xdamp,xmucvpp,xmulaf)
67	69	END MODULE YOMPHY2

LMDZ5/branches/testing/libf/phylmd/rrtm/yomphy3.F90

-                      r1999
+                      r2056
 REAL(KIND=JPRB) :: REXP_NEB
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(bsfsa,bsfsi,bsfsn,bsfta,bsfti,bsftn,earrt,eoasa,eoasi,eoasn,eoata,eoati,eoatn,eodsa,eodsi)
+!$OMP THREADPRIVATE(eodsn,eodta,eodti,eodtn,eoray,fcm_del_a,fcm_del_d,fcm_mu_a,fcm_mu_d,fcm_n_i,fcm_n_l,fcm_p_ai)
+!$OMP THREADPRIVATE(fcm_p_al,fcm_p_di,fcm_p_dl,fcm_p_gi,fcm_p_gl,fcm_q_ai,fcm_q_al,fcm_q_di,fcm_q_dl,fcm_q_gi)
+!$OMP THREADPRIVATE(fcm_q_gl,gca,gcb,gcc,gcd4,gce4,girec1,girec2,girec3,girec4,qco2,qlimi,qlip0,rexp_neb,rii0)
+!$OMP THREADPRIVATE(usaa,usai,usan,usba,usbi,usbn,vdp,vnp)
 END MODULE YOMPHY3

LMDZ5/branches/testing/libf/phylmd/rrtm/yompldsw.F90

r1999	r2056
10	10	LOGICAL :: LOPT_RS6K
11	11	! ------------------------------------------------------------------
	12	!$OMP THREADPRIVATE(lopt_rs6k,lopt_scalar)
12	13	END MODULE YOMPLDSW

LMDZ5/branches/testing/libf/phylmd/rrtm/yomprad.F90

-                      r1999
+                      r2056
 INTEGER(KIND=JPIM),ALLOCATABLE:: NRCRCVWO(:,:,:)
 INTEGER(KIND=JPIM),ALLOCATABLE:: NRCRCVEO(:,:,:)
+!$OMP THREADPRIVATE(lodbgradi,lodbgradl,lradondem,lradondem_active,nfixradfld,nrimaxla,nrimaxlb)
+!$OMP THREADPRIVATE(nrimaxln,nrimaxlt,nrimaxt,nrlbchunks,nrlbdata,nrlbpoints,nrlprcs,nrlrchunks)
+!$OMP THREADPRIVATE(nrlrdata,nrlrpoints,radgrid)
+!$OMP THREADPRIVATE(mask_ri1,mask_ri2,mask_ro1,mask_ro2,nrcneede,nrcneedw,nrcrcve,nrcrcveo,nrcrcvt)
+!$OMP THREADPRIVATE(nrcrcvw,nrcrcvwo,nrcsnde,nrcsndt,nrcsndw,nrfrstoff,nrimax,nrirint,nrlastoff)
 END MODULE YOMPRAD

LMDZ5/branches/testing/libf/phylmd/rrtm/yomrad15.F90

r1999	r2056
66	66	! LNEWAER15 :LOGICAL : .TRUE. IF TEGEN AEROSOLS ARE USED
67	67	! ------------------------------------------------------------------
	68	!$OMP THREADPRIVATE(lerad6h15,leradhs15,lnewaer15,lradaer15,lradlb15,naer15,nflux15,nmode15,novlp15)
	69	!$OMP THREADPRIVATE(nrad15,nradc2f15,nradf2c15,nradfr15,nradnfr15,nradpfr15,nradpla15,nradsfr15,nrint15,nrproma15)
68	70	END MODULE YOMRAD15

LMDZ5/branches/testing/libf/phylmd/rrtm/yomradf.F90

r1999	r2056
42	42	REAL(KIND=JPRB),ALLOCATABLE :: RMOON(:,:)
43	43
	44
	45	!$OMP THREADPRIVATE(edro,emtc,emtd,emtu,rmoon,srlwd,srlwdcs,srswd,srswdcs,srswduv)
	46	!$OMP THREADPRIVATE(srswdv,srswpar,srswparc,srswtinc,srswuvb,trsc,trsw)
44	47	END MODULE YOMRADF

LMDZ5/branches/testing/libf/phylmd/rrtm/yomrcoef.F90

r1999	r2056
80	80
81	81	! ----------------------------------------------------------------
	82	!$OMP THREADPRIVATE(lglobrad,lrcoef,ltladdia,nexpbsr,nexpbthr,ng3sr,ngmtr,nlatrd,nlatwr,nlengsrb)
	83	!$OMP THREADPRIVATE(nlengtrb,npckfsr,npckfthr)
	84	!$OMP THREADPRIVATE(solrad,therrad,trmatsum,trweight)
82	85	END MODULE YOMRCOEF

LMDZ5/branches/testing/libf/phylmd/rrtm/yomrdi15.F90

r1999	r2056
59	59	! TO BE MORE THAN THE RESPECTIVE VALUE AT SATURATION.
60	60	! -----------------------------------------------------------------
	61	!$OMP THREADPRIVATE(ralbice15,ralbsea15,ralbsnm15,ralbsno15,rcardi15,rcfc1115,rcfc1215,rch415)
	62	!$OMP THREADPRIVATE(remiss15,repalb15,repclc15,reph2o15,rmu0015,rn2o15,rrae15,rsdtsn15,rsnowal15,rvlbdc15)
61	63	END MODULE YOMRDI15

LMDZ5/branches/testing/libf/phylmd/rrtm/yomrdu15.F90

r1999	r2056
52	52	! REPSCW15 : REAL SEC. EPSILON FOR CLOUD LIQUID WATER PATH
53	53	! -----------------------------------------------------------------
	54	!$OMP THREADPRIVATE(diff15,nimp15,nout15,ntraer15,nuaer15,r10e15,rcday15,reelog15)
	55	!$OMP THREADPRIVATE(repsc15,repsco15,repscq15,repsct15,repscw15,repsec15)
54	56	END MODULE YOMRDU15

LMDZ5/branches/testing/libf/phylmd/rrtm/yomrip.F90

r1999	r2056
99	99	REAL(KIND=JPRB) :: RSIVSRLU
100	100	! ------------------------------------------------------------------
	101	!$OMP THREADPRIVATE(nindat,nsssss,nstadd,nstass,rcodec,rcodeclu,rcovsr,rcovsrlu,rdeaso,rdecli,rdeclu)
	102	!$OMP THREADPRIVATE(rdts22,rdts62,rdtsa,rdtsa2,reqtim,rhgmt,rip0,rip0lu,rsidec,rsideclu,rsivsr)
	103	!$OMP THREADPRIVATE(rsivsrlu,rsovr,rstati,rtdt,rtimst,rtimtr,rtmolt,rwsovr)
101	104	END MODULE YOMRIP

LMDZ5/branches/testing/libf/phylmd/rrtm/yomsc2.F90

r1999	r2056
49	49
50	50	!-----------------------------------------------------------------------
	51	!$OMP THREADPRIVATE(nfldobb1,nfldslb1,nfldslb15,nfldslb2,nobwide,nriwidee,nriwiden,nriwides)
	52	!$OMP THREADPRIVATE(nriwidew,nrowidee,nrowiden,nrowides,nrowidew,nslwide)
	53	!$OMP THREADPRIVATE(nciend,ncist,ndiend,ndist)
51	54	END MODULE YOMSC2

LMDZ5/branches/testing/libf/phylmd/rrtm/yomscm.F90

r1999	r2056
51	51	INTEGER(KIND=JPIM) :: NSCM_ADD_SAMPL
52	52
	53	!$OMP THREADPRIVATE(gscm_lat1,gscm_lat2,gscm_lon1,gscm_lon2,gscm_radius,lgscm,nfrscm,nscm_add_sampl,nscm_space_s,nscmts)
53	54	END MODULE YOMSCM

LMDZ5/branches/testing/libf/phylmd/rrtm/yomsimphl.F90

r1999	r2056
51	51
52	52	! ----------------------------------------------------------------
	53	!$OMP THREADPRIVATE(lclouds,lcvrasp,lgwdsp,lraysp,lrrmessp,lsimph,lsmootha,lsmoothb,lsmoothd,lstrasp)
	54	!$OMP THREADPRIVATE(ltrajps,ltrajpst,lvdifsp)
53	55	END MODULE YOMSIMPHL

LMDZ5/branches/testing/libf/phylmd/rrtm/yomslphy.F90

r1999	r2056
26	26	INTEGER(KIND=JPIM) :: MSAVTEND_S
27	27
	28	!$OMP THREADPRIVATE(lslphy,msat_savtend,msat_savtend_s,msavtend_s,mt_savtend,mt_savtend_s)
	29	!$OMP THREADPRIVATE(mu_savtend,mu_savtend_s,mv_savtend,mv_savtend_s,nvtend)
	30	!$OMP THREADPRIVATE(savtend)
28	31	END MODULE YOMSLPHY

LMDZ5/branches/testing/libf/phylmd/rrtm/yomsta.F90

-                      r1999
+                      r2056
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(hextrap,nlextrap,rdtdz1,rdtdz2,rdtdz3,rdtdz4,rdtdz5,rdtdz6,rdtdz7,rdtdz8,rdtdz9)
+!$OMP THREADPRIVATE(rpabov,rpmepo,rpmes2,rpmeso,rpstpo,rpstr2,rpstra,rptrop,rtabov,rtmepo,rtmes2,rtmeso)
+!$OMP THREADPRIVATE(rtstpo,rtstr2,rtstra,rtsur,rttrop,rzabov,rzmepo,rzmes2,rzmeso,rzstpo,rzstr2,rzstra)
+!$OMP THREADPRIVATE(rztrop,vdtdz1,vdtdz2,vdtdz3,vdtdz4,vdtdz5,vdtdz6,vdtdz7,vdtdz8,vdtdz9,vpabov,vpmepo)
+!$OMP THREADPRIVATE(vpmes2,vpmeso,vpstpo,vpstr2,vpstra,vptrop,vtabov,vtmepo,vtmes2,vtmeso,vtstpo,vtstr2)
+!$OMP THREADPRIVATE(vtstra,vtsur,vttrop,vzabov,vzmepo,vzmes2,vzmeso,vzstpo,vzstr2,vzstra,vztrop)
+!$OMP THREADPRIVATE(stden,stphi,stpre,stpreh,sttem,stz)
 END MODULE YOMSTA

LMDZ5/branches/testing/libf/phylmd/rrtm/yomsw15.F90

r1999	r2056
51	51	! RTUMG15 : REFERENCE TEMPERATURE UNIFORMLY MIXED GASES
52	52	! -----------------------------------------------------------------
	53	!$OMP THREADPRIVATE(apad15,bpad15,d15,rpdh115,rpdu115,rpnh15,rpnu15,rray15,rsun15,rswce15,rswcp15)
	54	!$OMP THREADPRIVATE(rtdh2o15,rtdumg15,rth2o15,rtumg15)
53	55	END MODULE YOMSW15

LMDZ5/branches/testing/libf/phylmd/rrtm/yomtag.F90

-                      r1999
+                      r2056
 INTEGER(KIND=JPIM) :: MTAGDISTFO
+!$OMP THREADPRIVATE(mt_distributed_vector,mtagbdy,mtagbrpr,mtagcain,mtagcost,mtagddh1,mtagddh2,mtagddh3,mtagddh4)
+!$OMP THREADPRIVATE(mtagddhres,mtagdistfo,mtagdistgp,mtagdistsp,mtageigmd,mtagfce,mtagfreq,mtaggetv,mtagglobsi)
+!$OMP THREADPRIVATE(mtagglobsr,mtaggom,mtaggpnorm,mtaggsum,mtagke,mtaglcz,mtaglm,mtagmn,mtagms,mtagmv,mtagnm)
+!$OMP THREADPRIVATE(mtagobseq,mtagobseqad,mtagozon,mtagpart,mtagrad,mtagrcbdy,mtagrclb,mtagrclbi,mtagreadvec)
+!$OMP THREADPRIVATE(mtagsig,mtagslag,mtagsm,mtagspno,mtagtide,mtagvh)
 END MODULE YOMTAG

LMDZ5/branches/testing/libf/phylmd/rrtm/yomtddh.F90

r1999	r2056
310	310	! IF LHDMCI
311	311	! IF LHDENT
312
	312	!$OMP THREADPRIVATE(hdcs0,hdcs1,hdcvb0,hdcvb1,pddhfsvi)
313	313	END MODULE YOMTDDH

LMDZ5/branches/testing/libf/phylmd/rrtm/yomtoph.F90

-                      r1999
+                      r2056
 !     ------------------------------------------------------------------
+!$OMP THREADPRIVATE(etajuc,etcoef,etcoefe,etcoet,etcvim,etdifu,etdrag,etdrme,etnebu,etozon,etplui)
+!$OMP THREADPRIVATE(etqsat,etradi,ntajuc,ntcoef,ntcoefe,ntcoet,ntcvim,ntdifu,ntdrag,ntdrme,ntnebu)
+!$OMP THREADPRIVATE(ntozon,ntplui,ntqsat,ntradi,rclx,rfmesoq,tpsclim,xdrmqk,xdrmqp,xdrmtk,xdrmtp)
+!$OMP THREADPRIVATE(xdrmtx,xdrmuk,xdrmup,xdrmux)
+!$OMP THREADPRIVATE(rmesoq,rmesot,rmesou)
 END MODULE YOMTOPH

LMDZ5/branches/testing/libf/phylmd/rrtm/yomvdoz.F90

r1999	r2056
74	74	LOGICAL :: LRDEPOZ
75	75	! ---------------------------------------------------------------------
	76	!$OMP THREADPRIVATE(lrdepoz,lrdifoz,vdajh,vdajs,vdanh,vdans,vdejh,vdejs,vdenh,vdens,vdhjh,vdhjs)
	77	!$OMP THREADPRIVATE(vdhnh,vdhns,vdnjh,vdnjs,vdnnh,vdnns,vdpjh,vdpjs,vdpnh,vdpns,vozhs,voznj)
76	78	END MODULE YOMVDOZ

LMDZ5/branches/testing/libf/phylmd/rrtm/yophlc.F90

r1999	r2056
53	53	! X(T+1)=X(T-1)+2*DX
54	54	! -----------------------------------------------------------------
	55	!$OMP THREADPRIVATE(ah0,alandz0,alpha,aseaz0,lczdeb,lkexp,lsdrds,lsdrlc,lsphlc,lvdfds,lvdflc,lzmcon,ustarl,ustars)
55	56	END MODULE YOPHLC

LMDZ5/branches/testing/libf/phylmd/rrtm/yophnc.F90

r1999	r2056
50	50
51	51	! ------------------------------------------------------------------
	52	!$OMP THREADPRIVATE(lecond2,lecubm2,lecumf2,ledcld2,legwdg2,lekpert,lencld2,leqngt2,leradfl2,leradi2)
	53	!$OMP THREADPRIVATE(leradn2,lerads2,leradsw2,lesurf2,letrajp,letrajpt,levapls2,levdif2,ltraclnph)
52	54	END MODULE YOPHNC

LMDZ5/branches/testing/libf/phylmd/surf_land_orchidee_mod.F90

-                      r1910
+                      r2056
 ! zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/287.05*temp_air(1:knon))*9.80665)
+    zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/RD*temp_air(1:knon))*RG)
+!    zlev(1:knon) = (100.*plev(1:knon))/((ps(1:knon)/RD*temp_air(1:knon))*RG)
+     zlev(1:knon) = plev(1:knon)*RD*temp_air(1:knon)/((ps(1:knon)*100.0)*RG)

LMDZ5/branches/testing/libf/phylmd/thermcell.h

-                      r1910
+                      r2056
       real,parameter     :: r_aspect_thermals=2.,l_mix_thermals=30.
       real               :: alp_bl_k
       real               :: tau_thermals
+      real               :: tau_thermals,fact_thermals_ed_dz
       integer,parameter  :: w2di_thermals=0
       integer            :: isplit
       integer            :: iflag_coupl,iflag_clos,iflag_wake
       integer            :: iflag_thermals_ed,iflag_thermals_optflux
+      integer            :: iflag_thermals_ed,iflag_thermals_optflux,iflag_thermals_closure
       common/ctherm1/iflag_thermals,nsplit_thermals
       common/ctherm2/tau_thermals,alp_bl_k
+      common/ctherm1/iflag_thermals,nsplit_thermals,iflag_thermals_closure
+      common/ctherm2/tau_thermals,alp_bl_k,fact_thermals_ed_dz
       common/ctherm4/iflag_coupl,iflag_clos,iflag_wake
       common/ctherm5/iflag_thermals_ed,iflag_thermals_optflux

LMDZ5/branches/testing/libf/phylmd/thermcell_dry.F90

-                      r1910
+                      r2056
                zw2(ig,l+1)=0.
                lmax(ig)=l
+!            endif
+!CR:zmax continu 06/05/12: calcul de linter quand le thermique est stoppe par le detrainement
+            elseif (f_star(ig,l+1).lt.0.) then
+               linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
+     &           -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
+               zw2(ig,l+1)=0.
+               lmax(ig)=l
             endif
+!CRfin
                wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))

LMDZ5/branches/testing/libf/phylmd/thermcell_height.F90

-                      r1910
+                      r2056
       enddo
+      if (iflag_thermals_ed.ge.1) then
+!     if (iflag_thermals_ed.ge.1) then
+      if (1==0) then
+!CR:date de quand le calcul du zmax continu etait buggue
          num(:)=0.
          denom(:)=0.
 …
        endif
        enddo
        else
+      else
+!CR:Calcul de zmax continu via le linter
       do  ig=1,ngrid
 ! calcul de zlevinter

LMDZ5/branches/testing/libf/phylmd/thermcell_main.F90

-                      r1999
+                      r2056
     &                      lalim,lmin,zmax_sec,wmax_sec,lev_out)
 call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
 call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
 …
       alim_star_clos(:,:)=alim_star(:,:)
       alim_star_clos(:,:)=entr_star(:,:)+alim_star(:,:)
+! Appel avec la version seche
+!
+!CR Appel de la fermeture seche
+      if (iflag_thermals_closure.eq.1) then
       CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho,  &
      &   zlev,lalim,alim_star_clos,f_star,zmax_sec,wmax_sec,f,lev_out)
 …
 ! Appel avec les zmax et wmax tenant compte de la condensation
 ! Semble moins bien marcher
+!     CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho,  &
+!    &   zlev,lalim,alim_star,f_star,zmax,wmax,f,lev_out)
+     else if (iflag_thermals_closure.eq.2) then
+     CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho,  &
+    &   zlev,lalim,alim_star,f_star,zmax,wmax,f,lev_out)
+     endif
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 …
       do ig=1,ngrid
         if (ok_lcl(ig)) then
+          if ((pplay(ig,l) .ge. pcon(ig)) .and. (pplay(ig,l+1) .le. pcon(ig))) then
+!ATTENTION,zw2 calcule en pplev
+!          if ((pplay(ig,l) .ge. pcon(ig)) .and. (pplay(ig,l+1) .le. pcon(ig))) then
+!          klcl(ig)=l
+!          interp(ig)=(pcon(ig)-pplay(ig,klcl(ig)))/(pplay(ig,klcl(ig)+1)-pplay(ig,klcl(ig)))
+!          endif
+          if ((pplev(ig,l) .ge. pcon(ig)) .and. (pplev(ig,l+1) .le. pcon(ig))) then
           klcl(ig)=l
           interp(ig)=(pcon(ig)-pplay(ig,klcl(ig)))/(pplay(ig,klcl(ig)+1)-pplay(ig,klcl(ig)))
+          interp(ig)=(pcon(ig)-pplev(ig,klcl(ig)))/(pplev(ig,klcl(ig)+1)-pplev(ig,klcl(ig)))
           endif
         endif
 …
 !!    enddo
     do ig =1,ngrid
+     zmax(ig)=pphi(ig,lmax(ig))/rg
+!CR:REHABILITATION ZMAX CONTINU
+!     zmax(ig)=pphi(ig,lmax(ig))/rg
      if (ok_lcl(ig)) then
       rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &
 …
 !------------Closure------------------
   IF (iflag_clos_bl.ge.1) THEN
+  IF (iflag_clos_bl.ge.2) THEN
 !-----Calcul de ALP_BL_STAT
 …
   enddo
   ENDIF ! (iflag_clos_bl.ge.1)
+  ENDIF ! (iflag_clos_bl.ge.2)
 !!! fin nrlmd le 10/04/2012

LMDZ5/branches/testing/libf/phylmd/thermcell_plume.F90

-                      r1999
+                      r2056
      &           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
      &           ,lev_out,lunout1,igout)
 !--------------------------------------------------------------------------
+! thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
+! Last modified : Arnaud Jam 2014/02/11
+!                 Better representation of stratocumulus
+!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
 !--------------------------------------------------------------------------
 …
       real zbuoyjam(ngrid,klev)
       real zbuoybis,zdz2,zdz3,lmel,entrbis,zdzbis
+      real fact_shell
+      real ztv1,ztv2,factinv,zinv,zlmel
+      real ztv_est1,ztv_est2
       real zcor,zdelta,zcvm5,qlbef
       real betalpha,zbetalpha
 …
       fact_epsilon=0.002
       betalpha=0.9
+      afact=2./3.
+      afact=2./3.
+      fact_shell=0.85
       zbetalpha=betalpha/(1.+betalpha)
 …
                lalim(ig)=l+1
                alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
 !              print*,'alim2',l,ztv(ig,l),ztv(ig,l+1),alim_star(ig,l)
+!               print*,'alim2',l,ztv(ig,l),ztv(ig,l+1),alim_star(ig,l)
             endif
          enddo
 …
    call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
     do ig=1,ngrid
 !      print*,'active',active(ig),ig,l
+!       print*,'active',active(ig),ig,l
         if(active(ig)) then
         zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
 …
 !    &                     Max(0.0001,exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2)
 !              w_est(ig,l+1)=Max(0.0001,(1-exp(-zw2fact))*zdw2+w_est(ig,l)*exp(-zw2fact))
+!--------------------------------------------------
+!AJ052014: J'ai remplac? w_est(ig,l) par zw2(ig,l)
+!--------------------------------------------------
+         if (iflag_thermals_ed==8) then
+! Ancienne version
              w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
     &                     (w_est(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
     &                     (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2))
+             if (w_est(ig,l+1).lt.0.) then
+! Nouvelle version Arnaud
+         else
+              w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
+    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
+    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
+         endif
+         if (iflag_thermals_ed<6) then
+             zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
+!              fact_epsilon=0.0005/(zalpha+0.025)**0.5
+!              fact_epsilon=Min(0.003,0.0004/(zalpha)**0.5)
+              fact_epsilon=0.0002/(zalpha+0.1)
+              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+              zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
+              zdw2=afact*zbuoy(ig,l)/fact_epsilon
+              zdw2bis=afact*zbuoy(ig,l-1)/fact_epsilon
+              w_est(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
+    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
+    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
+         endif
+!--------------------------------------------------
+!AJ052014: J'ai comment? ce if plus n?cessaire puisqu'
+!on fait max(0.0001,.....)
+!--------------------------------------------------
+!             if (w_est(ig,l+1).lt.0.) then
 !               w_est(ig,l+1)=zw2(ig,l)
+                w_est(ig,l+1)=0.0001
+             endif
+!                w_est(ig,l+1)=0.0001
+!             endif
        endif
     enddo
 …
 !Modif AJAM
+        lmel=0.1*zlev(ig,l)
+        lmel=fact_thermals_ed_dz*zlev(ig,l)
+        zlmel=zlev(ig,l)+lmel
 !        lmel=2.5*(zlev(ig,l)-zlev(ig,l-1))
         lt=l+1
+         do it=1,klev-(l+1)
+          zdz2=zlev(ig,lt)-zlev(ig,l)
+          if (zdz2.gt.lmel) then
+          zdz3=zlev(ig,lt)-zlev(ig,lt-1)
+        zdz2=zlev(ig,lt)-zlev(ig,l)
+!--------------------------------------------------
+!AJ052014: J'ai remplac? la boucle do par un do while
+! afin de faire moins de calcul dans la boucle
+!--------------------------------------------------
+         do while (zdz2.lt.lmel)
+         lt=lt+1
+         zdz2=zlev(ig,lt)-zlev(ig,l)
+         end do
+         zdz3=zlev(ig,lt)-zlev(ig,lt-1)
+!--------------------------------------------------
+!AJ052014: Si iflag_thermals_ed<8 (par ex 6), alors
+! on cherche o? se trouve l'altitude d'inversion
+! en calculant ztv1 (interpolation de la valeur de
+! theta au niveau lt en utilisant les niveaux lt-1 et
+! lt-2) et ztv2 (interpolation avec les niveaux lt+1
+! et lt+2). Si theta r?ellement calcul?e au niveau lt
+! comprise entre ztv1 et ztv2, alors il y a inversion
+! et on calcule son altitude zinv en supposant que ztv(lt)
+! est une combinaison lin?aire de ztv1 et ztv2.
+! Ensuite, on calcule la flottabilit? en comparant
+! la temp?rature de la couche l ? celle de l'air situ?
+! l+lmel plus haut, ce qui n?cessite de savoir quel fraction
+! de cet air est au-dessus ou en-dessous de l'inversion
+!--------------------------------------------------
+         if (iflag_thermals_ed.lt.8) then
+          ztv1=(ztv(ig,lt-1)-ztv(ig,lt-2))*zlev(ig,lt)/(zlev(ig,lt-1)-zlev(ig,lt-2)) &
+    &          +(ztv(ig,lt-2)*zlev(ig,lt-1)-ztv(ig,lt-1)*zlev(ig,lt-2)) &
+    &          /(zlev(ig,lt-1)-zlev(ig,lt-2))
+          ztv2=(ztv(ig,lt+2)-ztv(ig,lt+1))*zlev(ig,lt)/(zlev(ig,lt+2)-zlev(ig,lt+1)) &
+    &          +(ztv(ig,lt+1)*zlev(ig,lt+2)-ztv(ig,lt+2)*zlev(ig,lt+1)) &
+    &          /(zlev(ig,lt+2)-zlev(ig,lt+1))
+          if (ztv(ig,lt).gt.ztv1.and.ztv(ig,lt).lt.ztv2) then
+          factinv=(ztv2-ztv(ig,lt))/(ztv2-ztv1)
+          zinv=zlev(ig,lt-1)+factinv*(zlev(ig,lt)-zlev(ig,lt-1))
+          if (zlmel+0.5*zdz.ge.zinv) then
+           if (zlmel-0.5*zdz.ge.zinv) then
+          ztv_est(ig,l)=(ztv(ig,lt+2)-ztv(ig,lt+1))*(zlmel-0.*zdz)/(zlev(ig,lt+2)-zlev(ig,lt+1)) &
+    &          +(ztv(ig,lt+1)*zlev(ig,lt+2)-ztv(ig,lt+2)*zlev(ig,lt+1)) &
+    &          /(zlev(ig,lt+2)-zlev(ig,lt+1))
+          zbuoyjam(ig,l)=fact_shell*RG*(ztva_est(ig,l)-ztv_est(ig,l))/ztv_est(ig,l)+(1.-fact_shell)*zbuoy(ig,l)
+          else
+          ztv_est1=(ztv(ig,lt+2)-ztv(ig,lt+1))*0.5*(zlmel+zinv+0.5*zdz)/(zlev(ig,lt+2)-zlev(ig,lt+1)) &
+    &          +(ztv(ig,lt+1)*zlev(ig,lt+2)-ztv(ig,lt+2)*zlev(ig,lt+1)) &
+    &          /(zlev(ig,lt+2)-zlev(ig,lt+1))
+          ztv_est2=(ztv(ig,lt-1)-ztv(ig,lt-2))*0.5*(zinv+zlmel-0.5*zdz)/(zlev(ig,lt-1)-zlev(ig,lt-2)) &
+    &          +(ztv(ig,lt-2)*zlev(ig,lt-1)-ztv(ig,lt-1)*zlev(ig,lt-2)) &
+    &          /(zlev(ig,lt-1)-zlev(ig,lt-2))
+          zbuoyjam(ig,l)=fact_shell*RG*(((zlmel+0.5*zdz-zinv)/zdz)*(ztva_est(ig,l)- &
+    &          ztv_est1)/ztv_est1+((zinv-zlmel+0.5*zdz)/zdz)*(ztva_est(ig,l)- &
+    &          ztv_est2)/ztv_est2)+(1.-fact_shell)*zbuoy(ig,l)
+           endif
+          else
+          ztv_est(ig,l)=(ztv(ig,lt-1)-ztv(ig,lt-2))*(zlmel-0.*zdz)/(zlev(ig,lt-1)-zlev(ig,lt-2)) &
+    &          +(ztv(ig,lt-2)*zlev(ig,lt-1)-ztv(ig,lt-1)*zlev(ig,lt-2)) &
+    &          /(zlev(ig,lt-1)-zlev(ig,lt-2))
+          zbuoyjam(ig,l)=fact_shell*RG*(ztva_est(ig,l)-ztv_est(ig,l))/ztv_est(ig,l)+(1.-fact_shell)*zbuoy(ig,l)
+!         ztv_est1=(ztv(ig,lt+2)-ztv(ig,lt+1))*0.5*(zlmel+zinv+0.5*zdz)/(zlev(ig,lt+2)-zlev(ig,lt+1)) &
+!    &          +(ztv(ig,lt+1)*zlev(ig,lt+2)-ztv(ig,lt+2)*zlev(ig,lt+1)) &
+!    &          /(zlev(ig,lt+2)-zlev(ig,lt+1))
+!          ztv_est2=(ztv(ig,lt-1)-ztv(ig,lt-2))*0.5*(zinv+zlmel-0.5*zdz)/(zlev(ig,lt-1)-zlev(ig,lt-2)) &
+!    &          +(ztv(ig,lt-2)*zlev(ig,lt-1)-ztv(ig,lt-1)*zlev(ig,lt-2)) &
+!    &          /(zlev(ig,lt-1)-zlev(ig,lt-2))
+!          zbuoyjam(ig,l)=fact_shell*RG*(((zlmel+0.5*zdz-zinv)/zdz)*(ztva_est(ig,l)- &
+!    &          ztv_est1)/ztv_est1+((zinv-zlmel+0.5*zdz)/zdz)*(ztva_est(ig,l)- &
+!    &          ztv_est2)/ztv_est2)+(1.-fact_shell)*zbuoy(ig,l)
+!          print*,'on est pass? par l?',l,lt,zbuoyjam(ig,l),zbuoy(ig,l)
+          endif
+          else
 !          ztv_est(ig,l)=(lmel/zdz2)*(ztv(ig,lt)-ztv(ig,l))+ztv(ig,l)
 !          zbuoyjam(ig,l)=RG*(ztva_est(ig,l)-ztv_est(ig,l))/ztv_est(ig,l)
+         zbuoyjam(ig,l)=fact_shell*RG*(((lmel+zdz3-zdz2)/zdz3)*(ztva_est(ig,l)- &
+    &          ztv(ig,lt))/ztv(ig,lt)+((zdz2-lmel)/zdz3)*(ztva_est(ig,l)- &
+    &          ztv(ig,lt-1))/ztv(ig,lt-1))+(1.-fact_shell)*zbuoy(ig,l)
+!         zdqt(ig,l)=Max(0.,((lmel+zdz3-zdz2)/zdz3)*(zqta(ig,l-1)- &
+!    &          po(ig,lt))/po(ig,lt)+((zdz2-lmel)/zdz3)*(zqta(ig,l-1)- &
+!     &          po(ig,lt-1))/po(ig,lt-1))
+          endif
+          else
          zbuoyjam(ig,l)=1.*RG*(((lmel+zdz3-zdz2)/zdz3)*(ztva_est(ig,l)- &
 …
     &          ztv(ig,lt-1))/ztv(ig,lt-1))+0.*zbuoy(ig,l)
+!         zdqt(ig,l)=Max(0.,((lmel+zdz3-zdz2)/zdz3)*(zqta(ig,l-1)- &
+!    &          po(ig,lt))/po(ig,lt)+((zdz2-lmel)/zdz3)*(zqta(ig,l-1)- &
+!    &          po(ig,lt-1))/po(ig,lt-1))
+          endif
-          else
-          lt=lt+1
-          endif
-          enddo
 !          zbuoyjam(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+!          entr_star(ig,l)=f_star(ig,l)*zdz*zbetalpha*MAX(0.,  &
+!    &     afact*zbuoyjam(ig,l)/zw2m - fact_epsilon )
+!          entrbis=entr_star(ig,l)
+          if (iflag_thermals_ed.lt.6) then
+          fact_epsilon=0.0002/(zalpha+0.1)
+          endif
+          detr_star(ig,l)=f_star(ig,l)*zdz             &
+    &     *MAX(1.e-4, -afact*zbetalpha*zbuoyjam(ig,l)/zw2m          &
+    &     + 0.012*(zdqt(ig,l)/zw2m)**0.5)
+          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
           entr_star(ig,l)=f_star(ig,l)*zdz*zbetalpha*MAX(0.,  &
+    &     afact*zbuoyjam(ig,l)/zw2m - fact_epsilon )
+          entrbis=entr_star(ig,l)
+          detr_star(ig,l)=f_star(ig,l)*zdz                        &
+    &     *MAX(1.e-4, -afact*zbetalpha*zbuoyjam(ig,l)/zw2m          &
+    &     + 0.012*(zdqt(ig,l)/zw2m)**0.5 )
+!           zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+!
+!           entr_star(ig,l)=Max(0.,f_star(ig,l)*zdz*zbetalpha*  &
+!     &     afact*zbuoy(ig,l)/zw2m &
+!     &     - 1.*fact_epsilon)
+    &     afact*zbuoy(ig,l)/zw2m - fact_epsilon)
+!          entr_star(ig,l)=Max(0.,f_star(ig,l)*zdz*zbetalpha*  &
+!    &     afact*zbuoy(ig,l)/zw2m &
+!    &     - 1.*fact_epsilon)
 …
 !        endif
 !print*,'alim0',l,lalim(ig),alim_star(ig,l),entrbis,f_star(ig,l)
+!       print*,'alim0',zlev(ig,l),entr_star(ig,l),detr_star(ig,l),zw2m,zbuoy(ig,l),f_star(ig,l)
 ! Calcul du flux montant normalise
       f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
 …
            zdzbis=zlev(ig,l+1)-zlev(ig,l-1)
            zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
+           fact_epsilon=0.002
             zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
             zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
 …
     &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
     &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
+           if (iflag_thermals_ed.lt.6) then
+           zalpha=f0(ig)*f_star(ig,l)/sqrt(zw2(ig,l+1))/rhobarz(ig,l)
+!           fact_epsilon=0.0005/(zalpha+0.025)**0.5
+!           fact_epsilon=Min(0.003,0.0004/(zalpha)**0.5)
+           fact_epsilon=0.0002/(zalpha+0.1)**1
+            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+            zw2factbis=fact_epsilon*2.*zdzbis/(1.+betalpha)
+            zdw2= afact*zbuoy(ig,l)/(fact_epsilon)
+            zdw2bis= afact*zbuoy(ig,l-1)/(fact_epsilon)
+            zw2(ig,l+1)=Max(0.0001,(zdz/zdzbis)*(exp(-zw2fact)* &
+    &                     (zw2(ig,l)-zdw2)+zdw2)+(zdzbis-zdz)/zdzbis* &
+    &                     (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2))
+           endif
       endif
    enddo
 …
      &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
            zw2(ig,l+1)=0.
+!+CR:04/05/12:correction calcul linter pour calcul de zmax continu
+        elseif (f_star(ig,l+1).lt.0.) then
+           linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
+     &               -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
+           zw2(ig,l+1)=0.
+!fin CR:04/05/12
         endif
 …
         if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
+#undef wrgrads_thermcell
+#ifdef wrgrads_thermcell
+         call wrgradsfi(1,klev,entr_star(igout,1:klev),'esta      ','esta      ')
+         call wrgradsfi(1,klev,detr_star(igout,1:klev),'dsta      ','dsta      ')
+         call wrgradsfi(1,klev,zbuoy(igout,1:klev),'buoy      ','buoy      ')
+         call wrgradsfi(1,klev,zdqt(igout,1:klev),'dqt      ','dqt      ')
+         call wrgradsfi(1,klev,w_est(igout,1:klev),'w_est     ','w_est     ')
+         call wrgradsfi(1,klev,w_est(igout,2:klev+1),'w_es2     ','w_es2     ')
+         call wrgradsfi(1,klev,zw2(igout,1:klev),'zw2A      ','zw2A      ')
+#endif
      return
      end
 …
       REAL zqsatth(ngrid,klev)
       REAL zta_est(ngrid,klev)
+      REAL zbuoyjam(ngrid,klev)
       REAL ztemp(ngrid),zqsat(ngrid)
       REAL zdw2
 …
 ! Initialisations des variables reeles
 if (1==0) then
+if (1==1) then
       ztva(:,:)=ztv(:,:)
       ztva_est(:,:)=ztva(:,:)
 …
       zw2(:,:)=0.
       zbuoy(:,:)=0.
+      zbuoyjam(:,:)=0.
       gamma(:,:)=0.
       zeps(:,:)=0.
 …
         if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
+#undef wrgrads_thermcell
+#ifdef wrgrads_thermcell
+         call wrgradsfi(1,klev,entr_star(igout,1:klev),'esta      ','esta      ')
+         call wrgradsfi(1,klev,detr_star(igout,1:klev),'dsta      ','dsta      ')
+         call wrgradsfi(1,klev,zbuoy(igout,1:klev),'buoy      ','buoy      ')
+         call wrgradsfi(1,klev,zdqt(igout,1:klev),'dqt      ','dqt      ')
+         call wrgradsfi(1,klev,w_est(igout,1:klev),'w_est     ','w_est     ')
+         call wrgradsfi(1,klev,w_est(igout,2:klev+1),'w_es2     ','w_es2     ')
+         call wrgradsfi(1,klev,zw2(igout,1:klev),'zw2A      ','zw2A      ')
+#endif
      return
      end

LMDZ5/branches/testing/makegcm

-                      r1999
+                      r2056
 # options par defaut pour la commande make
 ########################################################################
+echo ' '
+echo 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
+echo 'Attention makegcm n est plus supporte par l equipe de developpement'
+echo 'Il faut maintenant utiliser ./makelmdz ou ./makelmdz_fcm              '
+echo 'Si vous tenez absolument a utiliser makegcm, editez le script et'
+echo 'retirer ces lignes (a vos risques et perils)'
+echo 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
+echo ' '
+exit
 set dim="96x71x19"
 set physique=lmd
 …
 set FC_LINUX=gfortran
 if ( $FC_LINUX == g95 ) then
   set OPT_LINUX="-i4 -O3 -r8 -DNC_DOUBLE"
+if ( $FC_LINUX == gfortran ) then
+  set OPT_LINUX="-O3 -fdefault-real-8 -DNC_DOUBLE"
 else if ( $FC_LINUX == gfortran ) then
   set OPT_LINUX="-O3 -fdefault-real-8 -DNC_DOUBLE"
 else
 # pgf90 options
   set OPT_LINUX="-O3 -i4 -r8 -DNC_DOUBLE"
+  set OPT_LINUX="-O3 -fdefault-real-8 -DNC_DOUBLE"
 endif
 …
 setenv IOIPSLDIR /tmpdir/fairhead/Aqua/LMDZ20120327.trunk/modipsl/lib
 setenv MODIPSLDIR /tmpdir/fairhead/Aqua/LMDZ20120327.trunk/modipsl/lib
 setenv NCDFINC /d1/mpllmd/LMDZtesting/netcdf-4.0.1/include
 setenv NCDFLIB /d1/mpllmd/LMDZtesting/netcdf-4.0.1/lib
+setenv NCDFINC /tmpdir/fairhead/Test_install/LMDZtrunk/netcdf-4.0.1/include
+setenv NCDFLIB /tmpdir/fairhead/Test_install/LMDZtrunk/netcdf-4.0.1/lib
 …
   if ( ! $?NCDFLIB ) then
     echo You must initialize the variable NCDFLIB in your environnement
     echo for instance: "setenv NCDFLIB /d1/mpllmd/LMDZtesting/netcdf-4.0.1/lib
+    echo for instance: "setenv NCDFLIB /tmpdir/fairhead/Test_install/LMDZtrunk/netcdf-4.0.1/lib
     exit
   endif
   if ( ! $?NCDFINC ) then
     echo You must initialize the variable NCDFINC in your environnement
     echo for instance: "setenv NCDFINC /d1/mpllmd/LMDZtesting/netcdf-4.0.1/include
+    echo for instance: "setenv NCDFINC /tmpdir/fairhead/Test_install/LMDZtrunk/netcdf-4.0.1/include
     exit
   endif
 …
 else if $LINUX then
 #################
    if ( $FC_LINUX == pgf90 || $FC_LINUX == g95 || $FC_LINUX == gfortran ) then
+   if ( $FC_LINUX == pgf90 || $FC_LINUX == gfortran || $FC_LINUX == gfortran ) then
      set optim=" $OPT_LINUX "
      set optim90=" $OPT_LINUX "
 …
              set optim90="$optim90"" -g -ffpe-trap=invalid,zero,overflow -fbounds-check -Wall "
              set optimtru90="$optimtru90"" -ffpe-trap=invalid,zero,overflow -g -fbounds-check -Wall "
            else if ( $FC_LINUX == 'g95' ) then
+           else if ( $FC_LINUX == 'gfortran' ) then
              set optim="$optim"" -g -fbounds-check -freal=nan -ftrace=full -Wall "
              set optim90="$optim90"" -g -fbounds-check -freal=nan -ftrace=full -Wall "
 …
    set cppflags="$cppflags -DCPP_VEGET"
 #   set link_veget=" -lsechiba -lparameters -lstomate  "
    set link_veget=" -lsechiba -lparameters -lstomate -lparallel -lorglob -lorchidee"
+   set link_veget=" -lsechiba -lparameters -lstomate   -lorchidee"
    if ( $XNEC || $X8BRODIE || $X6NEC) then
 #      set link_veget=" -lsxsechiba -lsxparameters -lsxstomate -lsxorglob -lsxparallel"
 …
        set opt_link="$opt_link  -L$MODIPSLDIR $link_veget -L$NCDFLIB -lnetcdf "
      endif
    else if ($FC_LINUX == 'g95' || $FC_LINUX == 'gfortran' ) then
+   else if ($FC_LINUX == 'gfortran' || $FC_LINUX == 'gfortran' ) then
      if ( $io == "ioipsl" ) then
        set opt_link="$opt_link -L$MODIPSLDIR $link_veget -lioipsl -L$NCDFLIB  -lnetcdf -lioipsl  -lnetcdf "
 …
    set optimtru90=" $optimtru90 -module $libo "
    set optim90=" $optim90 -module $libo "
 else if ( $FC_LINUX == 'g95' ) then
    set optimtru90=" $optimtru90 -fmod=$libo  "
    set optim90=" $optim90 -fmod=$libo  "
+else if ( $FC_LINUX == 'gfortran' ) then
+   set optimtru90=" $optimtru90 -I$libo  "
+   set optim90=" $optim90 -I$libo  "
 else if ( $FC_LINUX == 'gfortran' ) then
    set optimtru90=" $optimtru90 -M $libo  "

LMDZ5/branches/testing/makelmdz

-                      r1999
+                      r2056
 ## try to recognise machine and infer arch from it
 machine=`hostname`
-if [[ "$machine" == "brodie" ]]
-then
-  arch="SX8_BRODIE"
-fi
 if [[ "${machine:0:3}" == "ada" ]]
 then
   arch="X64_ADA"
-fi
-if [[ "${machine:0:6}" == "ciclad" ]]
-then
-  arch="AMD64_CICLAD"
 fi
 if [[ "${machine:0:7}" == "platine" ]]
 …
 CPP_KEY=""
 INCLUDE='-I$(LIBF)/grid -I$(LIBF)/bibio -I$(LIBF)/dyn3d_common -I$(LIBF)/filtrez -I. '
+INCLUDE='-I$(LIBF)/grid -I$(LIBF)/bibio -I$(LIBF)/filtrez -I. '
 LIB=""
 adjnt=""
 …
           CPP_KEY="$CPP_KEY $2" ; shift ; shift ;;
-      "-adjnt")
-          echo "not operational ... work to be done here ";exit
-          opt_dep="$opt_dep adjnt" ; adjnt="-ladjnt -ldyn3d "
-          optim="$optim -Dadj" ; shift ;;
       "-cosp")
           cosp="$2" ; shift ; shift ;;
 …
    cp -p fxy_${grille}.h fxyprim.h
    filtre="FILTRE=$filtre"
    INCLUDE="$INCLUDE "'-I$(LIBF)/dyn3d${FLAG_PARA} '
+   INCLUDE="$INCLUDE "'-I$(LIBF)/dyn3d${FLAG_PARA} -I$(LIBF)/dyn3d_common '
 elif (( $dimc == 2 )) ; then
    filtre="FILTRE= L_FILTRE= "
    INCLUDE="$INCLUDE "'-I$(LIBF)/dyn2d'
 elif (( $dimc == 1 )) ; then
+   CPP_KEY="$CPP_KEY CPP_1D"
    filtre="L_DYN= DYN= FILTRE= L_FILTRE= DIRMAIN=phy$physique "
    INCLUDE="$INCLUDE "'-I$(LIBF)/dyn3d' # Pas tres propre
+   INCLUDE="$INCLUDE "'-I$(LIBF)/dyn3d -I$(LIBF)/dyn3d_common ' # Pas tres propre
 else
    echo Dimension dimc=$dimc pas prevu ; exit
 fi
-######################################################################
-# Creation du suffixe de la configuration
-######################################################################
-SUFF_NAME=_${dim_full}
-SUFF_NAME=${SUFF_NAME}_phy${physique}
-if [[ "$parallel" != "none" ]]
-then
-  SUFF_NAME=${SUFF_NAME}_para
-  DYN=dyn${dimc}d${paramem}
-  if [[ "$paramem" == "mem" ]]
-  then
-   SUFF_NAME=${SUFF_NAME}_${paramem}
-  fi
-else
-  SUFF_NAME=${SUFF_NAME}_seq
-  DYN=dyn${dimc}d
-fi
-if [[ $veget != "false" ]]
-then
-  SUFF_NAME=${SUFF_NAME}_orch
-fi
-if [[ $couple != "false" ]]
-then
-  SUFF_NAME=${SUFF_NAME}_couple
-fi
-if [[ $chimie == "INCA" ]]
-then
-  SUFF_NAME=${SUFF_NAME}_inca
-fi
 cd $LMDGCM
 …
 if [[ -r $LMDGCM/libf/dyn${dimc}d${FLAG_PARA}/${code}.F90 ]]
 then
+  source_code=${code}.F90
+elif [[ -r $LMDGCM/libf/phy$physique/${code}.F90 ]] ; then
   source_code=${code}.F90
 fi

Context Navigation

Legend: