Ignore:
Timestamp:
Apr 15, 2025, 11:56:45 AM (2 months ago)
Author:
aborella
Message:

Merge with trunk testing r5597. We have convergence in prod and debug in NPv7.0.1c

Location:
LMDZ6/branches/contrails
Files:
6 deleted
92 edited
10 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/contrails

  • TabularUnified LMDZ6/branches/contrails/libf/dyn3d/replay3d.f90

    r5536 r5618  
    1818        grossismx, grossismy, dzoomx, dzoomy,taux,tauy
    1919  USE mod_const_mpi, ONLY: comm_lmdz
     20  USE ioipsl, only: getin
     21
    2022!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2123  ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
    … …  
    2628  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
    2729  USE paramet_mod_h
     30
    2831  IMPLICIT NONE
    2932
    … …  
    7174
    7275  integer :: ntime=10000,it,klon,klev
     76
     77  character*20 :: lmax_replay
    7378
    7479
    … …  
    162167
    163168
    164      CALL iophys_ini(900.)
    165169print*,'Rlatu=',rlatu
    166170klon=2+iim*(jjm-1)
     171
     172print*,'AVANT getin'
    167173klev=llm
     174CALL getin('lmax_replay',lmax_replay)
     175print*,'APRES getin',lmax_replay
     176CALL getin(lmax_replay,klev)
     177print*,'replay3d lmax_replay klev',lmax_replay,klev
     178
     179     CALL iophys_ini(900.,klev)
    168180
    169181!---------------------------------------------------------------------

  • TabularUnified LMDZ6/branches/contrails/libf/dyn3d_common/infotrac.f90

    r5609 r5618  
    33MODULE infotrac
    44
    5    USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
    6    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
    7         delPhase, niso, getKey, isot_type, processIsotopes,  isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
    8         addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,  iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    9    USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3
     5   USE       strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx
     6   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers,  addPhase,  addKey, iH2O, &
     7       isoSelect,  indexUpdate, isot_type, testTracersFiles, isotope,  delPhase,  getKey, tran0, &
     8       isoKeys, isoName, isoZone, isoPhas, processIsotopes,  isoCheck, itZonIso,  nbIso,         &
     9          niso,   ntiso,   nzone,   nphas,   maxTableWidth,  iqIsoPha, iqWIsoPha, ixIso, new2oldH2O, newHNO3, oldHNO3
    1010   IMPLICIT NONE
    1111
    … …  
    3030   PUBLIC :: isoKeys, isoName, isoZone, isoPhas            !--- Isotopes keys & names, tagging zones names, phases
    3131   PUBLIC ::    niso,   ntiso,   nzone,   nphas            !--- Number of   "   "
    32    PUBLIC :: itZonIso                                      !--- index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx)
    33    PUBLIC :: iqIsoPha                                      !--- index "iq" in "qx"              = f(isotope idx,   phase idx)
     32   PUBLIC :: itZonIso                                      !--- Index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx)
     33   PUBLIC :: iqIsoPha                                      !--- Index "iq" in "qx"              = f(isotope idx,   phase idx)
    3434   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
    3535   !=== FOR BOTH TRACERS AND ISOTOPES
    … …  
    7878!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
    7979!  | iadv        | Advection scheme number                              | iadv        | 1,2,10-20(exc.15,19),30|
    80 !  | isAdvected  | Advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
    81 !  | isInPhysics | Tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
    8280!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
    8381!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    … …  
    103101
    104102   !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
    105    INTEGER,               SAVE :: nqtot,   &                    !--- Tracers nb in dynamics (incl. higher moments + H2O)
    106                                   nbtr,    &                    !--- Tracers nb in physics  (excl. higher moments + H2O)
    107                                   nqo,     &                    !--- Number of water phases
    108                                   nqtottr, &                    !--- Number of tracers passed to phytrac (TO BE DELETED ?)
    109                                   nqCO2                         !--- Number of tracers of CO2  (ThL)
     103   INTEGER, SAVE :: nqtot                                       !--- Tracers nb in dynamics (incl. higher moments + H2O)
     104   INTEGER, SAVE :: nbtr                                        !--- Tracers nb in physics  (excl. higher moments + H2O)
     105   INTEGER, SAVE :: nqo                                         !--- Number of water phases
     106   INTEGER, SAVE :: nqtottr                                     !--- Number of tracers passed to phytrac (TO BE DELETED ?)
     107   INTEGER, SAVE :: nqCO2                                       !--- Number of tracers of CO2  (ThL)
    110108   CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type(s)
    111109
    112110   !=== VARIABLES FOR INCA
    113    INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: &
    114                     conv_flg, pbl_flg                           !--- Convection / boundary layer activation (nbtr)
     111   INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:)        !--- Convection / boundary layer activation (nbtr)
    115112
    116113CONTAINS
    … …  
    147144! Local variables
    148145   INTEGER, ALLOCATABLE :: hadv(:), vadv(:)                          !--- Horizontal/vertical transport scheme number
    149    INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
    150                            vad (:), vadv_inca(:),  pbl_flg_inca(:)
    151    CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:)                   !--- Tracers names for INCA
    152146   INTEGER :: nqINCA
    153147   CHARACTER(LEN=2)      ::   suff(9)                                !--- Suffixes for schemes of order 3 or 4 (Prather)
    154148   CHARACTER(LEN=3)      :: descrq(30)                               !--- Advection scheme description tags
    155    CHARACTER(LEN=maxlen) :: msg1, texp, ttp                          !--- Strings for messages and expanded tracers type
     149   CHARACTER(LEN=maxlen) :: msg1, texp, ttp, nam, val                !--- Strings for messages and expanded tracers type
    156150   INTEGER :: fType                                                  !--- Tracers description file type ; 0: none
    157151                                                                     !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
    158152   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    159153   INTEGER :: iad                                                    !--- Advection scheme number
    160    INTEGER :: iq, jq, nt, im, nm                                     !--- Indexes and temporary variables
    161    LOGICAL :: lerr, ll
     154   INTEGER :: iq, jq, nt, im, nm, ig                                 !--- Indexes and temporary variables
     155   LOGICAL :: lerr
    162156   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    163157   TYPE(trac_type), POINTER             :: t1, t(:)
    … …  
    173167   descrq(30)    =  'PRA'
    174168
    175    lerr=strParse(type_trac, '|', types_trac, n=nt)
    176    IF (nt .GT. 1) THEN
    177       IF (nt .GT. 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
    178       IF (nt .EQ. 2) type_trac=types_trac(2)
    179    ENDIF
    180 
    181169   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
    182 
    183    
     170   IF(strCount(type_trac, '|', nt)) CALL abort_gcm(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1)
     171   IF(nt >= 3) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
     172   IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_gcm(modname, "couldn't parse "//'"type_trac"', 1)
     173   IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON
     174
     175   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
     176
     177!##############################################################################################################################
     178   IF(.TRUE.) THEN                                                   !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
     179!##############################################################################################################################
    184180   !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
    185181   msg1 = 'For type_trac = "'//TRIM(type_trac)//'":'
    … …  
    197193   SELECT CASE(type_trac)
    198194      CASE('inca', 'inco')
    199 IF (.NOT. CPPKEY_INCA) THEN
    200          CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
    201 END IF
     195         IF(.NOT.CPPKEY_INCA)     CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
    202196      CASE('repr')
    203 IF (.NOT. CPPKEY_REPROBUS) THEN
    204          CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
    205 END IF
     197         IF(.NOT.CPPKEY_REPROBUS) CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
    206198      CASE('coag')
    207 IF (.NOT. CPPKEY_STRATAER) THEN
    208          CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
    209 END IF
     199         IF(.NOT.CPPKEY_STRATAER) CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
    210200   END SELECT
    211 
    212    nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
     201!##############################################################################################################################
     202   END IF
     203!##############################################################################################################################
    213204
    214205!==============================================================================================================================
    215206! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT
    216207!==============================================================================================================================
    217    texp = type_trac                                                            !=== EXPANDED (WITH "|" SEPARATOR) "type_trac"
     208   texp = type_trac                                                  !=== EXPANDED (WITH "|" SEPARATOR) "type_trac"
    218209   IF(texp == 'inco') texp = 'co2i|inca'
    219210   IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp)
    220211   IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    221212   ttp = type_trac; IF(fType /= 1) ttp = texp
    222    IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    223 
    224 !==============================================================================================================================
    225 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.
    226 !==============================================================================================================================
    227213   !---------------------------------------------------------------------------------------------------------------------------
    228214   IF(fType == 0) CALL abort_gcm(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1)
    229215   !---------------------------------------------------------------------------------------------------------------------------
    230    IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) THEN      !=== FOUND OLD STYLE INCA "traceur.def"
     216   IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) &         !=== FOUND OLD STYLE INCA "traceur.def"
     217      CALL abort_gcm(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1)
    231218   !---------------------------------------------------------------------------------------------------------------------------
    232 IF (CPPKEY_INCA) THEN
    233       nqo = SIZE(tracers) - nqCO2
    234       CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA
    235       nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
    236       nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
    237       IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
    238       ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
    239       ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
    240       CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
    241       ALLOCATE(ttr(nqtrue))
    242       ttr(1:nqo+nqCO2)                  = tracers
    243       ttr(1    :      nqo   )%component = 'lmdz'
    244       ttr(1+nqo:nqCO2+nqo   )%component = 'co2i'
    245       ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
    246       ttr(1+nqo      :nqtrue)%name      = [('CO2     ', iq=1, nqCO2), solsym_inca]
    247       ttr(1+nqo+nqCO2:nqtrue)%parent    = tran0
    248       ttr(1+nqo+nqCO2:nqtrue)%phase     = 'g'
    249       lerr = getKey('hadv', had, ky=tracers(:)%keys)
    250       lerr = getKey('vadv', vad, ky=tracers(:)%keys)
    251       hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca
    252       vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca
    253       CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    254       DO iq = 1, nqtrue
    255          t1 => tracers(iq)
    256          CALL addKey('name',      t1%name,      t1%keys)
    257          CALL addKey('component', t1%component, t1%keys)
    258          CALL addKey('parent',    t1%parent,    t1%keys)
    259          CALL addKey('phase',     t1%phase,     t1%keys)
    260       END DO
    261       IF(setGeneration(tracers)) CALL abort_gcm(modname,'See above',1) !- SET FIELDS %iGeneration, %gen0Name
    262       DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
    263 END IF
    264    !---------------------------------------------------------------------------------------------------------------------------
    265    ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
    266    !---------------------------------------------------------------------------------------------------------------------------
     219
     220!##############################################################################################################################
     221   IF(readTracersFiles(ttp, lRepr=type_trac == 'repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
     222!##############################################################################################################################
     223
     224!==============================================================================================================================
     225! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.
     226!==============================================================================================================================
    267227   nqtrue = SIZE(tracers)                                                                               !--- "true" tracers
    268228!   nqo    =      COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name)     == 'H2O')     !--- Water phases
    … …  
    275235        (delPhase(tracers(:)%gen0Name)     == 'CLDFRA')))
    276236   nqCO2  =      COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
    277 IF (CPPKEY_INCA) THEN
     237   IF(CPPKEY_INCA) &
    278238   nqINCA =      COUNT(tracers(:)%component == 'inca')
    279 END IF
     239   IF(CPPKEY_REPROBUS) CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
     240
     241!==============================================================================================================================
     242! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
     243!==============================================================================================================================
    280244   IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "hadv"', 1)
    281245   IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "vadv"', 1)
    282    !---------------------------------------------------------------------------------------------------------------------------
    283    END IF
    284    !---------------------------------------------------------------------------------------------------------------------------
    285 
    286 IF (CPPKEY_REPROBUS) THEN
    287    CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
    288 END IF
    289 
    290 !==============================================================================================================================
    291 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
    292 !==============================================================================================================================
    293246   DO iq = 1, nqtrue
    294247      IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
    … …  
    308261
    309262!==============================================================================================================================
    310 ! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected.
     263! 3) Determine the advection scheme choice for water and tracers "iadv" and the field "long name".
    311264!     iadv = 1    "LMDZ-specific humidity transport" (for H2O vapour)          LMV
    312265!     iadv = 2    backward                           (for H2O liquid)          BAK
    … …  
    326279!==============================================================================================================================
    327280   ALLOCATE(ttr(nqtot))
    328    jq = nqtrue+1; tracers(:)%iadv = -1
     281   jq = nqtrue+1
    329282   DO iq = 1, nqtrue
    330283      t1 => tracers(iq)
    … …  
    337290      IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
    338291
    339       !--- SET FIELDS longName, iadv, isAdvected, isInPhysics
     292      !--- SET FIELDS longName and iadv
    340293      t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
    341294      t1%iadv       = iad
    342       t1%isAdvected = iad >= 0
    343 !      t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O
    344       t1%isInPhysics=((delPhase(t1%gen0Name) /= 'H2O') .AND. &
    345                       (delPhase(t1%gen0Name) /= 'CLDFRA')) .OR. t1%component /= 'lmdz'
    346295      ttr(iq)       = t1
    347296
    … …  
    357306      ttr(jq+1:jq+nm)%longName    = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
    358307      ttr(jq+1:jq+nm)%iadv        = [ (-iad,    im=1, nm) ]
    359       ttr(jq+1:jq+nm)%isAdvected  = [ (.FALSE., im=1, nm) ]
    360308      jq = jq + nm
    361309   END DO
    … …  
    367315
    368316   !=== TEST ADVECTION SCHEME
    369    DO iq = 1, nqtot ; t1 => tracers(iq); iad = t1%iadv
     317   DO iq = 1, nqtot ; t1 => tracers(iq)
     318      iad = t1%iadv
     319      ig  = t1%iGeneration
     320      nam = t1%name
     321      val = 'iadv='//TRIM(int2str(iad))
    370322
    371323      !--- ONLY TESTED VALUES FOR TRACERS FOR NOW:               iadv = 14, 10 (and 0 for non-transported tracers)
    372       IF(ALL([10,14,0] /= iad)) &
    373          CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1)
    374 
    375       !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1)
    376       IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) &
    377          CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1)
    378 
    379       !--- ONLY TESTED VALUES FOR CHILDS FOR NOW:                iadv = 10     (CHILDS:  TRACERS OF GENERATION GREATER THAN 1)
    380       IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',&
    381          modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10
    382 
    383       !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR:            iadv = 14
    384       ll = t1%name /= addPhase('H2O','g')
    385       IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', &
    386          modname, iad == 14 .AND. ll))                 t1%iadv = 10
     324      IF(ALL([10,14,0] /= iad)) CALL abort_gcm(modname, TRIM(val)//' has not been tested yet ; 10 or 14 only are allowed !', 1)
     325
     326      !--- ONLY TESTED VALUES SO FAR FOR PARENTS HAVING CHILDREN: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 0)
     327      IF(ALL([10,14] /= iad) .AND. ig == 0 .AND. ANY(tracers(:)%parent==nam)) &
     328         CALL abort_gcm(modname, TRIM(val)//' is not implemented for parents ; 10 or 14 only are allowed !', 1)
     329
     330      !--- ONLY TESTED VALUES SO FAR FOR DESCENDANTS (TRACERS OF GENERATION > 0): iadv = 10 ; WATER VAPOUR: iadv = 14
     331      lerr = iad /= 10 .AND. ig > 0;                     IF(lerr) tracers(iq)%iadv = 10
     332      CALL msg('WARNING! '//TRIM(val)//  ' not implemented for children. Setting iadv=10 for "'//TRIM(nam)//'"', modname, lerr)
     333      lerr = iad == 14 .AND. nam /= addPhase('H2O','g'); IF(lerr) tracers(iq)%iadv = 10
     334      CALL msg('WARNING! '//TRIM(val)//' is valid for water vapour only. Setting iadv=10 for "'//TRIM(nam)//'"', modname, lerr)
    387335   END DO
    388336
    … …  
    392340
    393341   !--- Convection / boundary layer activation for all tracers
    394    ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
    395    ALLOCATE( pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
     342   IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
     343   IF(.NOT.ALLOCATED( pbl_flg)) ALLOCATE( pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
    396344
    397345   !--- Note: nqtottr can differ from nbtr when nmom/=0
    … …  
    401349        (delPhase(tracers(:)%gen0Name)     == 'CLDFRA')))
    402350!   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
    403 !   IF(COUNT(tracers%iso_iName == 0) - COUNT(tracers(:)%component == 'lmdz' .AND. &
    404 !       ((delPhase(tracers(:)%name)     == 'H2O') .OR. &
    405 !        (delPhase(tracers(:)%name)     == 'CLDFRA') /= nqtottr) &
    406 !      CALL abort_gcm(modname, 'problem with the computation of nqtottr', 1)
     351   IF(COUNT(tracers%iso_iName == 0) - COUNT(tracers(:)%component == 'lmdz' .AND. &
     352       ((delPhase(tracers(:)%name)     == 'H2O') .OR. &
     353        (delPhase(tracers(:)%name)     == 'CLDFRA'))) /= nqtottr) &
     354      CALL abort_gcm(modname, 'problem with the computation of nqtottr', 1)
    407355
    408356   !=== DISPLAY THE RESULTS
     357   IF(.NOT..TRUE.) RETURN
    409358   CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
    410359   CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
    … …  
    413362   CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
    414363   CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
    415 IF (CPPKEY_INCA) THEN
    416    CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
    417    CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
    418 END IF
     364   CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname, CPPKEY_INCA)
     365   CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname, CPPKEY_INCA)
    419366   t => tracers
    420367   CALL msg('Information stored in '//TRIM(modname)//': ', modname)
    … …  
    425372                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
    426373      CALL abort_gcm(modname, "problem with the tracers table content", 1)
    427    IF(niso > 0) THEN
    428       CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
    429       CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
    430       CALL msg('  isoName = '//strStack(isoName),      modname)
    431       CALL msg('  isoZone = '//strStack(isoZone),      modname)
    432       CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
    433    ELSE
    434       CALL msg('No isotopes identified.', modname)
    435    END IF
    436    CALL msg('end', modname)
     374   CALL msg('No isotopes identified.', modname, nbIso == 0)
     375   IF(nbIso == 0) RETURN
     376   CALL msg('For isotopes family "H2O":', modname)
     377   CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
     378   CALL msg('  isoName = '//strStack(isoName),      modname)
     379   CALL msg('  isoZone = '//strStack(isoZone),      modname)
     380   CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
    437381
    438382END SUBROUTINE init_infotrac

  • TabularUnified LMDZ6/branches/contrails/libf/dyn3dmem/guide_loc_mod.f90

    r5285 r5618  
    15891589!=======================================================================
    15901590  SUBROUTINE guide_read(timestep)
    1591     USE netcdf, ONLY: nf90_put_var
     1591    USE netcdf, ONLY: nf90_get_var
    15921592    USE dimensions_mod, ONLY: iim, jjm, llm, ndm
    15931593USE paramet_mod_h
    … …  
    18031803         endif
    18041804! Coefs ap, bp pour calcul de la pression aux differents niveaux
     1805!function nf90_get_var(ncid, varid, values, start, count, stride, map)
     1806!  integer,                         intent( in) :: ncid, varid
     1807!  any valid type, scalar or array of any rank, &
     1808!                                   intent(out) :: values
     1809!  integer, dimension(:), optional, intent( in) :: start, count, stride, map
     1810!  integer                                      :: nf90_get_var
    18051811         IF (guide_plevs.EQ.1) THEN
    1806              status = nf90_put_var(ncidpl, varidap, apnc, [1], [nlevnc])
    1807              status = nf90_put_var(ncidpl, varidbp, bpnc, [1], [nlevnc])
     1812             status = nf90_get_var(ncidpl, varidap, apnc, [1], [nlevnc])
     1813             status = nf90_get_var(ncidpl, varidbp, bpnc, [1], [nlevnc])
    18081814         ELSEIF (guide_plevs.EQ.0) THEN
    1809              status = nf90_put_var(ncidpl, varidpl, apnc, [1], [nlevnc])
     1815             status = nf90_get_var(ncidpl, varidpl, apnc, [1], [nlevnc])
    18101816!FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
    18111817             IF(convert_Pa) apnc=apnc*100.! conversion en Pascals
    … …  
    18331839! Pression
    18341840     if (guide_plevs.EQ.2) then
    1835          status = nf90_put_var(ncidp, varidp, pnat2, start, count)
     1841         status = nf90_get_var(ncidp, varidp, pnat2, start, count)
    18361842         IF (invert_y) THEN
    18371843!           PRINT*,"Invertion impossible actuellement"
    … …  
    18431849!  Vent zonal
    18441850     if (guide_u) then
    1845          status = nf90_put_var(ncidu, varidu, unat2, start, count)
     1851         status = nf90_get_var(ncidu, varidu, unat2, start, count)
    18461852         IF (invert_y) THEN
    18471853!           PRINT*,"Invertion impossible actuellement"
    … …  
    18551861!  Temperature
    18561862     if (guide_T) then
    1857          status = nf90_put_var(ncidt, varidt, tnat2, start, count)
     1863         status = nf90_get_var(ncidt, varidt, tnat2, start, count)
    18581864         IF (invert_y) THEN
    18591865!           PRINT*,"Invertion impossible actuellement"
    … …  
    18651871!  Humidite
    18661872     if (guide_Q) then
    1867          status = nf90_put_var(ncidQ, varidQ, qnat2, start, count)
     1873         status = nf90_get_var(ncidQ, varidQ, qnat2, start, count)
    18681874         IF (invert_y) THEN
    18691875!           PRINT*,"Invertion impossible actuellement"
    … …  
    18791885         count(2)=jjnb_v
    18801886         IF (invert_y) start(2)=jjm-jje_v+1
    1881          status = nf90_put_var(ncidv, varidv, vnat2, start, count)
     1887         status = nf90_get_var(ncidv, varidv, vnat2, start, count)
    18821888         IF (invert_y) THEN
    18831889!           PRINT*,"Invertion impossible actuellement"
    … …  
    18961902         count(4)=0
    18971903         IF (invert_y) start(2)=jjp1-jje_u+1
    1898          status = nf90_put_var(ncidps, varidps, psnat2, start, count)
     1904         status = nf90_get_var(ncidps, varidps, psnat2, start, count)
    18991905         IF (invert_y) THEN
    19001906!           PRINT*,"Invertion impossible actuellement"
    … …  
    19081914!=======================================================================
    19091915  SUBROUTINE guide_read2D(timestep)
    1910     USE netcdf, ONLY: nf90_put_var
     1916    USE netcdf, ONLY: nf90_get_var
    19111917    USE dimensions_mod, ONLY: iim, jjm, llm, ndm
    19121918USE paramet_mod_h
    … …  
    20572063! Coefs ap, bp pour calcul de la pression aux differents niveaux
    20582064         if (guide_plevs.EQ.1) then
    2059              status = nf90_put_var(ncidpl, varidap, apnc, [1], [nlevnc])
    2060              status = nf90_put_var(ncidpl, varidbp, bpnc, [1], [nlevnc])
     2065             status = nf90_get_var(ncidpl, varidap, apnc, [1], [nlevnc])
     2066             status = nf90_get_var(ncidpl, varidbp, bpnc, [1], [nlevnc])
    20612067         elseif (guide_plevs.EQ.0) THEN
    2062              status = nf90_put_var(ncidpl, varidpl, apnc, [1], [nlevnc])
     2068             status = nf90_get_var(ncidpl, varidpl, apnc, [1], [nlevnc])
    20632069             apnc=apnc*100.! conversion en Pascals
    20642070             bpnc(:)=0.
    … …  
    20852091!  Pression
    20862092     if (guide_plevs.EQ.2) then
    2087          status = nf90_put_var(ncidp, varidp, zu, start, count)
     2093         status = nf90_get_var(ncidp, varidp, zu, start, count)
    20882094         DO i=1,iip1
    20892095             pnat2(i,:,:)=zu(:,:)
    … …  
    20982104!  Vent zonal
    20992105     if (guide_u) then
    2100          status = nf90_put_var(ncidu, varidu, zu, start, count)
     2106         status = nf90_get_var(ncidu, varidu, zu, start, count)
    21012107         DO i=1,iip1
    21022108             unat2(i,:,:)=zu(:,:)
    … …  
    21132119!  Temperature
    21142120     if (guide_T) then
    2115          status = nf90_put_var(ncidt, varidt, zu, start, count)
     2121         status = nf90_get_var(ncidt, varidt, zu, start, count)
    21162122         DO i=1,iip1
    21172123             tnat2(i,:,:)=zu(:,:)
    … …  
    21272133!  Humidite
    21282134     if (guide_Q) then
    2129          status = nf90_put_var(ncidQ, varidQ, zu, start, count)
     2135         status = nf90_get_var(ncidQ, varidQ, zu, start, count)
    21302136         DO i=1,iip1
    21312137             qnat2(i,:,:)=zu(:,:)
    … …  
    21442150         count(2)=jjnb_v
    21452151         IF (invert_y) start(2)=jjm-jje_v+1
    2146          status = nf90_put_var(ncidv, varidv, zv, start, count)
     2152         status = nf90_get_var(ncidv, varidv, zv, start, count)
    21472153         DO i=1,iip1
    21482154             vnat2(i,:,:)=zv(:,:)
    … …  
    21662172         count(4)=0
    21672173         IF (invert_y) start(2)=jjp1-jje_u+1
    2168          status = nf90_put_var(ncidps, varidps, zu(:, 1), start, count)
     2174         status = nf90_get_var(ncidps, varidps, zu(:, 1), start, count)
    21692175         DO i=1,iip1
    21702176             psnat2(i,:)=zu(:,1)

  • TabularUnified LMDZ6/branches/contrails/libf/dyn3dmem/leapfrog_loc.f90

    r5324 r5618  
    14751475     endif
    14761476
    1477 IF (CPPKEY_INCA) THEN
    1478      IF (ANY(type_trac == ['inca','inco'])) THEN
    1479         CALL finalize_inca
    1480   ! switching back to LMDZDYN context
    1481 !$OMP MASTER
    1482         IF (ok_dyn_xios) THEN
    1483            CALL xios_set_current_context(dyn3d_ctx_handle)
    1484         ENDIF
    1485 !$OMP END MASTER
    1486      ENDIF
    1487 END IF
    14881477IF (CPPKEY_REPROBUS) THEN
    14891478     if (type_trac == 'repr') CALL finalize_reprobus
    … …  
    15321521!$OMP END MASTER
    15331522
    1534 IF (CPPKEY_INCA) THEN
    1535           IF (ANY(type_trac == ['inca','inco'])) THEN
    1536              CALL finalize_inca
    1537   ! switching back to LMDZDYN context
    1538 !$OMP MASTER
    1539              IF (ok_dyn_xios) THEN
    1540                 CALL xios_set_current_context(dyn3d_ctx_handle)
    1541              ENDIF
    1542 !$OMP END MASTER
    1543           ENDIF
    1544 END IF
    15451523IF (CPPKEY_REPROBUS) THEN
    15461524          if (type_trac == 'repr') CALL finalize_reprobus
    … …  
    17031681!$OMP END MASTER
    17041682
    1705 IF (CPPKEY_INCA) THEN
    1706              IF (ANY(type_trac == ['inca','inco'])) THEN
    1707                 CALL finalize_inca
    1708   ! switching back to LMDZDYN context
    1709 !$OMP MASTER
    1710                 IF (ok_dyn_xios) THEN
    1711                    CALL xios_set_current_context(dyn3d_ctx_handle)
    1712                 ENDIF
    1713 !$OMP END MASTER
    1714              ENDIF
    1715 
    1716 END IF
    17171683IF (CPPKEY_REPROBUS) THEN
    17181684             if (type_trac == 'repr') CALL finalize_reprobus
    … …  
    18151781!$OMP END MASTER
    18161782
    1817 IF (CPPKEY_INCA) THEN
    1818   IF (ANY(type_trac == ['inca','inco'])) THEN
    1819      CALL finalize_inca
    1820   ! switching back to LMDZDYN context
    1821 !$OMP MASTER
    1822      IF (ok_dyn_xios) THEN
    1823         CALL xios_set_current_context(dyn3d_ctx_handle)
    1824      ENDIF
    1825 !$OMP END MASTER
    1826   ENDIF
    1827 
    1828 END IF
    18291783IF (CPPKEY_REPROBUS) THEN
    18301784  if (type_trac == 'repr') CALL finalize_reprobus

  • TabularUnified LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis.f90

    r5536 r5618  
    279279  itr=0
    280280  DO iq=1,nqtot
    281      IF(.NOT.tracers(iq)%isAdvected) CYCLE
     281     IF(tracers(iq)%iadv < 0) CYCLE
    282282     itr = itr + 1
    283283     DO l=1,llm
    … …  
    597597  itr = 0
    598598  DO iq=1,nqtot
    599      IF(.NOT.tracers(iq)%isAdvected) CYCLE
     599     IF(tracers(iq)%iadv < 0) CYCLE
    600600     itr = itr + 1
    601601     DO l=1,llm

  • TabularUnified LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis_loc.F90

    r5536 r5618  
    356356  itr = 0
    357357  DO iq=1,nqtot
    358      IF(.NOT.tracers(iq)%isAdvected) CYCLE
     358     IF(tracers(iq)%iadv < 0) CYCLE
    359359     itr = itr + 1
    360360!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    10591059  itr = 0
    10601060  DO iq=1,nqtot
    1061      IF(.NOT.tracers(iq)%isAdvected) CYCLE
     1061     IF(tracers(iq)%iadv < 0) CYCLE
    10621062     itr = itr + 1
    10631063!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)

  • TabularUnified LMDZ6/branches/contrails/libf/misc/lmdz_inca_wrappers.F90

    r5325 r5618  
    371371END SUBROUTINE chemmain
    372372
     373SUBROUTINE init_inca_oasis(inforecv_lmdz)
     374  INTEGER, PARAMETER    :: maxrecv = 2
     375  TYPE                  ::   FLD_CPL            ! Type for coupling field information
     376     CHARACTER(len = 8) ::   name      ! Name of the coupling field   
     377     LOGICAL            ::   action    ! To be exchanged or not
     378     INTEGER            ::   nid       ! Id of the field
     379  END TYPE FLD_CPL
     380  TYPE(FLD_CPL), DIMENSION(maxrecv), INTENT(in) :: inforecv_lmdz
     381
     382  CALL lmdz_inca_wrapper_abort
     383END SUBROUTINE init_inca_oasis
     384
    373385#endif

  • TabularUnified LMDZ6/branches/contrails/libf/misc/readTracFiles_mod.f90

    r5609 r5618  
    6161    INTEGER               :: nqChildren  = 0                    !--- Number of children  (first generation)
    6262    INTEGER               :: iadv        = 10                   !--- Advection scheme used
    63     LOGICAL               :: isAdvected  = .FALSE.              !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
    6463    LOGICAL               :: isInPhysics = .TRUE.               !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
    65     INTEGER               :: iso_iGroup  = -1                   !--- Isotopes group index in isotopes(:)
     64    INTEGER               :: iso_iGroup  = 0                    !--- Isotopes group index in isotopes(:)
    6665    INTEGER               :: iso_iName   = 0                    !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
    6766    INTEGER               :: iso_iZone   = 0                    !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
    … …  
    185184!     * The "keys" component (of type keys_type) is in principle enough to store everything we could need.
    186185!     But some variables are stored as direct-access keys to make the code more readable and because they are used often.
    187 !     * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now).
     186!     * Most of the direct-access keys are set in this module, but some are not (longName, iadv and isInPhysicsfor now).
    188187!     * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
    189188!     is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen).
    … …  
    10751074    CALL addKey('iqParent',   parent(iq), tr(iq)%keys)
    10761075    CALL addKey('iqGeneration', iGen(iq), tr(iq)%keys)
     1076    tr(iq)%iqParent = iqParent(iq)
    10771077  END DO
    10781078
    … …  
    13141314
    13151315  !=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
    1316   IF(isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso; ELSE; lerr = isoSelect(1, .TRUE.); END IF
     1316  IF(.NOT.isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso; ELSE; lerr = isoSelect(1, .TRUE.); END IF
    13171317
    13181318CONTAINS

  • TabularUnified LMDZ6/branches/contrails/libf/misc/strings_mod.f90

    r5353 r5618  
    138138END SUBROUTINE msg_m
    139139!==============================================================================================================================
    140 LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
     140 FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
    141141  IMPLICIT NONE
    142142  CHARACTER(LEN=*),           INTENT(IN) :: str
    … …  
    144144  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
    145145  INTEGER,          OPTIONAL, INTENT(IN) :: unit
     146  LOGICAL                                :: l
    146147!------------------------------------------------------------------------------------------------------------------------------
    147148  CHARACTER(LEN=maxlen) :: subn
    … …  
    153154END FUNCTION fmsg_1
    154155!==============================================================================================================================
    155 LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
     156 FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
    156157  IMPLICIT NONE
    157158  CHARACTER(LEN=*),           INTENT(IN)  :: str(:)
    … …  
    160161  INTEGER,          OPTIONAL, INTENT(IN) :: unit
    161162  INTEGER,          OPTIONAL, INTENT(IN)  :: nmax
     163  LOGICAL                                 :: l
    162164!------------------------------------------------------------------------------------------------------------------------------
    163165  CHARACTER(LEN=maxlen) :: subn
    … …  
    175177!=== Lower/upper case conversion function. ====================================================================================
    176178!==============================================================================================================================
    177 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out)
     179ELEMENTAL FUNCTION strLower(str) RESULT(out)
    178180  IMPLICIT NONE
    179181  CHARACTER(LEN=*), INTENT(IN) :: str
    180182  INTEGER :: k
     183  CHARACTER(LEN=maxlen) :: out
    181184  out = str
    182185  DO k=1,LEN_TRIM(str)
    … …  
    185188END FUNCTION strLower
    186189!==============================================================================================================================
    187 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out)
     190ELEMENTAL FUNCTION strUpper(str) RESULT(out)
    188191  IMPLICIT NONE
    189192  CHARACTER(LEN=*), INTENT(IN) :: str
    190193  INTEGER :: k
     194  CHARACTER(LEN=maxlen)  :: out
    191195  out = str
    192196  DO k=1,LEN_TRIM(str)
    … …  
    203207!===    * strHead(..,.TRUE.)  = 'a_b'         ${str%$sep*}                                                     ================
    204208!==============================================================================================================================
    205 CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
     209  FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
    206210  IMPLICIT NONE
    207211  CHARACTER(LEN=*),           INTENT(IN) :: str
    208212  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    209213  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
     214  CHARACTER(LEN=maxlen) :: out
    210215!------------------------------------------------------------------------------------------------------------------------------
    211216  IF(PRESENT(sep)) THEN
    … …  
    241246!===    * strTail(str, '_', .TRUE.)  = 'c'           ${str##*$sep}                                             ================
    242247!==============================================================================================================================
    243 CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
     248  FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
    244249  IMPLICIT NONE
    245250  CHARACTER(LEN=*),           INTENT(IN) :: str
    246251  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    247252  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
     253  CHARACTER(LEN=maxlen) :: out
    248254!------------------------------------------------------------------------------------------------------------------------------
    249255  IF(PRESENT(sep)) THEN
    … …  
    406412!=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0                       ============================
    407413!==============================================================================================================================
    408 INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
     414  FUNCTION strIdx_1(str, s) RESULT(out)
    409415  IMPLICIT NONE
    410416  CHARACTER(LEN=*), INTENT(IN) :: str(:), s
     417  INTEGER :: out
    411418  DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
    412419  IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0
    … …  
    491498!===                     * THEN TEST WHETHER THE STRING FROM START TO THE FOUND SEPARATOR IS A CORRECTLY FORMATTED NUMBER
    492499!==============================================================================================================================
    493 LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
     500 FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
    494501  IMPLICIT NONE
    495502  CHARACTER(LEN=*),  INTENT(IN)  :: rawList                          !--- String in which delimiters have to be identified
    … …  
    498505  INTEGER,           INTENT(OUT) :: idx                              !--- Index of the first identified delimiter in "rawList"
    499506  INTEGER,           INTENT(OUT) :: idel                             !--- Index of the identified delimiter (0 if idx==0)
    500   LOGICAL, OPTIONAL, INTENT(IN)  :: lSc                              !--- Care about nbs with front sign or in scient. notation
     507  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc 
     508  LOGICAL :: lerr
     509!--- Care about nbs with front sign or in scient. notation
    501510!------------------------------------------------------------------------------------------------------------------------------
    502511  INTEGER :: idx0                                                    !--- Used to display an identified non-numeric string
    … …  
    526535
    527536!------------------------------------------------------------------------------------------------------------------------------
    528 INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i)
     537 FUNCTION strIdx1(str, del, ib, id) RESULT(i)
    529538!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
    530539!--- "id" is the index in "del(:)" of the first delimiter found.
    … …  
    533542  INTEGER,           INTENT(IN)  :: ib
    534543  INTEGER,           INTENT(OUT) :: id
     544  INTEGER :: i
    535545!------------------------------------------------------------------------------------------------------------------------------
    536546  DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO
    … …  
    545555!=== Count the number of elements separated by "delimiter" in list "rawList". =================================================
    546556!==============================================================================================================================
    547 LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
     557 FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
    548558  IMPLICIT NONE
    549559  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    … …  
    551561  INTEGER,           INTENT(OUT) :: nb
    552562  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
     563  LOGICAL :: lerr
    553564!------------------------------------------------------------------------------------------------------------------------------
    554565  LOGICAL :: ll
    … …  
    557568END FUNCTION strCount_11
    558569!==============================================================================================================================
    559 LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
     570 FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
    560571  IMPLICIT NONE
    561572  CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
    … …  
    563574  INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
    564575  LOGICAL,    OPTIONAL, INTENT(IN)  :: lSc
     576  LOGICAL :: lerr
    565577!------------------------------------------------------------------------------------------------------------------------------
    566578  LOGICAL :: ll
    … …  
    574586END FUNCTION strCount_m1
    575587!==============================================================================================================================
    576 LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
     588 FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
    577589  IMPLICIT NONE
    578590  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    … …  
    584596  LOGICAL              :: ll
    585597  CHARACTER(LEN=1024)  :: r
     598  LOGICAL :: lerr
     599 
    586600  lerr = .FALSE.
    587601  ll   = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    … …  
    605619!===          Corresponding "vals" remains empty if the element does not contain "=" sign. ====================================
    606620!==============================================================================================================================
    607 LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
     621 FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
    608622  IMPLICIT NONE
    609623  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
    … …  
    611625  INTEGER,                            OPTIONAL, INTENT(OUT) :: n
    612626  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
     627  LOGICAL :: lerr
    613628!------------------------------------------------------------------------------------------------------------------------------
    614629  CHARACTER(LEN=1024) :: r
    … …  
    625640
    626641!------------------------------------------------------------------------------------------------------------------------------
    627 INTEGER FUNCTION countK() RESULT(nkeys)
     642 FUNCTION countK() RESULT(nkeys)
    628643!--- Get the number of elements after parsing.
    629644  IMPLICIT NONE
     645  INTEGER :: nkeys
    630646!------------------------------------------------------------------------------------------------------------------------------
    631647  INTEGER :: ib, ie, nl
    … …  
    680696END FUNCTION strParse
    681697!==============================================================================================================================
    682 LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
     698 FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
    683699  IMPLICIT NONE
    684700  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
    … …  
    688704  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
    689705  INTEGER,               OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:)    !--- Indexes of the separators in "delimiter(:)" vector
     706  LOGICAL :: lerr
    690707!------------------------------------------------------------------------------------------------------------------------------
    691708  CHARACTER(LEN=1024) :: r
    … …  
    10851102!===    higher, several partial tables are displayed ; the nHead (default: 1) first columns are included in each sub-table.
    10861103!==============================================================================================================================
    1087 LOGICAL FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
     1104 FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
    10881105  IMPLICIT NONE
    10891106  CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
    … …  
    10981115  INTEGER,          OPTIONAL, INTENT(IN)  :: unit          !--- Output unit (default: screen)
    10991116  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: sub           !--- Subroutine name
     1117  LOGICAL :: lerr
    11001118!------------------------------------------------------------------------------------------------------------------------------
    11011119  CHARACTER(LEN=2048) :: row
    … …  
    11941212
    11951213!==============================================================================================================================
    1196 LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
     1214  FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
    11971215  IMPLICIT NONE
    11981216  INTEGER,                    INTENT(IN)  :: unt           !--- Output unit
    … …  
    12041222  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt          !--- Format for reals
    12051223  LOGICAL,          OPTIONAL, INTENT(IN)  :: llast         !--- Last variable: no final ','
     1224  LOGICAL :: lerr
    12061225!------------------------------------------------------------------------------------------------------------------------------
    12071226  CHARACTER(LEN=maxlen)  :: rFm, el
    … …  
    12771296
    12781297!==============================================================================================================================
    1279 LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
     1298  FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
    12801299  IMPLICIT NONE
    12811300! Display outliers list in tables
    … …  
    12891308  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
    12901309  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
     1310  LOGICAL :: lerr
    12911311!------------------------------------------------------------------------------------------------------------------------------
    12921312  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:)
    … …  
    13561376END FUNCTION dispOutliers_1
    13571377!==============================================================================================================================
    1358 LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
     1378  FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
    13591379  IMPLICIT NONE
    13601380! Display outliers list in tables
    … …  
    13681388  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
    13691389  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
     1390  LOGICAL :: lerr
    13701391!------------------------------------------------------------------------------------------------------------------------------
    13711392  CHARACTER(LEN=maxlen)                   :: mes, sub, fm='(f12.9)', prf
    … …  
    14141435!=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ====================
    14151436!==============================================================================================================================
    1416 LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
     1437  FUNCTION reduceExpr_1(str, val) RESULT(lerr)
    14171438  IMPLICIT NONE
    14181439  CHARACTER(LEN=*),      INTENT(IN)  :: str
    14191440  CHARACTER(LEN=maxlen), INTENT(OUT) :: val
     1441  LOGICAL :: lerr
    14201442!------------------------------------------------------------------------------------------------------------------------------
    14211443  CHARACTER(LEN=maxlen)              :: v
    … …  
    14641486!=== Reduce a simple algebrical expression (basic operations, no parenthesis) to a single number (string format) ==============
    14651487!==============================================================================================================================
    1466 LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
     1488 FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
    14671489  IMPLICIT NONE
    14681490  CHARACTER(LEN=*),      INTENT(IN)  :: str
    … …  
    14721494  CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:)
    14731495  CHARACTER(LEN=1),      ALLOCATABLE :: op(:)
     1496  LOGICAL :: lerr
    14741497!------------------------------------------------------------------------------------------------------------------------------
    14751498  CHARACTER(LEN=1024) :: s
    … …  
    15241547!=== Check whether a string is a number or not ================================================================================
    15251548!==============================================================================================================================
    1526 ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out)
     1549ELEMENTAL FUNCTION is_numeric(str) RESULT(out)
    15271550  IMPLICIT NONE
    15281551  CHARACTER(LEN=*), INTENT(IN) :: str
    … …  
    15301553  INTEGER :: e
    15311554  CHARACTER(LEN=12) :: fmt
     1555  LOGICAL :: out
     1556 
    15321557  IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF
    15331558  WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str)
    … …  
    15411566!=== Convert a string into a logical/integer integer or an integer/real into a string =========================================
    15421567!==============================================================================================================================
    1543 ELEMENTAL INTEGER FUNCTION str2bool(str) RESULT(out)  !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean
     1568ELEMENTAL FUNCTION str2bool(str) RESULT(out)  !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean
    15441569  IMPLICIT NONE
    15451570  CHARACTER(LEN=*), INTENT(IN) :: str
    15461571  INTEGER :: ierr
    15471572  LOGICAL :: lout
     1573  INTEGER :: out
     1574
    15481575  READ(str,*,IOSTAT=ierr) lout
     1576 
    15491577  out = -HUGE(1)
    15501578  IF(ierr /= 0) THEN
    … …  
    15561584END FUNCTION str2bool
    15571585!==============================================================================================================================
    1558 ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
     1586ELEMENTAL FUNCTION str2int(str) RESULT(out)
    15591587  IMPLICIT NONE
    15601588  CHARACTER(LEN=*), INTENT(IN) :: str
    15611589  INTEGER :: ierr
     1590  INTEGER :: out
     1591 
    15621592  READ(str,*,IOSTAT=ierr) out
    15631593  IF(ierr/=0) out = -HUGE(1)
    15641594END FUNCTION str2int
    15651595!==============================================================================================================================
    1566 ELEMENTAL REAL FUNCTION str2real(str) RESULT(out)
     1596ELEMENTAL FUNCTION str2real(str) RESULT(out)
    15671597  IMPLICIT NONE
    15681598  CHARACTER(LEN=*), INTENT(IN) :: str
    15691599  INTEGER :: ierr
     1600  REAL :: out
     1601 
    15701602  READ(str,*,IOSTAT=ierr) out
    15711603  IF(ierr/=0) out = -HUGE(1.)
    15721604END FUNCTION str2real
    15731605!==============================================================================================================================
    1574 ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(out)
     1606ELEMENTAL FUNCTION str2dble(str) RESULT(out)
    15751607  IMPLICIT NONE
    15761608  CHARACTER(LEN=*), INTENT(IN) :: str
    15771609  INTEGER :: ierr
     1610  DOUBLE PRECISION :: out
     1611 
    15781612  READ(str,*,IOSTAT=ierr) out
    15791613  IF(ierr/=0) out = -HUGE(1.d0)
    15801614END FUNCTION str2dble
    15811615!==============================================================================================================================
    1582 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
     1616ELEMENTAL FUNCTION bool2str(b) RESULT(out)
    15831617  IMPLICIT NONE
    15841618  LOGICAL, INTENT(IN) :: b
     1619  CHARACTER(LEN=maxlen) :: out
    15851620  WRITE(out,*)b
    15861621  out = ADJUSTL(out)
    15871622END FUNCTION bool2str
    15881623!==============================================================================================================================
    1589 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
     1624ELEMENTAL FUNCTION int2str(i, nDigits) RESULT(out)
    15901625  IMPLICIT NONE
    15911626  INTEGER,           INTENT(IN) :: i
    15921627  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
     1628  CHARACTER(LEN=maxlen) :: out
    15931629!------------------------------------------------------------------------------------------------------------------------------
    15941630  WRITE(out,*)i
    … …  
    15981634END FUNCTION int2str
    15991635!==============================================================================================================================
    1600 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
     1636ELEMENTAL FUNCTION real2str(r,fmt) RESULT(out)
    16011637  IMPLICIT NONE
    16021638  REAL,                       INTENT(IN) :: r
    16031639  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
     1640  CHARACTER(LEN=maxlen) :: out
    16041641!------------------------------------------------------------------------------------------------------------------------------
    16051642  IF(     PRESENT(fmt)) WRITE(out,fmt)r
    … …  
    16081645END FUNCTION real2str
    16091646!==============================================================================================================================
    1610 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
     1647ELEMENTAL FUNCTION dble2str(d,fmt) RESULT(out)
    16111648  IMPLICIT NONE
    16121649  DOUBLE PRECISION,           INTENT(IN) :: d
    16131650  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
     1651  CHARACTER(LEN=maxlen) :: out
    16141652!------------------------------------------------------------------------------------------------------------------------------
    16151653  IF(     PRESENT(fmt)) WRITE(out,fmt)d
    … …  
    16561694END FUNCTION addQuotes_m
    16571695!==============================================================================================================================
    1658 ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out)
     1696ELEMENTAL FUNCTION needQuotes(s) RESULT(out)
    16591697  IMPLICIT NONE
    16601698  CHARACTER(LEN=*), INTENT(IN) :: s
    16611699  CHARACTER(LEN=1) :: b, e
     1700  LOGICAL :: out
    16621701!------------------------------------------------------------------------------------------------------------------------------
    16631702  out = .TRUE.; IF(TRIM(s) == '') RETURN
    … …  
    16711710!=== DISPLAY "<message>: the following <items> are <reason>" FOLLOWED BY THE LIST OF <str> FOR WHICH <lerr>==T. ===============
    16721711!==============================================================================================================================
    1673 LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
     1712 FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
    16741713  IMPLICIT NONE
    16751714! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
    … …  
    16791718  CHARACTER(LEN=*),   INTENT(IN)  :: message, items, reason
    16801719  INTEGER,  OPTIONAL, INTENT(IN)  :: nmax
     1720  LOGICAL :: out
    16811721!------------------------------------------------------------------------------------------------------------------------------
    16821722  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)

  • TabularUnified LMDZ6/branches/contrails/libf/misc/wxios_mod.F90

    r5536 r5618  
    188188      ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
    189189      DO iq = 1, nqtot
    190          IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     190         IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    191191         dn = 'd'//TRIM(tracers(iq)%name)//'_'
    192192
    … …  
    241241      ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
    242242      DO iq = 1, nqtot
    243          IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     243         IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    244244         
    245245         unt = "kg m-2"

  • TabularUnified LMDZ6/branches/contrails/libf/phy_common/abort_physic.f90

    r5536 r5618  
    4949        endif         
    5050      endif
    51       END
     51      END SUBROUTINE abort_physic

  • TabularUnified LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_mpi_transfert.f90

    r5536 r5618  
    6565!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    6666
    67 !! -- Les chaine de charactère -- !!
     67!! -- Les chaine de charactere -- !!
    6868
    6969  SUBROUTINE bcast_mpi_c(var1)

  • TabularUnified LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_omp_transfert.f90

    r5536 r5618  
    116116!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    117117
    118 !! -- Les chaine de charactère -- !!
     118!! -- Les chaine de charactere -- !!
    119119
    120120  SUBROUTINE bcast_omp_c(var)

  • TabularUnified LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_transfert_para.f90

    r5536 r5618  
    5757!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    5858
    59 !! -- Les chaine de charactère -- !!
     59!! -- Les chaine de charactere -- !!
    6060
    6161  SUBROUTINE bcast_c(var)

  • TabularUnified LMDZ6/branches/contrails/libf/phydev/infotrac_phy.f90

    r5536 r5618  
    3232    TYPE(keys_type)       :: keys                          !--- <key>=<val> pairs vector
    3333    INTEGER               :: iadv        = 10              !--- Advection scheme used
    34     LOGICAL               :: isAdvected  = .FALSE.         !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
    3534    LOGICAL               :: isInPhysics = .TRUE.          !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
    3635    INTEGER               :: iso_iGroup  = 0               !--- Isotopes group index in isotopes(:)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/Dust/checknanqfi.f90

    r5354 r5618  
    11SUBROUTINE checknanqfi(zq,qmin,qmax,comment)
    22  USE dimphy
    3   USE, intrinsic :: ieee_arithmetic
    43  IMPLICIT NONE
    54
    … …  
    1716     DO i = 1, klon
    1817!        IF (zq(i,k).GT.qmax .OR. zq(i,k).LT.qmin) THEN
    19         IF (ieee_is_nan(zq(i,k))) THEN
     18        IF (isnan(zq(i,k))) THEN
    2019           jbad = jbad + 1
    2120           jadrs(jbad) = i

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/Dust/chem_spla_mod_h.f90

    r5292 r5618  
    11MODULE chem_spla_mod_h
    22  IMPLICIT NONE; PRIVATE
    3   PUBLIC ss_bins, masse_ammsulfate
     3  PUBLIC ss_bins 
    44
    55  INTEGER, PARAMETER :: ss_bins = 2
    6   REAL, PARAMETER :: masse_ammsulfate = 132.0  !--g mol-1
    76END MODULE chem_spla_mod_h
    87

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/Dust/phytracr_spl_mod.F90

    r5337 r5618  
    44MODULE phytracr_spl_mod
    55
     6  USE lmdz_spla_gastoparticle, ONLY : spla_gastoparticle
     7
    68  ! Recuperation des morceaux de la physique de Jeronimo specifiques
    79  ! du modele d'aerosols d'Olivier n'co.
    8   USE chem_mod_h
     10  USE lmdz_spla_ini, ONLY: masse_s   !au lieu de USE chem_mod_h
    911  USE chem_spla_mod_h
    1012
    … …  
    27482750      ENDIF
    27492751
    2750       CALL gastoparticle(pdtphys,zdz,zrho,rlat, &
     2752      CALL spla_gastoparticle(klon,klev,nbtr,pdtphys,zdz,zrho,rlat, &
    27512753                   pplay,t_seri,id_prec,id_fine, &
    27522754                   tr_seri,his_g2pgas ,his_g2paer)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/Dust/precuremission.f90

    r5337 r5618  
    1616        source_tr,flux_tr,tr_seri)
    1717
    18 USE chem_spla_mod_h
    19   USE chem_mod_h
     18USE lmdz_spla_ini, ONLY: masse_s,masse_ammsulfate ! remplaces USE de chem_mod_h chem_spla_mod_h
     19USE lmdz_spla_nightingale, ONLY: spla_nightingale
    2020  USE dimphy
    2121  USE indice_sol_mod
    … …  
    8484  REAL :: lmt_h2sbio(klon)        ! emissions de h2s bio
    8585
    86   EXTERNAL condsurfs, liss, nightingale
     86  EXTERNAL condsurfs, liss
    8787  !=========================================================================
    8888  ! Modifications introduced by NHL
    … …  
    9696  !=========================================================================
    9797
    98      CALL nightingale(u_seri, v_seri, u10m_ec, v10m_ec, paprs, &
     98     CALL spla_nightingale(klon,klev,nbsrf,u_seri, v_seri, u10m_ec, v10m_ec, paprs, &
    9999           pplay, cdragh, cdragm, t_seri, q_seri, ftsol, &
    100100           tsol, pctsrf, lmt_dmsconc, lmt_dms)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/Dust/read_dust.f90

    r5536 r5618  
    2121  save ncid1, varid1, ncid2, varid2
    2222!$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2)
    23   integer :: start(4),count(4), status
     23  integer :: start_(4),count_(4)
    2424  integer :: i, j, ig
    2525  !
    … …  
    2828  if (debutphy) then
    2929  !
    30      ncid1=nf90_open('dust.nc',nf90_nowrite,rcode)
    31      varid1=nf90_inq_varid(ncid1,'EMISSION',rcode)
     30     rcode=nf90_open('dust.nc',nf90_nowrite,ncid1)
     31     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open dust.nc dans read_vent',1) ; endif
     32
     33     rcode=nf90_inq_varid(ncid1,'EMISSION',varid1)
     34     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','inq varid EMISSION dans read_vent',1) ; endif
    3235  !
    3336  endif
    3437  !
    35   start(1)=1
    36   start(2)=1
    37   start(4)=0
     38  start_(1)=1
     39  start_(2)=1
     40  start_(3)=step
     41  start_(4)=0
    3842
    39    ! count(1)=iip1
    40   count(1)=nbp_lon+1
    41    ! count(2)=jjp1
    42   count(2)=nbp_lat
    43   count(3)=1
    44   count(4)=0
     43   ! count_(1)=iip1
     44  count_(1)=nbp_lon+1
     45   ! count_(2)=jjp1
     46  count_(2)=nbp_lat
     47  count_(3)=1
     48  count_(4)=0
    4549  !
    46   start(3)=step
    4750  !
    48   status = nf90_get_var(ncid1, varid1, dust_nc_glo, start, count)
     51  rcode = nf90_get_var(ncid1, varid1, dust_nc_glo, start_, count_)
     52  if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get EMISSION dans read_vent',1) ; endif
    4953
    5054  !

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/Dust/read_surface.f90

    r5536 r5618  
    3131       real surfa_glo(klon_glo,5)
    3232!
    33        integer ncid, varid, rcode
    34        integer start(2),count(2),status
     33       integer ncid, varid, rcode, varlatid,tmpid
     34       integer start_(2),count_(2)
    3535       integer i,j,l,ig
    3636       character*1 str1
    … …  
    4141      real, dimension(nbp_lat) :: lats
    4242      real, dimension(nbp_lat) :: lats_glo
    43       integer, dimension(1) :: startj,endj
     43      integer, dimension(1) :: start_j,endj
    4444!JE20140526>>
    4545!$OMP MASTER
    … …  
    4747
    4848       print*,'Lecture du fichier donnees_lisa.nc'
    49        ncid=nf90_open('donnees_lisa.nc',nf90_nowrite,rcode)
     49       rcode=nf90_open('donnees_lisa.nc',nf90_nowrite,ncid)
     50       if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open donnees_lisa.nc dans read_vent',1) ; endif
     51
    5052
    5153!JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa
    … …  
    5456      isinversed=.false.
    5557      do i=1,5
    56        if (i==1) aux4s='latu'
    57        if (i==2) aux4s='LATU'
    58        if (i==3) aux4s='LatU'
    59        if (i==4) aux4s='Latu'
    60        if (i==5) aux4s='latU'
    61        status = nf90_inq_varid(ncid, aux4s, rcode)
    62 !       print *,'stat,i',status,i,outcycle,aux4s
    63 !       print *,'ifclause',status.NE. nf90_noerr ,outcycle == .false.
    64        IF ((.not.(status.NE. nf90_noerr) ).and.( .not. outcycle )) THEN
    65          outcycle=.true.
    66          latstr=aux4s
    67        ENDIF
     58          if (i==1) aux4s='latu'
     59          if (i==2) aux4s='LATU'
     60          if (i==3) aux4s='LatU'
     61          if (i==4) aux4s='Latu'
     62          if (i==5) aux4s='latU'
     63          rcode = nf90_inq_varid(ncid, aux4s, tmpid)
     64          IF ((rcode==0).and.( .not. outcycle )) THEN
     65            outcycle=.true.
     66            varlatid=tmpid
     67          ENDIF
    6868      enddo ! check if it inversed lat
    69       startj(1)=1
    70 !      endj(1)=jjp1
     69      start_j(1)=1
    7170      endj(1)=nbp_lat
    72       varid=nf90_inq_varid(ncid,latstr,rcode)
     71      rcode = nf90_get_var(ncid, varlatid, lats_glo, start_j, endj)
     72      if ( .not. outcycle ) then ; call abort_physic('LMDZ','get lat dans read_surface',1) ; endif
    7373
    74           status = nf90_get_var(ncid, varid, lats_glo, startj, endj)
    75 !      print *,latstr,varid,status,jjp1,rcode
    76 !      IF (status .NE. nf90_noerr) print*,'NOOOOOOO'
    77 !      print *,lats
    78 !stop
     74
    7975
    8076! check if netcdf is latitude inversed or not.
    … …  
    8682          write(str1,'(i1)') i
    8783          varname=trim(name)//str1
    88        print*,'lecture variable:',varname
    89           varid=nf90_inq_varid(ncid,trim(varname),rcode)
     84          rcode=nf90_inq_varid(ncid,trim(varname),varid)
     85          if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//'  dans read_vent',1) ; endif
    9086!          varid=nf90_inq_varid(ncid,varname,rcode)
    9187
    … …  
    9389!  -----------------------------------------------------
    9490
    95           start(1)=1
    96           start(2)=1     
    97           count(1)=nbp_lon+1
    98 !          count(1)=iip1
    99           count(2)=nbp_lat
    100 !          count(2)=jjp1
     91          start_(1)=1
     92          start_(2)=1     
     93          count_(1)=nbp_lon+1
     94!          count_(1)=iip1
     95          count_(2)=nbp_lat
     96!          count_(2)=jjp1
    10197
    10298! mise a zero des tableaux
    … …  
    106102! Lecture
    107103! -----------------------
    108           status = nf90_get_var(ncid, varid, tmp_dyn_glo, start, count)
     104          rcode = nf90_get_var(ncid, varid, tmp_dyn_glo, start_, count_)
     105          if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//'  dans read_vent',1) ; endif
    109106
    110107!      call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn   ')

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/Dust/read_vent.f90

    r5536 r5618  
    2323  save ncidu1, varidu1, ncidv1, varidv1
    2424!$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1)
    25   integer :: start(4),count(4), status
     25  integer :: start(4),count_(4)
    2626  integer :: i, j, ig
     27  integer :: lunout
     28
     29  lunout=6
    2730
    2831
    … …  
    3235  if (debutphy) then
    3336  !
    34      ncidu1=nf90_open('u10m.nc',nf90_nowrite,rcode)
    35      varidu1=nf90_inq_varid(ncidu1,'U10M',rcode)
    36      ncidv1=nf90_open('v10m.nc',nf90_nowrite,rcode)
    37      varidv1=nf90_inq_varid(ncidv1,'V10M',rcode)
     37     rcode=nf90_open('u10m.nc',nf90_nowrite,ncidu1)
     38     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open u10m.nc dans read_vent',1) ; endif
     39     rcode=nf90_inq_varid(ncidu1,'U10M',varidu1)
     40     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get id u10m dans read_vent',1) ; endif
     41     rcode=nf90_open('v10m.nc',nf90_nowrite,ncidv1)
     42     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open v10m.nc dans read_vent',1) ; endif
     43     rcode=nf90_inq_varid(ncidv1,'V10M',varidv1)
     44     if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get id v10m dans read_vent',1) ; endif
    3845  !
    3946  endif
    … …  
    4148  start(1)=1
    4249  start(2)=1
     50  start(3)=step
    4351  start(4)=0
    4452
    45    ! count(1)=iip1
    46   count(1)=nbp_lon+1
    47    ! count(2)=jjp1
    48   count(2)=nbp_lat
    49   count(3)=1
    50   count(4)=0
     53   ! count_(1)=iip1
     54  count_(1)=nbp_lon+1
     55   ! count_(2)=jjp1
     56  count_(2)=nbp_lat
     57  count_(3)=1
     58  count_(4)=0
    5159  !
    52   start(3)=step
    5360  !
    54   status = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count)
     61  rcode = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count_)
     62  ! if ( rcode /= 0 ) then ; call abort_physic('LMDZ','lecture u10m dans read_vent',1) ; endif
     63  if ( rcode /= 0 ) then ; write(lunout,*) 'WARNING : pas de temps manquant dans la lecture u10m dans read_vent' ; endif
     64  rcode = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count_)
     65  ! if ( rcode /= 0 ) then ; call abort_physic('LMDZ','lecture v10m dans read_vent',1) ; endif
     66  if ( rcode /= 0 ) then ; write(lunout,*) 'WARNING : pas de temps manquant dans la lecture v10m dans read_vent' ; endif
    5567
    56     ! print *,status
    57   !
    58   status = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count)
     68
     69! ------- Tests 2024/12/31-FH----------------------------------------
     70! print*,'nbp_lon,npb_lat ',nbp_lon,nbp_lat
     71! print*,'start ',start
     72! print*,'count_ ',count_
     73! print*,'satus lecture u10m ',rcode
     74! call dump2d(nbp_lon+1,nbp_lat,u10m_nc_glo,'U10M global read_vent')
     75! call dump2d(nbp_lon+1,nbp_lat,v10m_nc_glo,'V10M global read_vent')
     76! stop
     77! ------- Tests -----------------------------------------------------
    5978
    6079  !
    … …  
    6382  !  print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1)
    6483
    65   !   print *,status
     84  !   print *,rcode
    6685  !  call correctbid(iim,jjp1,u10m_nc)
    6786  !  call correctbid(iim,jjp1,v10m_nc)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/StratAer/calcaerosolstrato_rrtm.f90

    r5338 r5618  
    3939  tau_strat_wave=0.0
    4040  tau_lw_abs_rrtm=0.0
    41 
     41 
     42!-- init tau_strat vars
     43  tau_strat_550(:,:) =0.0
     44  tau_strat_1020(:,:)=0.0
     45 
    4246  CALL miecalc_aer(tau_strat, piz_strat, cg_strat, tau_strat_wave, tau_lw_abs_rrtm, paprs, debut)
    43 
    44 !!--test CK: deactivate radiative effect of aerosol
    45 !  tau_strat=0.0
    46 !  piz_strat=0.0
    47 !  cg_strat=0.0
    48 !  tau_strat_wave=0.0
    49 !  tau_lw_abs_rrtm=0.0
    50 
    51 !--test CK: deactivate SW radiative effect of aerosol (but leave LW)
    52 !  tau_strat=0.0
    53 !  piz_strat=0.0
    54 !  cg_strat=0.0
    55 
    56 !  DO wave=1, nwave_sw
    57 !  tau_strat_wave(:,:,wave)=0.0
    58 !  ENDDO
    59 
    60 !--test CK: deactivate LW radiative effect of aerosol (but leave SW)
    61 !  tau_lw_abs_rrtm=0.0
    62 
    63 !  DO wave=nwave_sw+1, nwave_sw+nwave_lw
    64 !  tau_strat_wave(:,:,wave)=0.0
    65 !  ENDDO
    6647
    6748!--total vertical aod at the 5 SW + 1 LW wavelengths

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/StratAer/interp_sulf_input.f90

    r5338 r5618  
    118118
    119119  IF (is_mpi_root.AND.is_omp_root) THEN
    120 
     120   
     121    OCS_lifetime(:,:)=0.0
     122    SO2_lifetime(:,:)=0.0
     123    H2SO4_lifetime(:,:)=0.0
     124    O3_clim(:,:)=0.0
     125     
    121126    !--init ncdf variables
    122127    IF(flag_newclim_file) THEN
    … …  
    332337
    333338!--regridding tracer concentration on the vertical
     339  budg_3D_backgr_ocs(:,:)=0.0
     340  budg_3D_backgr_so2(:,:)=0.0
     341 
    334342  DO i=1, klon
    335343    DO k=1, klev

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/StratAer/miecalc_aer.f90

    r5268 r5618  
    227227    50000.000,    0.2000,   1.49800,   1.0000E-08 /), (/nb_lambda_h2so4,4/), order=(/2,1/) )
    228228     
     229    ! init
     230    piz_bin(:,:)=0.0
     231    alpha_bin(:,:)=0.0
     232    cg_bin(:,:)=0.0
     233   
    229234    !--compute particle radius for a composition of 75% H2SO4 / 25% H2O at T=293K
    230235    DO bin_number=1, nbtr_bin
    … …  
    332337
    333338      DO bin=1, Nbin !---loop on size bins
    334 
     339     
    335340      r_lower=exp(log(rmin)+FLOAT(bin-1)/FLOAT(Nbin)*(log(rmax)-log(rmin)))
    336341      r_upper=exp(log(rmin)+FLOAT(bin)/FLOAT(Nbin)*(log(rmax)-log(rmin)))

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/StratAer/strataer_local_var_mod.f90

    r5268 r5618  
    159159    USE mod_phys_lmdz_para, ONLY : is_master
    160160    USE infotrac_phy, ONLY: id_OCS_strat,id_SO2_strat,id_H2SO4_strat,nbtr_sulgas,nbtr_bin
    161     USE phys_local_var_mod, ONLY : mdw
     161    USE phys_local_var_mod, ONLY : mdw,R2SO4,R2SO4B,DENSO4,DENSO4B,f_r_wet,f_r_wetB
    162162    USE aerophys, ONLY: mdwmin, V_rat
    163163    USE yomcst_mod_h  , ONLY : RPI
    … …  
    205205    nAerErupt = 1 ; nSpeciesErupt = 1
    206206    ifreqroc=2 ; flh2o=0
     207   
     208    ! array init
     209    mdw(:)=0.
     210    R2SO4(:,:)=0.
     211    R2SO4B(:,:,:)=0.
     212    DENSO4(:,:)=0.
     213    DENSO4B(:,:,:)=0.
     214    f_r_wet(:,:)=0.
     215    f_r_wetB(:,:,:)=0.
    207216   
    208217    !============= Read params =============

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/StratAer/sulfate_aer_mod.f90

    r5268 r5618  
    2727      USE dimphy, ONLY : klon,klev ! nb of longitude and altitude bands
    2828      USE infotrac_phy, ONLY : nbtr_bin
    29       USE aerophys
     29      USE aerophys, ONLY : mAIRmol,mH2Omol,dens_aer_dry,rgas
    3030      USE phys_local_var_mod, ONLY: R2SO4, R2SO4B, DENSO4, DENSO4B, f_r_wet, f_r_wetB
    3131      USE strataer_local_var_mod, ONLY: RRSI
    3232!     WARNING: in phys_local_var_mod R2SO4B, DENSO4B, f_r_wetB (klon,klev,nbtr_bin)
    3333!          and dens_aer_dry must be declared somewhere
     34      USE print_control_mod, ONLY : lunout
    3435   
    3536      IMPLICIT NONE
    … …  
    9091!          Loop on bin radius (RRSI in cm)
    9192           DO IK=1,nbtr_bin
    92  
     93
    9394!      ***   H2SO4-H2O curved surface - Kelvin effect factor ***
    9495!            wet radius (m) (RRSI(IK) in [cm])

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/calcul_fluxs_mod.f90

    r5536 r5618  
    177177       zx_coefh(i) = cdragh(i) * zx_wind(i) * p1lay(i)/(RD*t1lay(i))
    178178       zx_coefq(i) = cdragq(i) * zx_wind(i) * p1lay(i)/(RD*t1lay(i))
    179 !      zx_wind(i)=min_wind_speed+SQRT(gustiness(i)+u1lay(i)**2+v1lay(i)**2) &
    180 !                * p1lay(i)/(RD*t1lay(i))
    181 !      zx_coefh(i) = cdragh(i) * zx_wind(i)
    182 !      zx_coefq(i) = cdragq(i) * zx_wind(i)
    183179    ENDDO
    184180

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/calwake.f90

    r5285 r5618  
    1 
    21! $Id$
     2MODULE calwake_mod
     3  PRIVATE
     4
     5  LOGICAL, SAVE, ALLOCATABLE :: first(:) ! first(klon) : first calwake computation on columns
     6  !$OMP THREADPRIVATE(first)
     7
     8  LOGICAL, SAVE :: first_first=.TRUE.  ! fisrt call to calwake
     9  !$OMP THREADPRIVATE(first_first) 
     10
     11  PUBLIC calwake_first, calwake
     12
     13CONTAINS 
     14
     15SUBROUTINE calwake_first(dtime)
     16USE dimphy, ONLY : klon,klev
     17USE lmdz_wake, ONLY : wake_first
     18  REAL, INTENT(IN)  :: dtime
     19 
     20  IF (first_first) THEN
     21    ALLOCATE(first(klon))
     22    first(:)=.TRUE.
     23   
     24    CALL wake_first(klev, dtime)
     25
     26    first_first=.FALSE.
     27  ENDIF
     28
     29END SUBROUTINE calwake_first
     30
    331
    432SUBROUTINE calwake(iflag_wake_tend, paprs, pplay, dtime, &
    … …  
    2856  USE phys_state_var_mod, ONLY: pctsrf
    2957  USE indice_sol_mod, ONLY: is_oce
    30   USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
     58  USE print_control_mod, ONLY: lunout, prt_level
    3159  USE lmdz_wake, ONLY : wake
    3260  USE yomcst_mod_h
    … …  
    76104  ! Variable internes
    77105  ! -----------------
    78   LOGICAL, SAVE                                      :: first = .TRUE.
    79   !$OMP THREADPRIVATE(first)
    80106  INTEGER                                            :: i, l
    81107  INTEGER, DIMENSION(klon)                           :: znatsurf    ! 0 if pctsrf(is_oce)>0.1; 1 else.
    … …  
    318344  ENDIF  ! (iflag_wake_tend .EQ. 0)
    319345!
    320   IF (first) THEN
    321     DO i = 1,klon
     346  DO i = 1,klon
     347    IF (first(i)) THEN
    322348      IF (wake_dens(i) < -1.) THEN
    323349        wake_dens(i) = wdens(i)
    324350      ENDIF
    325     ENDDO
    326     first=.false.
    327   ENDIF  ! (first)
     351      first(i)=.FALSE.
     352    ENDIF 
     353  ENDDO
     354   
    328355!>jyg
    329356  IF (prt_level >= 10) THEN
    … …  
    334361END SUBROUTINE calwake
    335362
    336 
     363END MODULE calwake_mod

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/carbon_cycle_mod.f90

    r5536 r5618  
    350350
    351351  CHARACTER(len=10),SAVE :: planet_type="earth"
     352
     353  !$OMP THREADPRIVATE(cfname_root,cftext_root,cfunits_root)
     354  !$OMP THREADPRIVATE(mask_in_root,mask_out_root)
     355
    352356
    353357!-----------------------------------------------------------------------

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/chem_mod_h.f90

    r5292 r5618  
    11MODULE chem_mod_h
     2
     3! AS 20250220 : masse_s MOVED TO Dust/lmdz_spla_ini.f90
     4!               n_avogadro, masse_so4 REMOVED BECAUSE NOT USED     
     5
    26  IMPLICIT NONE; PRIVATE
    37  PUBLIC idms, iso2, iso4, ih2s, idmso, imsa, ih2o2, &
    4           n_avogadro, masse_s, masse_so4, rho_water, rho_ice
     8          rho_water, rho_ice
    59
    610  INTEGER idms, iso2, iso4, ih2s, idmso, imsa, ih2o2
    … …  
    812  PARAMETER (ih2s = 4, idmso = 5, imsa = 6, ih2o2 = 7)
    913
    10   REAL n_avogadro, masse_s, masse_so4, rho_water, rho_ice
    11   PARAMETER (n_avogadro = 6.02E23)                  !--molec mol-1
    12   PARAMETER (masse_s = 32.0)                        !--g mol-1
    13   PARAMETER (masse_so4 = 96.0)                      !--g mol-1
     14  REAL rho_water, rho_ice
    1415  PARAMETER (rho_water = 1000.0)                    !--kg m-3
    1516  PARAMETER (rho_ice = 500.0)                       !--kg m-3

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/clesphys_mod_h.f90

    r5589 r5618  
    2222          , co2_ppm0                                                   &
    2323          , tau_thermals                                               &
    24           , Cd_frein, zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t &
     24          , Cd_frein, nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t &
    2525          , ecrit_LES                                                  &
    2626          , ecrit_ins, ecrit_hf, ecrit_day                             &
    … …  
    5555
    5656  ! threshold on to activate SSO schemes
    57   ! threshold on to activate SSO schemes
    58   REAL zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t
     57  REAL nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t
    5958  INTEGER iflag_cycle_diurne
    6059  LOGICAL soil_model, new_oliq, ok_orodr, ok_orolf
    … …  
    180179  !$OMP      , co2_ppm0                                                   &
    181180  !$OMP      , tau_thermals                                               &
    182   !$OMP      , Cd_frein, zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t &
     181  !$OMP      , Cd_frein, nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t &
    183182  !$OMP      , ecrit_LES                                                  &
    184183  !$OMP      , ecrit_ins, ecrit_hf, ecrit_day                             &

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/concvl.f90

    r5304 r5618  
    1111                  pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, &
    1212                  qcondc, wd, pmflxr, pmflxs, &
     13                  coef_clos, coef_clos_eff, &
    1314!RomP >>>
    1415!!     .             da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
    1516                  da, phi, mp, phii, d1a, dam, sij, qta, clw, elij, &! RomP
    16                   dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
     17                  dd_t, dd_q, lalim_conv, wght_th,                  &! RomP
    1718                  evap, ep, epmlmMm, eplaMm, &                       ! RomP
    1819                  wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, &
    … …  
    132133  REAL, DIMENSION(klon),        INTENT(OUT)     :: wd
    133134  REAL, DIMENSION(klon,klev+1), INTENT(OUT)     :: pmflxr, pmflxs
     135  REAL, DIMENSION(klon),        INTENT(OUT)     :: coef_clos, coef_clos_eff
    134136
    135137  REAL, DIMENSION(klon,klev),   INTENT(OUT)     :: da, mp
    … …  
    430432                    cape, cin, tvp, &
    431433                    dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
    432                     asupmaxmin, lalim_conv, &
     434                    asupmaxmin, &
     435                    coef_clos, coef_clos_eff, &
     436                    lalim_conv, &
    433437!AC!+!RomP+jyg
    434438!!                   da,phi,mp,phii,d1a,dam,sij,clw,elij, &               ! RomP

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/conf_phys_m.f90

    r5589 r5618  
    213213    LOGICAL, SAVE :: ok_lic_cond_omp
    214214    !
    215     REAL, SAVE    :: zrel_oro_t_omp, zstd_orodr_t_omp
     215    REAL, SAVE    :: nm_oro_t_omp, zstd_orodr_t_omp
    216216    REAL, SAVE    :: zpmm_orodr_t_omp, zpmm_orolf_t_omp
    217217    INTEGER, SAVE :: iflag_cycle_diurne_omp
    … …  
    893893
    894894
    895     !Config  Key  =  zrel_oro_t
    896     !Config  Desc = zrel_oro_t
    897     !Config  Def  = 9999.
     895    !Config  Key  =  nm_oro_t
     896    !Config  Desc = nm_oro_t
     897    !Config  Def  = -1
    898898    !Config  Help = Connais pas !
    899     zrel_oro_t_omp = 9999.
    900     CALL getin('zrel_oro_t', zrel_oro_t_omp)
     899    nm_oro_t_omp = -1.
     900    CALL getin('nm_oro_t', nm_oro_t_omp)
    901901
    902902    !Config  Key  =  zstd_orodr_t
    … …  
    23302330    ok_orodr = ok_orodr_omp
    23312331    ok_orolf = ok_orolf_omp
    2332     zrel_oro_t=zrel_oro_t_omp
     2332    nm_oro_t=nm_oro_t_omp
    23332333    zstd_orodr_t=zstd_orodr_t_omp
    23342334    zpmm_orodr_t=zpmm_orodr_t_omp
    … …  
    27512751    WRITE(lunout,*) ' ok_orodr=',ok_orodr
    27522752    WRITE(lunout,*) ' ok_orolf=',ok_orolf
    2753     WRITE(lunout,*) ' zrel_oro_t=',zrel_oro_t
     2753    WRITE(lunout,*) ' nm_oro_t=',nm_oro_t
    27542754    WRITE(lunout,*) ' zstd_orodr_t=',zstd_orodr_t
    27552755    WRITE(lunout,*) ' zpmm_orodr_t=',zpmm_orodr_t

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/cv3_routines.f90

    r5536 r5618  
    1212  USE conema3_mod_h
    1313  USE lmdz_cv_ini, ONLY : alpha,alpha1,beta,betad,coef_peel,cv_flag_feed,delta,dpbase,dtcrit,dtovsh,dttrig,ejectice,ejectliq,elcrit,flag_epkeorig,flag_wb,minorig,nl,nlm,nlp,noconv_stop,noff,omtrain,pbcrit,ptcrit,sigdz,spfac,t_top_max,tau,tau_stop,tlcrit,wbmax
     14  USE lmdz_cv_ini, ONLY : keep_bug_indices_cv3_tracer, keep_bug_q_nocons_cv
    1415
    1516
    … …  
    139140     keepbug_ice_frac = .TRUE.
    140141     CALL getin_p('keepbug_ice_frac', keepbug_ice_frac)
     142     keep_bug_indices_cv3_tracer = .FALSE.
     143     CALL getin_p('keep_bug_indices_cv3_tracer', keep_bug_indices_cv3_tracer)
     144     keep_bug_q_nocons_cv = .TRUE.
     145     CALL getin_p('keep_bug_q_nocons_cv', keep_bug_q_nocons_cv)
     146
    141147
    142148    WRITE (*, *) 't_top_max=', t_top_max
    … …  
    164170    WRITE (*, *) 'adiab_ascent_mass_flux_depends_on_ejectliq =', adiab_ascent_mass_flux_depends_on_ejectliq
    165171    WRITE (*, *) 'keepbug_ice_frac =', keepbug_ice_frac
     172    WRITE (*, *) 'keep_bug_indices_cv3_tracer =', keep_bug_indices_cv3_tracer
     173    WRITE (*, *) 'keep_bug_q_nocons_cv =', keep_bug_q_nocons_cv
    166174
    167175    first = .FALSE.
    … …  
    26992707                     wdtrainA, wdtrainS, wdtrainM)                                      ! RomP
    27002708  USE lmdz_cv_ini, ONLY : cpd,ginv,grav,nl,nlp,sigdz
     2709  USE lmdz_cv_ini, ONLY : keep_bug_q_nocons_cv
    27012710  USE cvflag_mod_h
    27022711  USE print_control_mod, ONLY: prt_level, lunout
    … …  
    29012910
    29022911
    2903     DO il = 1, ncum
    2904       IF (i<=inb(il) .AND. lwork(il)) THEN
    2905         wdtrain(il) = grav*ep(il, i)*m(il, i)*clw(il, i)
    2906         wdtrainS(il, i) = wdtrain(il)/grav                                            !   Ps   jyg
    2907 !!        wdtrainA(il, i) = wdtrain(il)/grav                                          !   Ps   RomP
    2908       END IF
    2909     END DO
    2910 
    2911     IF (i>1) THEN
    2912       DO j = 1, i - 1
     2912  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2913  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2914  IF (keep_bug_q_nocons_cv) THEN
     2915  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    29132916        DO il = 1, ncum
    29142917          IF (i<=inb(il) .AND. lwork(il)) THEN
    2915             awat = elij(il, j, i) - (1.-ep(il,i))*clw(il, i)
    2916             awat = max(awat, 0.0)
    2917             wdtrain(il) = wdtrain(il) + grav*awat*ment(il, j, i)
    2918             wdtrainM(il, i) = wdtrain(il)/grav - wdtrainS(il, i)    !   Pm  jyg
    2919 !!            wdtrainM(il, i) = wdtrain(il)/grav - wdtrainA(il, i)  !   Pm  RomP
     2918            wdtrain(il) = grav*ep(il, i)*m(il, i)*clw(il, i)
     2919            wdtrainS(il, i) = wdtrain(il)/grav                                            !   Ps   jyg
    29202920          END IF
    29212921        END DO
    2922       END DO
    2923     END IF
    2924 
    2925     IF (cvflag_prec_eject) THEN
    2926 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2927       IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
    2928 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2929 !!! Warning : this option leads to water conservation violation
    2930 !!!           Expert only
    2931 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2932           IF ( i > 1) THEN
     2922   
     2923        IF (i>1) THEN
     2924          DO j = 1, i - 1
    29332925            DO il = 1, ncum
    29342926              IF (i<=inb(il) .AND. lwork(il)) THEN
    2935                 wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))/(1. - qta(il, i-1))    !   Pa   jygprl
    2936                 wdtrain(il) = wdtrain(il) + grav*wdtrainA(il,i)
     2927                awat = elij(il, j, i) - (1.-ep(il,i))*clw(il, i)
     2928                awat = max(awat, 0.0)
     2929                wdtrain(il) = wdtrain(il) + grav*awat*ment(il, j, i)
     2930                wdtrainM(il, i) = wdtrain(il)/grav - wdtrainS(il, i)    !   Pm  jyg
    29372931              END IF
    29382932            END DO
    2939           ENDIF  ! ( i > 1)
    2940 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2941       ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
    2942 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2943           IF ( i > 1) THEN
     2933          END DO
     2934        END IF
     2935   
     2936        IF (cvflag_prec_eject) THEN
     2937    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2938          IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
     2939    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2940    !!! Warning : this option leads to water conservation violation
     2941    !!!           Expert only
     2942    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2943              IF ( i > 1) THEN
     2944                DO il = 1, ncum
     2945                  IF (i<=inb(il) .AND. lwork(il)) THEN
     2946                    wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))/(1. - qta(il, i-1))    !   Pa   jygprl
     2947                    wdtrain(il) = wdtrain(il) + grav*wdtrainA(il,i)
     2948                  END IF
     2949                END DO
     2950              ENDIF  ! ( i > 1)
     2951    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2952          ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
     2953    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2954              IF ( i > 1) THEN
     2955                DO il = 1, ncum
     2956                  IF (i<=inb(il) .AND. lwork(il)) THEN
     2957                    wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))                        !   Pa   jygprl
     2958                    wdtrain(il) = wdtrain(il) + grav*wdtrainA(il,i)
     2959                  END IF
     2960                END DO
     2961              ENDIF  ! ( i > 1)
     2962   
     2963          ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
     2964    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2965        ENDIF  ! (cvflag_prec_eject)
     2966   
     2967  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2968  ELSE ! (keep_bug_q_nocons_cv)
     2969  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2970        DO il = 1, ncum
     2971          IF (i<=inb(il) .AND. lwork(il)) THEN
     2972            wdtrainS(il, i) = ep(il, i)*m(il, i)*clw(il, i)                               ! jyg
     2973          END IF
     2974        END DO
     2975   
     2976        IF (i>1) THEN
     2977          DO j = 1, i - 1
    29442978            DO il = 1, ncum
    29452979              IF (i<=inb(il) .AND. lwork(il)) THEN
    2946                 wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))                        !   Pa   jygprl
    2947                 wdtrain(il) = wdtrain(il) + grav*wdtrainA(il,i)
     2980                awat = elij(il, j, i) - (1.-ep(il,i))*clw(il, i)
     2981                awat = max(awat, 0.0)
     2982                wdtrainM(il, i) = wdtrainM(il, i) + awat*ment(il, j, i)                   ! jyg
    29482983              END IF
    29492984            END DO
    2950           ENDIF  ! ( i > 1)
    2951 
    2952       ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
    2953 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2954     ENDIF  ! (cvflag_prec_eject)
    2955 
     2985          END DO
     2986        END IF
     2987   
     2988        IF (cvflag_prec_eject) THEN
     2989    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2990          IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
     2991    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2992    !!! Warning : this option leads to water conservation violation
     2993    !!!           Expert only
     2994    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2995              IF ( i > 1) THEN
     2996                DO il = 1, ncum
     2997                  IF (i<=inb(il) .AND. lwork(il)) THEN
     2998                    wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))/(1. - qta(il, i-1))    !   Pa   jygprl
     2999                  END IF
     3000                END DO
     3001              ENDIF  ! ( i > 1)
     3002    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3003          ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
     3004    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3005              IF ( i > 1) THEN
     3006                DO il = 1, ncum
     3007                  IF (i<=inb(il) .AND. lwork(il)) THEN
     3008                    wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))                        !   Pa   jygprl
     3009                  END IF
     3010                END DO
     3011              ENDIF  ! ( i > 1)
     3012   
     3013          ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
     3014    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3015        ENDIF  ! (cvflag_prec_eject)
     3016   
     3017        IF ( i > 1) THEN
     3018          DO il = 1, ncum
     3019            IF (i<=inb(il) .AND. lwork(il)) THEN
     3020              wdtrain(il) = grav*(wdtrainS(il,i) + wdtrainM(il,i) + wdtrainA(il,i))
     3021            END IF
     3022          END DO
     3023        ENDIF  ! ( i > 1)
     3024   
     3025  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3026  ENDIF ! (keep_bug_q_nocons_cv)
     3027  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3028  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    29563029
    29573030! ***    find rain water and evaporation using provisional   ***
    … …  
    31353208          ice(il, i) = ice(il, i) - fondue(il, i)
    31363209
    3137           IF (water(il,i)+ice(il,i)<1.E-30) THEN
    3138             faci(il, i) = 0.
    3139           ELSE
    3140             faci(il, i) = ice(il, i)/(water(il,i)+ice(il,i))
    3141           END IF
     3210!!          IF (water(il,i)+ice(il,i)<1.E-30) THEN
     3211!!            faci(il, i) = 0.
     3212!!          ELSE
     3213!!            faci(il, i) = ice(il, i)/(water(il,i)+ice(il,i))
     3214!!          END IF
     3215
     3216            faci(il,i) = ice(il, i)/max((water(il,i)+ice(il,i)), smallestreal)
    31423217
    31433218!           water(il,i)=water(il,i+1)+(1.-fraci(il,i))*e6+(1.-faci(il,i))*f6
    … …  
    34193494! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    34203495
    3421 
    34223496  RETURN
    34233497
    … …  
    34453519    USE cvflag_mod_h
    34463520   USE lmdz_cv_ini, ONLY : grav,minorig,nl,nlp,rowl,rrd,nl,ci,cl,cpd,cpv
     3521   USE lmdz_cv_ini, ONLY : keep_bug_q_nocons_cv
    34473522  IMPLICIT NONE
    34483523
    … …  
    35273602      REAL, DIMENSION (nloc, nd)                         :: sigment, qtment             ! cld
    35283603      REAL, DIMENSION (nloc, nd, nd)                     :: qdet
    3529       REAL sumdq !jyg
     3604!!      REAL sumdq !jyg
    35303605!
    35313606! -------------------------------------------------------------
     3607
    35323608
    35333609! initialization:
    … …  
    40034079! ***                      through each level                          ***
    40044080
    4005 
    40064081!jyg<
    40074082!!  DO i = 2, nl + 1 ! newvecto: mettre nl au lieu nl+1?
    … …  
    40204095           IF (ok_optim_yield) THEN                       !|
    40214096!-----------------------------------------------------------
    4022 DO il = 1, ncum
    4023    amp1(il) = upwd(il,i+1)
    4024    ad(il) = dnwd(il,i)
    4025 ENDDO
     4097    IF (keep_bug_q_nocons_cv) THEN    !!jyg20250215
     4098      DO il = 1, ncum
     4099         amp1(il) = upwd(il,i+1)
     4100         ad(il) = dnwd(il,i)
     4101      ENDDO
     4102    ELSE  ! (keep_bug_q_nocons_cv)
     4103      DO il = 1, ncum
     4104         amp1(il) = upwd(il,i+1)
     4105         ad(il) = - dnwd(il,i)
     4106      ENDDO
     4107    ENDIF  ! (keep_bug_q_nocons_cv)
    40264108!-----------------------------------------------------------
    40274109        ELSE !(ok_optim_yield)                            !|
    … …  
    43564438500 END DO
    43574439
    4358 !JYG<
    4359 !Conservation de l'eau
    4360 !   sumdq = 0.
    4361 !   DO k = 1, nl
    4362 !     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
    4363 !   END DO
    4364 !   PRINT *, 'cv3_yield, apres 500, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
    4365 !JYG>
     4440!!!JYG<
     4441!!!Conservation de l'eau
     4442!!   sumdq = 0.
     4443!!   DO k = 1, nl
     4444!!     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
     4445!!   END DO
     4446!!   PRINT *, 'cv3_yield, apres 500, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
     4447!!!JYG>
    43664448! ***   move the detrainment at level inb down to level inb-1   ***
    43674449! ***        in such a way as to preserve the vertically        ***
    … …  
    43984480  END DO
    43994481
    4400 !JYG<
    4401 !Conservation de l'eau
    4402 !   sumdq = 0.
    4403 !   DO k = 1, nl
    4404 !     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
    4405 !   END DO
    4406 !   PRINT *, 'cv3_yield, apres 503, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
    4407 !JYG>
     4482!!!JYG<
     4483!!!Conservation de l'eau
     4484!!   sumdq = 0.
     4485!!   DO k = 1, nl
     4486!!     sumdq = sumdq + fr(1, k)*100.*(ph(1,k)-ph(1,k+1))/grav
     4487!!   END DO
     4488!!   PRINT *, 'cv3_yield, apres 503, sum(dq), precip, somme ', sumdq, Vprecip(1, 1), sumdq + vprecip(1, 1)
     4489!!!JYG>
    44084490
    44094491!AC!      do j=1,ntra
    … …  
    49365018                      ep, Vprecip, elij, clw, epmlmMm, eplaMm, &
    49375019                      icb, inb)
    4938    USE lmdz_cv_ini, ONLY : nl
     5020  USE lmdz_cv_ini, ONLY : nl,keep_bug_indices_cv3_tracer
    49395021  USE cvflag_mod_h
     5022  USE ioipsl_getin_p_mod, ONLY : getin_p
    49405023  IMPLICIT NONE
    49415024
    49425025
    49435026!inputs:
     5027!------
    49445028  INTEGER, INTENT (IN)                               :: ncum, nd, na, nloc, len
    49455029  INTEGER, DIMENSION (len), INTENT (IN)              :: icb, inb
    … …  
    49495033  REAL, DIMENSION (len, nd+1), INTENT (IN)           :: Vprecip
    49505034!ouputs:
     5035!------
    49515036  REAL, DIMENSION (len, na, na), INTENT (OUT)        :: phi, phi2, epmlmMm
    49525037  REAL, DIMENSION (len, na), INTENT (OUT)            :: da, d1a, dam, eplaMm
    49535038!
     5039!local variables:
     5040!---------------
    49545041! variables pour tracer dans precip de l'AA et des mel
    4955 !local variables:
    49565042  INTEGER i, j, k
    49575043  REAL epm(nloc, na, na)
    4958 
     5044!
    49595045! variables d'Emanuel : du second indice au troisieme
    49605046! --->    tab(i,k,j) -> de l origine k a l arrivee j
    … …  
    49625048! variables personnelles : du troisieme au second indice
    49635049! --->    tab(i,j,k) -> de k a j
    4964 ! phi, phi2
    4965 
    4966 ! initialisations
     5050! phi, phi2, epm, epmlmMm
     5051
    49675052
    49685053  da(:, :) = 0.
    … …  
    50225107        d1a(i, j) = d1a(i, j) + ment(i, k, j)*ep(i, k)*(1.-sigij(i,k,j))
    50235108        IF (k<=j) THEN
    5024           dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, k, j)*(1.-ep(i,k))*(1.-sigij(i,k,j))
    50255109          phi2(i, j, k) = phi(i, j, k)*epm(i, j, k)
    50265110        END IF
    … …  
    50285112    END DO
    50295113  END DO
     5114
     5115  IF (keep_bug_indices_cv3_tracer) THEN
     5116    DO j = 1, nl
     5117      DO k = 1, nl
     5118        DO i = 1, ncum
     5119          IF (k<=j) THEN
     5120            dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, k, j)*(1.-ep(i,k))*(1.-sigij(i,k,j))
     5121          END IF ! (k<=j)
     5122        END DO
     5123      END DO
     5124    END DO
     5125  ELSE  ! (keep_bug_indices_cv3_tracer)
     5126    DO j = 1, nl
     5127      DO k = 1, nl
     5128        DO i = 1, ncum
     5129          IF (k<=j) THEN
     5130            dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, j, k)*(1.-ep(i,k))*(1.-sigij(i,k,j))
     5131          END IF ! (k<=j)
     5132        END DO
     5133      END DO
     5134    END DO
     5135  ENDIF ! (keep_bug_indices_cv3_tracer)
    50305136
    50315137  RETURN

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/cv3a_uncompress.f90

    r5346 r5618  
     1! $Id$
     2
    13SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
    24                           iflag, kbas, ktop, &
    … …  
    911                           plim1, plim2, asupmax, supmax0, &
    1012                           asupmaxmin, &
     13                           coef_clos, coef_clos_eff, &
    1114                           da, phi, mp, phi2, d1a, dam, sigij, &                ! RomP+AC+jyg
    1215                           qta, clw, elij, evap, ep, epmlmMm, eplaMm, &         ! RomP+jyg
    … …  
    2326                           plim11, plim21, asupmax1, supmax01, &
    2427                           asupmaxmin1, &
     28                           coef_clos1, coef_clos_eff1, &
    2529                           da1, phi1, mp1, phi21, d1a1, dam1, sigij1, &         ! RomP+AC+jyg
    2630                           qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &  ! RomP+jyg
    … …  
    6872  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: asupmax
    6973  REAL, DIMENSION (nloc), INTENT (IN)                :: supmax0, asupmaxmin
     74  REAL, DIMENSION (nloc), INTENT (IN)                :: coef_clos, coef_clos_eff
    7075
    7176  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: da
    … …  
    105110  REAL, DIMENSION (len, nd), INTENT (OUT)            :: asupmax1
    106111  REAL, DIMENSION (len), INTENT (OUT)                :: supmax01, asupmaxmin1
     112  REAL, DIMENSION (len), INTENT (OUT)                :: coef_clos1, coef_clos_eff1
    107113                                                   
    108114  REAL, DIMENSION (len, nd), INTENT (OUT)            :: da1
    … …  
    149155      supmax01(idcum(i)) = supmax0(i)
    150156      asupmaxmin1(idcum(i)) = asupmaxmin(i)
     157      coef_clos1(idcum(i)) = coef_clos(i)
     158      coef_clos_eff1(idcum(i)) = coef_clos_eff(i)
    151159      epmax_diag1(idcum(i)) = epmax_diag(i)
    152160    END DO
    … …  
    282290      supmax01(:) = supmax0(:)
    283291      asupmaxmin1(:) = asupmaxmin(:)
     292      coef_clos1(:) = coef_clos(:)
     293      coef_clos_eff1(:) = coef_clos_eff(:)
    284294!
    285295      sig1(:, 1:nl) = sig(:, 1:nl)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/cv3p1_closure.f90

    r5346 r5618  
    44SUBROUTINE cv3p1_closure(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, tv, &
    55    tvp, buoy, supmax, ok_inhib, ale, alp, omega,sig, w0, ptop2, cape, cin, m, &
    6     iflag, coef, plim1, plim2, asupmax, supmax0, asupmaxmin, cbmf, plfc, &
    7     wbeff)
     6    iflag, coef, coeftrue, plim1, plim2, asupmax, supmax0, asupmaxmin, &
     7    cbmf, plfc, wbeff)
    88
    99
    … …  
    4848  REAL, DIMENSION (nloc), INTENT (OUT)               :: cape, cin
    4949  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: m
     50  REAL, DIMENSION (nloc), INTENT (OUT)               :: coef, coeftrue
    5051  REAL, DIMENSION (nloc), INTENT (OUT)               :: plim1, plim2
    5152  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: asupmax
    … …  
    7475  REAL cbmflim(nloc), cbmf1(nloc), cbmfmax(nloc)
    7576  REAL cbmflast(nloc)
    76   REAL coef(nloc)
    7777  REAL xp(nloc), xq(nloc), xr(nloc), discr(nloc), b3(nloc), b4(nloc)
    7878  REAL theta(nloc), bb(nloc)
    … …  
    598598  DO il = 1, ncum
    599599    coef(il) = (cbmf(il)+1.E-10)/(cbmflim(il)+1.E-10)
     600    coeftrue(il) = coef(il)
    600601  END DO
    601602  IF (prt_level>=20) PRINT *, 'cv3p1_param apres coef_plantePLUS'

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/cva_driver.f90

    r5279 r5618  
    2121                      ftd1, fqd1, &
    2222                      Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
     23                      coef_clos1, coef_clos_eff1, &
    2324                      lalim_conv1, &
    2425!!                      da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, &        ! RomP
    … …  
    249250  REAL, DIMENSION (len), INTENT (OUT)                :: supmax01
    250251  REAL, DIMENSION (len), INTENT (OUT)                :: asupmaxmin1
     252  REAL, DIMENSION (len), INTENT (OUT)                :: coef_clos1, coef_clos_eff1
    251253  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1    ! in cloud water content (intensive)   ! cld
    252254  REAL, DIMENSION (len, nd), INTENT (OUT)            :: sigt1   ! fract. cloud area (intensive)        ! cld
    … …  
    495497  REAL elij(nloc, nd, nd)
    496498  REAL supmax(nloc, nd)
    497   REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
     499  REAL Ale(nloc), Alp(nloc), coef_clos(nloc), coef_clos_eff(nloc)
    498500  REAL omega(nloc,nd)
    499501  REAL sigd(nloc)
    … …  
    679681  DO il = 1, nloc
    680682    coef_clos(il) = 1.
     683    coef_clos_eff(il) = 1.
    681684  END DO
    682685
    … …  
    10031006                           pbase, plcl, p, ph, tv, tvp, buoy, &
    10041007                           supmax, ok_inhib, Ale, Alp, omega, &
    1005                            sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
     1008                           sig, w0, ptop2, cape, cin, m, iflag, &
     1009                           coef_clos_eff, coef_clos, &
    10061010                           Plim1, plim2, asupmax, supmax0, &
    10071011                           asupmaxmin, cbmf, plfc, wbeff)
    … …  
    10161020                           pbase, plcl, p, ph, tv, tvp, buoy, &
    10171021                           supmax, ok_inhib, Ale, Alp, omega, &
    1018                            sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
     1022                           sig, w0, ptop2, cape, cin, m, iflag, coef_clos_eff, &
    10191023                           Plim1, plim2, asupmax, supmax0, &
    10201024                           asupmaxmin, cbmf, plfc, wbeff)
    … …  
    10911095                     th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
    10921096                     ep, sigp, clw, frac_s, qpreca, frac_a, qta, &                    !!jygprl
    1093                      m, ment, elij, delt, plcl, coef_clos, &
     1097                     m, ment, elij, delt, plcl, coef_clos_eff, &
    10941098                     mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
    10951099                     faci, b, sigd, &
    … …  
    12181222                           Plim1, plim2, asupmax, supmax0, &
    12191223                           asupmaxmin, &
     1224                           coef_clos, coef_clos_eff, &
    12201225                           da, phi, mp, phi2, d1a, dam, sigij, &         ! RomP
    12211226                           qta, clw, elij, evap, ep, epmlmMm, eplaMm, &  ! RomP
    … …  
    12311236                           Plim11, plim21, asupmax1, supmax01, &
    12321237                           asupmaxmin1, &
     1238                           coef_clos1, coef_clos_eff1, &
    12331239                           da1, phi1, mp1, phi21, d1a1, dam1, sigij1,  &       ! RomP
    12341240                           qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/cvltr_scav.f90

    r5450 r5618  
    1212     zmfd1a,zmfphi2,zmfdam)
    1313  !
    14 USE chem_mod_h
    1514  USE yoecumf_mod_h
    1615  USE conema3_mod_h

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/dimphy.f90

    r5536 r5618  
    1414
    1515!$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon)
    16   REAL,save,allocatable,dimension(:) :: zmasq
     16! note that klev, klevp1, klevm1 and kflev are
     17! not included in an ompthreadprivate statement
     18! because of the way they are initialized below (omp master)
     19
     20REAL,save,allocatable,dimension(:) :: zmasq
    1721!$OMP THREADPRIVATE(zmasq)   
    1822

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/dyn1d/replay1d.f90

    r5536 r5618  
    2424CHARACTER (len=10) :: calend
    2525CHARACTER(len=20) :: calendrier
    26 
     26CHARACTER(len=20) :: lmax_replay
    2727
    2828!---------------------------------------------------------------------
    … …  
    5656call getin('calend',calend)
    5757call getin('day_step',day_step)
     58
     59print*,'AVANT getin'
     60klev=llm
     61CALL getin('lmax_replay',lmax_replay)
     62print*,'APRES getin',lmax_replay
     63CALL getin(lmax_replay,klev)
     64print*,'replay1d lmax_replay klev',lmax_replay,klev
     65
    5866calendrier=calend
    5967if ( calendrier == "earth_360d" ) calendrier="360_day"
    … …  
    6977
    7078klon=1
    71 klev=llm
    7279call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,86400./day_step,calendrier)
    7380! Consistent with ... CALL iophys_ini(600.)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/fonte_neige_mod.F90

    r5536 r5618  
    231231  SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
    232232       tsurf, precip_rain, precip_snow, &
    233        snow, qsol, tsurf_new, evap &
     233       snow, qsol, tsurf_new, evap, ice_sub &
    234234#ifdef ISO   
    235235     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
    … …  
    288288    REAL, DIMENSION(klon), INTENT(INOUT) :: evap
    289289
     290
     291    REAL, DIMENSION(klon), INTENT(OUT)   :: ice_sub
    290292#ifdef ISO   
    291293        ! sortie de quelques diagnostiques
    … …  
    297299    REAL, DIMENSION(klon), INTENT(OUT) ::  runoff_diag   
    298300    REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag 
    299     REAL,                  INTENT(OUT) :: coeff_rel_diag
    300 #endif
     301    REAL,                  INTENT(OUT) :: coeff_rel_diag   
     302#endif
     303
    301304
    302305! Local variables
    … …  
    345348
    346349    snow_evap = 0.
     350    ice_sub(:) = 0.
    347351 
    348352    IF (.NOT. ok_lic_cond) THEN
    … …  
    363367   
    364368    bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
     369
     370    IF (nisurf==is_lic) THEN
     371       DO i=1,knon
     372          ice_sub(i)=evap(i)-snow_evap(i)
     373       ENDDO
     374    ENDIF
     375
    365376#ifdef ISO
    366377    snow_evap_diag(:) = snow_evap(:)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/infotrac_phy.F90

    r5609 r5618  
    33MODULE infotrac_phy
    44
    5    USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx
    6    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
    7         delPhase, niso, getKey, isot_type, processIsotopes,  isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
    8         addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,  iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    9    USE readTracFiles_mod, ONLY: new2oldH2O
     5   USE       strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx
     6   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers,  addPhase,  addKey, iH2O, &
     7       isoSelect,  indexUpdate, isot_type, testTracersFiles, isotope,  delPhase,  getKey, tran0, &
     8       isoKeys, isoName, isoZone, isoPhas, processIsotopes,  isoCheck, itZonIso,  nbIso,         &
     9          niso,   ntiso,   nzone,   nphas,   maxTableWidth,  iqIsoPha, iqWIsoPha, ixIso, new2oldH2O
    1010   IMPLICIT NONE
    1111
    … …  
    2727   !=== FOR ISOTOPES: Specific to water
    2828   PUBLIC :: iH2O                                          !--- Value of "ixIso" for "H2O" isotopes class
    29    PUBLIC :: ivap, iliq, isol
     29   PUBLIC :: ivap, iliq, isol, ibs, icf, iqvc, icfa, ipcf, iqia, iqva
    3030   !=== FOR ISOTOPES: Depending on the selected isotopes family
    3131   PUBLIC :: isotope                                       !--- Selected isotopes database (argument of getKey)
    … …  
    8080!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
    8181!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
    82 !  | isAdvected  | Advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
    83 !  | isInPhysics | Tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
     82!  | isInPhysics | Advected tracers from the main table kept in physics | /           | nqtottr .TRUE. values  |
    8483!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
    8584!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    … …  
    104103
    105104   !=== INDICES FOR WATER
    106    INTEGER, SAVE :: ivap, iliq, isol
    107 !$OMP THREADPRIVATE(ivap, iliq, isol)
     105   INTEGER, SAVE :: ivap, iliq, isol, ibs, icf, iqvc, icfa, ipcf, iqia, iqva
     106!$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, iqvc, icfa, ipcf, iqia, iqva)
    108107
    109108   !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
    110    INTEGER,               SAVE :: nqtot                       !--- Tracers nb in dynamics (incl. higher moments + H2O)
    111    INTEGER,               SAVE :: nbtr                        !--- Tracers nb in physics  (excl. higher moments + H2O)
    112    INTEGER,               SAVE :: nqo                         !--- Number of water phases
    113    INTEGER,               SAVE :: nqtottr                     !--- Number of tracers passed to phytrac (TO BE DELETED ?)
    114    INTEGER,               SAVE :: nqCO2                         !--- Number of tracers of CO2  (ThL)
     109   INTEGER, SAVE :: nqtot                                       !--- Tracers nb in dynamics (incl. higher moments + H2O)
     110   INTEGER, SAVE :: nbtr                                        !--- Tracers nb in physics  (excl. higher moments + H2O)
     111   INTEGER, SAVE :: nqo                                         !--- Number of water phases
     112   INTEGER, SAVE :: nqtottr                                     !--- Number of tracers passed to phytrac (TO BE DELETED ?)
     113   INTEGER, SAVE :: nqCO2                                       !--- Number of tracers of CO2  (ThL)
    115114   CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type(s)
    116115!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac)
    117116
    118117   !=== VARIABLES FOR INCA
    119    INTEGER, DIMENSION(:), SAVE, ALLOCATABLE ::  conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr)
     118   INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:)        !--- Convection / boundary layer activation (nbtr)
    120119!$OMP THREADPRIVATE(conv_flg, pbl_flg)
    121120
    … …  
    133132   USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_trac
    134133   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS, CPPKEY_STRATAER
    135 IMPLICIT NONE
     134   USE mod_phys_lmdz_para, ONLY: is_master, is_omp_master
     135   IMPLICIT NONE
    136136!==============================================================================================================================
    137137!
    … …  
    158158! Local variables
    159159   INTEGER, ALLOCATABLE :: hadv(:), vadv(:)                          !--- Horizontal/vertical transport scheme number
    160    INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
    161                            vad (:), vadv_inca(:),  pbl_flg_inca(:)
    162    CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:)                   !--- Tracers names for INCA
    163160   INTEGER :: nqINCA
    164161   CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
    … …  
    187184   CALL getin_p('type_trac',type_trac)
    188185
    189    lerr=strParse(type_trac, '|', types_trac, n=nt)
    190    IF (nt .GT. 1) THEN
    191       IF (nt .GT. 2) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
    192       IF (nt .EQ. 2) type_trac=types_trac(2)
    193    ENDIF
     186   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname, is_master)
     187   IF(strCount(type_trac, '|', nt)) CALL abort_physic(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1)
     188   IF(nt >= 3) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
     189   IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_physic(modname, "couldn't parse "//'"type_trac"', 1)
     190   IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON
    194191
    195192   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
    … …  
    197194
    198195!##############################################################################################################################
    199    IF(lInit) THEN                                                    !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
     196   IF(lInit .AND. is_master) THEN                                    !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
    200197!##############################################################################################################################
    201198   !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
    … …  
    214211   SELECT CASE(type_trac)
    215212      CASE('inca', 'inco')
    216 IF (.NOT. CPPKEY_INCA) THEN
    217          CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1)
    218 END IF
     213         IF(.NOT.CPPKEY_INCA)     CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1)
    219214      CASE('repr')
    220 IF (.NOT. CPPKEY_REPROBUS) THEN
    221          CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
    222 END IF
     215         IF(.NOT.CPPKEY_REPROBUS) CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
    223216      CASE('coag')
    224 IF (.NOT. CPPKEY_STRATAER) THEN
    225          CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
    226 END IF
     217         IF(.NOT.CPPKEY_STRATAER) CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
    227218   END SELECT
    228219!##############################################################################################################################
    … …  
    230221!##############################################################################################################################
    231222
    232    nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
    233 
    234223!==============================================================================================================================
    235224! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT
    236225!==============================================================================================================================
    237    texp = type_trac                                                            !=== EXPANDED (WITH "|" SEPARATOR) "type_trac"
     226   texp = type_trac                                                  !=== EXPANDED (WITH "|" SEPARATOR) "type_trac"
    238227   IF(texp == 'inco') texp = 'co2i|inca'
    239228   IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp)
    240    IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_physic(modname, 'problem with tracers file(s)',1)
     229   IF(testTracersFiles(modname, texp, fType, lInit.AND.is_master)) CALL abort_physic(modname, 'problem with tracers file(s)',1)
    241230   ttp = type_trac; IF(fType /= 1) ttp = texp
    242 
    243 !##############################################################################################################################
    244    IF(lInit) THEN
    245       IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
    246    ELSE
    247       CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname)
    248    END IF
    249 !##############################################################################################################################
    250 
    251 !==============================================================================================================================
    252 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.
    253 !==============================================================================================================================
    254231   !---------------------------------------------------------------------------------------------------------------------------
    255232   IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1)
    256233   !---------------------------------------------------------------------------------------------------------------------------
    257    IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac) .AND. lInit) THEN  !=== FOUND OLD STYLE INCA "traceur.def"
     234   IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) &         !=== FOUND OLD STYLE INCA "traceur.def"
     235      CALL abort_physic(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1)
    258236   !---------------------------------------------------------------------------------------------------------------------------
    259 IF (CPPKEY_INCA) THEN
    260       nqo = SIZE(tracers) - nqCO2
    261       CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA
    262       nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
    263       nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
    264       IF(ALL([2,3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
    265       ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
    266       ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
    267       CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
    268       ALLOCATE(ttr(nqtrue))
    269       ttr(1:nqo+nqCO2)                  = tracers
    270       ttr(1    :      nqo   )%component = 'lmdz'
    271       ttr(1+nqo:nqCO2+nqo   )%component = 'co2i'
    272       ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
    273       ttr(1+nqo      :nqtrue)%name      = [('CO2     ', iq=1, nqCO2), solsym_inca]
    274       ttr(1+nqo+nqCO2:nqtrue)%parent    = tran0
    275       ttr(1+nqo+nqCO2:nqtrue)%phase     = 'g'
    276       lerr = getKey('hadv', had, ky=tracers(:)%keys)
    277       lerr = getKey('vadv', vad, ky=tracers(:)%keys)
    278       hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca
    279       vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca
    280       CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    281       DO iq = 1, nqtrue
    282          t1 => tracers(iq)
    283          CALL addKey('name',      t1%name,      t1%keys)
    284          CALL addKey('component', t1%component, t1%keys)
    285          CALL addKey('parent',    t1%parent,    t1%keys)
    286          CALL addKey('phase',     t1%phase,     t1%keys)
    287       END DO
    288       IF(setGeneration(tracers)) CALL abort_physic(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name
    289       DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
    290 END IF
    291    !---------------------------------------------------------------------------------------------------------------------------
    292    ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
    293    !---------------------------------------------------------------------------------------------------------------------------
     237
     238!##############################################################################################################################
     239   IF(lInit) THEN
     240      IF(readTracersFiles(ttp, lRepr=type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
     241   END IF
     242   CALL msg('No tracers description file(s) reading needed: already done', modname, .NOT.lInit.AND.is_master)
     243!##############################################################################################################################
     244
     245!==============================================================================================================================
     246! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.
     247!==============================================================================================================================
    294248   nqtrue = SIZE(tracers)                                                                               !--- "true" tracers
    295249   nqo    =      COUNT(tracers(:)%component == 'lmdz' .AND. &
    … …  
    300254        (delPhase(tracers(:)%gen0Name)     == 'CLDFRA')))
    301255   nqCO2  =      COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
    302 IF (CPPKEY_INCA) THEN
     256   IF(CPPKEY_INCA) &
    303257   nqINCA =      COUNT(tracers(:)%component == 'inca')
    304 END IF
     258   IF(CPPKEY_REPROBUS) CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)     !--- Transfert the number of tracers to Reprobus
     259
     260!==============================================================================================================================
     261! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
     262!==============================================================================================================================
    305263   IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1)
    306264   IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1)
    307    !---------------------------------------------------------------------------------------------------------------------------
    308    END IF
    309    !---------------------------------------------------------------------------------------------------------------------------
    310 
    311 IF (CPPKEY_REPROBUS) THEN
    312    CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)                         !--- Transfert the number of tracers to Reprobus
    313 END IF
    314 
    315 !##############################################################################################################################
    316    IF(lInit) THEN                                                    !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
    317 !##############################################################################################################################
    318 
    319 !==============================================================================================================================
    320 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
    321 !==============================================================================================================================
    322265   DO iq = 1, nqtrue
    323266      IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
    … …  
    336279   END IF
    337280
    338 !==============================================================================================================================
    339 ! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names, nqtot and %isAdvected
     281!##############################################################################################################################
     282   IF(lInit) THEN                                                    !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
     283!##############################################################################################################################
     284
     285!==============================================================================================================================
     286! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot
    340287!==============================================================================================================================
    341288   ALLOCATE(ttr(nqtot))
    342    jq = nqtrue+1; tracers(:)%iadv = -1
     289   jq = nqtrue+1
    343290   DO iq = 1, nqtrue
    344291      t1 => tracers(iq)
    … …  
    351298      IF(iad == -1) CALL abort_physic(modname, msg1, 1)
    352299
    353       !--- SET FIELDS longName, isAdvected, isInPhysics
     300      !--- SET FIELDS longName, isInPhysics
    354301      t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
    355       t1%isAdvected = iad >= 0
    356       !t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O
    357       t1%isInPhysics=((delPhase(t1%gen0Name) /= 'H2O') .AND. &
    358                       (delPhase(t1%gen0Name) /= 'CLDFRA')) .OR. t1%component /= 'lmdz'
     302      t1%isInPhysics= iad >= 0 .AND. (t1%component /= 'lmdz' .OR. &
     303                     ((delPhase(t1%gen0Name) /= 'H2O') .AND. &
     304                      (delPhase(t1%gen0Name) /= 'CLDFRA')))
    359305      ttr(iq)       = t1
    360306
    … …  
    369315      ttr(jq+1:jq+nm)%parent      = [ (TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
    370316      ttr(jq+1:jq+nm)%longName    = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
    371       ttr(jq+1:jq+nm)%isAdvected  = [ (.FALSE., im=1, nm) ]
    372317      ttr(jq+1:jq+nm)%isInPhysics = [ (.FALSE., im=1, nm) ]
    373318      jq = jq + nm
    … …  
    379324   IF(indexUpdate(tracers)) CALL abort_physic(modname, 'problem with tracers indices update', 1)
    380325
    381 !##############################################################################################################################
    382    END IF
    383 !##############################################################################################################################
    384 
    385 !##############################################################################################################################
    386    IF(.NOT.lInit) THEN
    387 !##############################################################################################################################
    388      nqtot = SIZE(tracers)
    389 !##############################################################################################################################
    390    ELSE
    391 !##############################################################################################################################
    392 
    393326   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES
    394327   niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
    … …  
    396329
    397330!##############################################################################################################################
    398    END IF
    399 !##############################################################################################################################
     331   ELSE
     332!##############################################################################################################################
     333   DO iq = 1, nqtrue
     334      t1 => tracers(iq)
     335      IF(hadv(iq)     ==    vadv(iq)    ) iad = hadv(iq)
     336      IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
     337      tracers(iq)%isInPhysics= iad >= 0 .AND. (t1%component /= 'lmdz' .OR. &
     338                     ((delPhase(t1%gen0Name) /= 'H2O') .AND. &
     339                      (delPhase(t1%gen0Name) /= 'CLDFRA')))
     340   END DO
     341!##############################################################################################################################
     342   END IF
     343!##############################################################################################################################
     344
    400345   !--- Convection / boundary layer activation for all tracers
    401346   IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
    … …  
    408353        (delPhase(tracers(:)%gen0Name)     == 'CLDFRA')))
    409354!   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
    410 !   IF(COUNT(tracers%iso_iName == 0) - COUNT(tracers(:)%component == 'lmdz' .AND. &
    411 !       ((delPhase(tracers(:)%name)     == 'H2O') .OR. &
    412 !        (delPhase(tracers(:)%name)     == 'CLDFRA'))) /= nqtottr) &
    413 !      CALL abort_physic(modname, 'problem with the computation of nqtottr', 1)
    414 
    415    !=== DISPLAY THE RESULTS
    416    CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
    417    CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
    418    CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
    419    CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
    420    CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
    421    CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
    422 IF (CPPKEY_INCA) THEN
    423    CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
    424    CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
    425 END IF
    426    t => tracers
    427    CALL msg('Information stored in '//TRIM(modname)//': ', modname)
    428    IF(dispTable('isssssssssiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',     &
    429                        'isPh', 'isAd', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],    &
    430       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component,                          &
    431                                                          bool2str(t%isInPhysics), bool2str(t%isAdvected)), &
    432       cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
    433                   t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
    434       CALL abort_physic(modname, "problem with the tracers table content", 1)
    435    IF(niso > 0) THEN
    436       CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
    437       CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
    438       CALL msg('  isoName = '//strStack(isoName),      modname)
    439       CALL msg('  isoZone = '//strStack(isoZone),      modname)
    440       CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
    441    ELSE
    442       CALL msg('No isotopes identified.', modname)
    443    END IF
    444 
    445 #ifdef ISOVERIF
    446    CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
    447 #endif
    448 IF (CPPKEY_STRATAER) THEN
    449    IF (type_trac == 'coag') THEN
     355   IF(COUNT(tracers%iso_iName == 0) - COUNT(tracers(:)%component == 'lmdz' .AND. &
     356       ((delPhase(tracers(:)%name)     == 'H2O') .OR. &
     357        (delPhase(tracers(:)%name)     == 'CLDFRA'))) /= nqtottr) &
     358      CALL abort_physic(modname, 'problem with the computation of nqtottr', 1)
     359
     360   !--- Compute indices for water
     361   ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
     362   iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
     363   isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
     364   ibs  = strIdx(tracers(:)%name, addPhase('H2O', 'b'))
     365   icf  = strIdx(tracers(:)%name, 'CLDFRA')
     366   iqvc = strIdx(tracers(:)%name, 'CLDVAP_g')
     367   icfa = strIdx(tracers(:)%name, 'CONTFRA')
     368   ipcf = strIdx(tracers(:)%name, 'PERSCONTFRA')
     369   iqva = strIdx(tracers(:)%name, 'CONTWATER_g')
     370   iqia = strIdx(tracers(:)%name, 'CONTWATER_s')
     371
     372   IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN
    450373      nbtr_bin    = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])
    451374      nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])
    … …  
    456379      id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
    457380      id_TEST_strat  = strIdx(tnames, 'GASTEST' )
     381   END IF
     382
     383   !=== DISPLAY THE RESULTS
     384   IF(.NOT.is_master) RETURN
     385   CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
     386   CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
     387   CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
     388   CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
     389   CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
     390   CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
     391   CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname, CPPKEY_INCA)
     392   CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname, CPPKEY_INCA)
     393   t => tracers
     394   CALL msg('Information stored in '//TRIM(modname)//': ', modname)
     395   IF(dispTable('issssssssiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',      &
     396                              'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],     &
     397      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
     398      cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
     399                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
     400      CALL abort_physic(modname, "problem with the tracers table content", 1)
     401   CALL msg('No isotopes identified.', modname, nbIso == 0)
     402   IF(nbIso == 0) RETURN
     403   CALL msg('For isotopes family "H2O":', modname)
     404   CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
     405   CALL msg('  isoName = '//strStack(isoName),      modname)
     406   CALL msg('  isoZone = '//strStack(isoZone),      modname)
     407   CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
     408
     409   IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN
    458410      CALL msg('nbtr_bin       ='//TRIM(int2str(nbtr_bin      )), modname)
    459411      CALL msg('nbtr_sulgas    ='//TRIM(int2str(nbtr_sulgas   )), modname)
    … …  
    464416      CALL msg('id_TEST_strat  ='//TRIM(int2str(id_TEST_strat )), modname)
    465417   END IF
    466 END IF
    467    CALL msg('end', modname)
    468418
    469419END SUBROUTINE init_infotrac_phy

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/iophy.F90

    r5536 r5618  
    1212  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nptabij
    1313  INTEGER, SAVE :: itau_iophy
     14  !! WARNING, only itau_iophy needs to be put in a THREADPRIVATE statement,
     15  !!          io_lat,io_lon,phys_domain_id,npstn,nptabij are shared between OMP tasks
    1416  LOGICAL :: check_dim = .false.
    15 
    1617!$OMP THREADPRIVATE(itau_iophy)
    1718
    … …  
    972973  REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
    973974  logical, save :: is_active = .true.
     975  !! WARNING, is_active is shared between OMP tasks and should not be put in a THREADPRIVATE statement
    974976
    975977  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/iophys.F90

    r5536 r5618  
    110110
    111111!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    112       SUBROUTINE iophys_ini(timestep)
     112      SUBROUTINE iophys_ini(timestep,nlev)
     113      USE dimphy, ONLY: klev
    113114      USE mod_phys_lmdz_para, ONLY: is_mpi_root
    114115      USE vertical_layers_mod, ONLY: presnivs
    115116      USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
    116       USE dimphy, ONLY: klev
    117117      USE mod_grid_phy_lmdz, ONLY: klon_glo
    118118      USE time_phylmdz_mod, ONLY : annee_ref, day_ref, day_ini
    … …  
    139139!   -------------
    140140
     141integer, intent(in) :: nlev
     142real, intent(in) :: timestep
     143
    141144real pi
    142145INTEGER nlat_eff
    143146INTEGER jour0,mois0,an0
    144 REAL timestep,t0
     147REAL t0
    145148CHARACTER(len=20) :: calendrier
     149integer ilev
     150real coord_vert(nlev)
    146151
    147152!   Arguments:
    … …  
    178183print*,'iophys_ini annee_ref day_ref',annee_ref,day_ref,day_ini,calend,t0
    179184
    180 
     185if ( nlev == klev ) then
     186     coord_vert=presnivs
     187print*,'ON EST LA '
     188else
     189     do ilev=1,nlev
     190        coord_vert(ilev)=ilev
     191     enddo
     192endif
     193print*,'nlev=',nlev
     194print*,'coord_vert',coord_vert
    181195call iotd_ini('phys.nc', &
    182 size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs,jour0,mois0,an0,t0,timestep,calendrier)
     196size(lon_reg),nlat_eff,nlev,lon_reg(:)*180./pi,lat_reg*180./pi,coord_vert,jour0,mois0,an0,t0,timestep,calendrier)
     197 !  SUBROUTINE iotd_ini(fichnom,iim,jjm,llm,prlon,prlat,pcoordv,jour0,mois0,an0,t0,timestep,calendrier)
     198!   -------
    183199    ENDIF
    184200!$OMP END MASTER
    … …  
    216232
    217233      SUBROUTINE iotd_ecrit_seq(nom,lllm,titre,unite,px)
     234!call iotd_ecrit_seq('f0',1,'f0 in thermcell_plume_6A',' ',f0(1:ngrid))
     235
    218236        USE iotd_mod_h
    219237
    … …  
    230248      integer i,j,l,ijl
    231249
     250      !print*,'iotd_ecrit_seq ,nom,lllm,titre,unite,px',nom,lllm,titre,unite,px
    232251      allocate(zx(imax,jmax,lllm))
    233252

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/iostart.f90

    r5536 r5618  
    22
    33PRIVATE
     4    ! WARNING the following variables, though SAVED, should not be put in a THREADPRIVATE statement
    45    INTEGER,SAVE :: nid_start
    56    INTEGER,SAVE :: nid_restart
    6    
    77    INTEGER,SAVE :: idim1,idim2,idim3,idim4
     8
    89    INTEGER,PARAMETER :: length=100
    910   

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/iotd_ecrit.f90

    r5536 r5618  
    5555! Ajouts
    5656      integer, save :: ntime=0
     57      !$OMP THREADPRIVATE(ntime)
    5758      integer :: idim,varid
    5859      character (len =50):: fichnom

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop.f90

    r5609 r5618  
    356356            dei = rei_coef * (iwc**0.2445) * ( temp(i,k) - rei_min_temp )
    357357            ! we clip the results
    358             !deimin = 20.
     358            deimin = 20.
    359359            deimax = 155.
    360             !dei = MIN(MAX(dei, deimin), deimax)
    361             dei = MIN(dei, deimax)
     360            dei = MIN(MAX(dei, deimin), deimax)
    362361            ! formula to convert effective diameter in effective radius
    363362            rei = 3. * SQRT(3.) / 8. * dei
    364             rei = MAX(rei, rei_min)
    365363          ELSEIF (iflag_rei .EQ. 1) THEN
    366364            ! when we account for precipitation in the radiation scheme,
    … …  
    472470        ! Calculation of ice cloud effective radius in micron
    473471
     472
    474473        IF (iflag_rei .EQ. 2) THEN
    475474            ! in-cloud ice water content in g/m3
    … …  
    486485            dei = rei_coef * (iwc**0.2445) * ( temp(i,k) - rei_min_temp )
    487486            ! we clip the results
    488             !deimin = 20.
     487            deimin = 20.
    489488            deimax = 155.
    490             !dei = MIN(MAX(dei, deimin), deimax)
    491             dei = MIN(dei, deimax)
     489            dei = MIN(MAX(dei, deimin), deimax)
    492490            ! formula to convert effective diameter to effective radius
    493491            rei = 3. * SQRT(3.) / 8. * dei
    494             rei = MAX(rei, rei_min)
    495            
     492
    496493        ELSEIF (iflag_rei .EQ. 1) THEN
    497494            ! when we account for precipitation in the radiation scheme,

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_cloudth.f90

    r5536 r5618  
    6969      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid)
    7070      REAL zqs(ngrid), qcloud(ngrid)
    71       REAL erf
    7271
    7372
    … …  
    9190! Initialisation des variables r?elles
    9291!-------------------------------------------------------------------------------
    93       sigma1(:,:)=0.
    94       sigma2(:,:)=0.
    95       qlth(:,:)=0.
    96       qlenv(:,:)=0. 
    97       qltot(:,:)=0.
    98       rneb(:,:)=0.
     92      sigma1(:,ind2)=0.
     93      sigma2(:,ind2)=0.
     94      qlth(:,ind2)=0.
     95      qlenv(:,ind2)=0. 
     96      qltot(:,ind2)=0.
     97      rneb(:,ind2)=0.
    9998      qcloud(:)=0.
    100       cth(:,:)=0.
    101       cenv(:,:)=0.
    102       ctot(:,:)=0.
     99      cth(:,ind2)=0.
     100      cenv(:,ind2)=0.
     101      ctot(:,ind2)=0.
    103102      qsatmmussig1=0.
    104103      qsatmmussig2=0.
    … …  
    317316      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid)
    318317      REAL zqs(ngrid), qcloud(ngrid)
    319       REAL erf
    320318
    321319!------------------------------------------------------------------------------
    322320! Initialisation des variables r?elles
    323321!------------------------------------------------------------------------------
    324       sigma1(:,:)=0.
    325       sigma2(:,:)=0.
    326       qlth(:,:)=0.
    327       qlenv(:,:)=0. 
    328       qltot(:,:)=0.
    329       rneb(:,:)=0.
     322      sigma1(:,ind2)=0.
     323      sigma2(:,ind2)=0.
     324      qlth(:,ind2)=0.
     325      qlenv(:,ind2)=0. 
     326      qltot(:,ind2)=0.
     327      rneb(:,ind2)=0.
    330328      qcloud(:)=0.
    331       cth(:,:)=0.
    332       cenv(:,:)=0.
    333       ctot(:,:)=0.
     329      cth(:,ind2)=0.
     330      cenv(:,ind2)=0.
     331      ctot(:,ind2)=0.
    334332      qsatmmussig1=0.
    335333      qsatmmussig2=0.
    … …  
    644642      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
    645643      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid)
    646       REAL erf
    647644
    648645
    … …  
    663660! Initialisation des variables r?elles
    664661!-------------------------------------------------------------------------------
    665       sigma1(:,:)=0.
    666       sigma2(:,:)=0.
    667       qlth(:,:)=0.
    668       qlenv(:,:)=0. 
    669       qltot(:,:)=0.
    670       rneb(:,:)=0.
     662      sigma1(:,ind2)=0.
     663      sigma2(:,ind2)=0.
     664      qlth(:,ind2)=0.
     665      qlenv(:,ind2)=0. 
     666      qltot(:,ind2)=0.
     667      rneb(:,ind2)=0.
    671668      qcloud(:)=0.
    672       cth(:,:)=0.
    673       cenv(:,:)=0.
    674       ctot(:,:)=0.
    675       cth_vol(:,:)=0.
    676       cenv_vol(:,:)=0.
    677       ctot_vol(:,:)=0.
     669      cth(:,ind2)=0.
     670      cenv(:,ind2)=0.
     671      ctot(:,ind2)=0.
     672      cth_vol(:,ind2)=0.
     673      cenv_vol(:,ind2)=0.
     674      ctot_vol(:,ind2)=0.
    678675      qsatmmussig1=0.
    679676      qsatmmussig2=0.
    … …  
    878875      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid)
    879876      REAL zqs(ngrid), qcloud(ngrid)
    880       REAL erf
    881877
    882878      REAL rhodz(ngrid,klev)
    … …  
    895891!------------------------------------------------------------------------------
    896892
    897       sigma1(:,:)=0.
    898       sigma2(:,:)=0.
    899       qlth(:,:)=0.
    900       qlenv(:,:)=0. 
    901       qltot(:,:)=0.
    902       rneb(:,:)=0.
     893      sigma1(:,ind2)=0.
     894      sigma2(:,ind2)=0.
     895      qlth(:,ind2)=0.
     896      qlenv(:,ind2)=0. 
     897      qltot(:,ind2)=0.
     898      rneb(:,ind2)=0.
    903899      qcloud(:)=0.
    904       cth(:,:)=0.
    905       cenv(:,:)=0.
    906       ctot(:,:)=0.
    907       cth_vol(:,:)=0.
    908       cenv_vol(:,:)=0.
    909       ctot_vol(:,:)=0.
     900      cth(:,ind2)=0.
     901      cenv(:,ind2)=0.
     902      ctot(:,ind2)=0.
     903      cth_vol(:,ind2)=0.
     904      cenv_vol(:,ind2)=0.
     905      ctot_vol(:,ind2)=0.
    910906      qsatmmussig1=0.
    911907      qsatmmussig2=0.
    … …  
    13061302      REAL qcloud(ngrid) !eau totale dans le nuage
    13071303        !Some arithmetic variables
    1308       REAL erf,pi,sqrt2,sqrt2pi
     1304      REAL  pi,sqrt2,sqrt2pi
    13091305        !Depth of the layer
    13101306      REAL dz(ngrid,klev)    !epaisseur de la couche en metre
    … …  
    13201316! Initialization
    13211317!------------------------------------------------------------------------------
    1322       qlth(:,:)=0.
    1323       qlenv(:,:)=0. 
    1324       qltot(:,:)=0.
    1325       cth_vol(:,:)=0.
    1326       cenv_vol(:,:)=0.
    1327       ctot_vol(:,:)=0.
    1328       cth_surf(:,:)=0.
    1329       cenv_surf(:,:)=0.
    1330       ctot_surf(:,:)=0.
     1318      qlth(:,ind2)=0.
     1319      qlenv(:,ind2)=0. 
     1320      qltot(:,ind2)=0.
     1321      cth_vol(:,ind2)=0.
     1322      cenv_vol(:,ind2)=0.
     1323      ctot_vol(:,ind2)=0.
     1324      cth_surf(:,ind2)=0.
     1325      cenv_surf(:,ind2)=0.
     1326      ctot_surf(:,ind2)=0.
    13311327      qcloud(:)=0.
    13321328      rdd=287.04
    … …  
    15791575      REAL qlbef
    15801576      REAL dqsatenv(klon), dqsatth(klon)
    1581       REAL erf
    15821577      REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
    15831578      REAL zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_cv_ini.f90

    r5348 r5618  
    1313          delta, betad, ejectliq, ejectice, flag_wb, flag_epKEorig, cv_flag_feed, noff, minorig, &
    1414          nl, nlp, nlm
    15   PUBLIC cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0, clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl  &
    16           , clmci, eps, epsi, epsim1, ginv, hrd, grav
     15  PUBLIC cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0, clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl,  &
     16          clmci, eps, epsi, epsim1, ginv, hrd, grav, keep_bug_indices_cv3_tracer, &
     17          keep_bug_q_nocons_cv
    1718
    1819
    … …  
    6970  !$OMP          , dtmax, cu, damp)
    7071
     72LOGICAL keep_bug_indices_cv3_tracer
     73 !$OMP THREADPRIVATE( keep_bug_indices_cv3_tracer)
     74LOGICAL keep_bug_q_nocons_cv
     75 !$OMP THREADPRIVATE( keep_bug_q_nocons_cv)
     76
    7177END MODULE lmdz_cv_ini

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp.f90

    r5615 r5618  
    937937                ! following line is very strange and probably wrong
    938938                rhcl(i,k)= (zqs(i)+zq(i))/2./zqs(i)
     939                ! Correct calculation of clear-sky relative humidity. To activate once
     940                ! issues related to zqn>zq in bi-gaussian clouds are corrected
     941                !--Relative humidity (no unit) in clear sky, calculated as rh = q / qsat
     942                !--This is slighly approximated, the actual formula is
     943                !-- rh = q / qsat * (eps + (1-eps)*qsat) / (eps + (1-eps)*q)
     944                !--Here, rh = (qtot - qincld * cldfra) / clrfra / qsat
     945                !--where (qtot - qincld * cldfra) is the grid-mean clear sky water content
     946                ! rhcl(i,k) = ( zq(i) - qincloud_mpc(i) * rneb(i,k) ) / ( 1. - rneb(i,k) ) / zqs(i)
    939947                ! water vapor update and partition function if thermals
    940948                zq(i) = zq(i) - zcond(i)       
    … …  
    966974                      zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
    967975                    ENDIF
    968                     ! following line is very strange and probably wrong:
    969                     rhcl(i,k)=(zqs(i)+zq(i))/2./zqs(i)
    970976                    ! Overwrite partitioning for non shallow-convective clouds if iflag_icefrac>1 (icefrac turb param)
    971977                    IF (iflag_icefrac .GE. 1) THEN
    … …  
    973979                           zcond(i)  = zqliq(i) + zqice(i)
    974980                           zfice(i)  = zfice_turb(i)
    975                            rhcl(i,k) = zqvapcl(i) * rneb(i,k) + (zq(i) - zqn(i)) * (1.-rneb(i,k))
    976981                        ENDIF
    977982                    ENDIF
     983
     984                    ! following line is very strange and probably wrong
     985                    rhcl(i,k)= (zqs(i)+zq(i))/2./zqs(i)
     986                    ! Correct calculation of clear-sky relative humidity. To activate once
     987                    ! issues related to zqn>zq in bi-gaussian clouds are corrected
     988                    !--Relative humidity (no unit) in clear sky, calculated as rh = q / qsat
     989                    !--This is slighly approximated, the actual formula is
     990                    !-- rh = q / qsat * (eps + (1-eps)*qsat) / (eps + (1-eps)*q)
     991                    !--Here, rh = (qtot - qincld * cldfra) / clrfra / qsat
     992                    !--where (qtot - qincld * cldfra) is the grid-mean clear sky water content
     993                    ! rhcl(i,k) = ( zq(i) - zqn(i) * rneb(i,k) ) / ( 1. - rneb(i,k) ) / zqs(i)
     994                    ! Overwrite partitioning for non shallow-convective clouds if iflag_icefrac>1 (icefrac turb param)
     995
    978996                ENDIF
    979997

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_old.f90

    r5536 r5618  
    33!
    44MODULE lmdz_lscp_old
     5  PRIVATE
     6
     7  INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation
     8  LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle
     9  REAL, PARAMETER :: t_coup=234.0
     10  REAL, PARAMETER :: DDT0=.01
     11  REAL, PARAMETER :: ztfondue=278.15
     12
     13  LOGICAL, SAVE :: appel1er=.TRUE.
     14  !$OMP THREADPRIVATE(appel1er)
     15 
     16  PUBLIC fisrtilp_first, fisrtilp
     17
    518CONTAINS
     19
     20! firstilp first call part
     21SUBROUTINE fisrtilp_first(klon, klev, dtime, pfrac_nucl, pfrac_1nucl, pfrac_impa)
     22USE lmdz_lscp_ini, ONLY: prt_level, lunout
     23IMPLICIT NONE
     24  REAL, INTENT(IN)     :: dtime  ! intervalle du temps (s)
     25  INTEGER, INTENT(IN)  :: klon, klev
     26  INTEGER :: i, k
     27
     28  !AA
     29  ! Coeffients de fraction lessivee : pour OFF-LINE
     30  !
     31  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfrac_nucl
     32  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfrac_1nucl
     33  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfrac_impa
     34
     35  IF (appel1er) THEN
     36    WRITE(lunout,*) 'fisrtilp, ninter:', ninter
     37    WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
     38    WRITE(lunout,*) 'FISRTILP VERSION LUDO'
     39     
     40    IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
     41     WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
     42     WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'
     43     !         CALL abort
     44    ENDIF
     45    !
     46    !cdir collapse
     47    DO k = 1, klev
     48      DO i = 1, klon
     49        pfrac_nucl(i,k)=1.
     50        pfrac_1nucl(i,k)=1.
     51        pfrac_impa(i,k)=1.
     52      ENDDO
     53    ENDDO
     54    appel1er = .FALSE.
     55  ENDIF
     56 
     57END SUBROUTINE fisrtilp_first
     58
    659SUBROUTINE fisrtilp(klon,klev,dtime,paprs,pplay,t,q,ptconv,ratqs,sigma_qtherm, &
    760     d_t, d_q, d_ql, d_qi, rneb,rneblsvol,radliq, rain, snow,          &
    … …  
    117170  REAL :: smallestreal
    118171
    119   INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation
    120   LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle
    121   REAL, PARAMETER :: t_coup=234.0
    122   REAL, PARAMETER :: DDT0=.01
    123   REAL, PARAMETER :: ztfondue=278.15
    124   ! --------------------------------------------------------------------------------
     172 ! --------------------------------------------------------------------------------
    125173  !
    126174  ! Variables locales:
    … …  
    142190
    143191  REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta, Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2, qcloud
    144   REAL :: erf   
    145192 
    146193  REAL :: zqev, zqevt, zqev0,zqevi, zqevti, zdelq
    … …  
    165212  REAL, DIMENSION(klon) :: zmqc
    166213  !
    167   LOGICAL, SAVE :: appel1er=.TRUE.
    168   !$OMP THREADPRIVATE(appel1er)
    169214  !
    170215! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max
    … …  
    196241  REAL, DIMENSION(klon) :: zlh_solid
    197242  REAL :: zm_solid
     243  REAL :: tmp_var1d(klon) ! temporary variable for call site
    198244
    199245
    … …  
    218264
    219265  if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM'
    220   IF (appel1er) THEN
    221      WRITE(lunout,*) 'fisrtilp, ninter:', ninter
    222      WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
    223      WRITE(lunout,*) 'FISRTILP VERSION LUDO'
    224      
    225      IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
    226         WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
    227         WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'
    228         !         CALL abort
    229      ENDIF
    230      appel1er = .FALSE.
    231      !
    232      !cdir collapse
    233      DO k = 1, klev
    234         DO i = 1, klon
    235            pfrac_nucl(i,k)=1.
    236            pfrac_1nucl(i,k)=1.
    237            pfrac_impa(i,k)=1.
    238            beta(i,k)=0.  !RomP initialisation
    239         ENDDO
    240      ENDDO
    241 
    242   ENDIF          !  test sur appel1er
     266
     267  beta(:,:)=0.  !RomP initialisation => ym : could be probably removed but keept by security
     268
    243269  !
    244270  !MAf Initialisation a 0 de zoliq
    … …  
    954980                 ! --------------------------
    955981                 if (iflag_t_glace.ge.1) then
    956                  CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
     982                   tmp_var1d(:) = pplay(:,k)/paprs(:,1)
     983                   CALL icefrac_lsc(klon, zt(:), tmp_var1d, zfice(:))
    957984                 endif
    958985
    … …  
    11231150     ELSE
    11241151         if (iflag_t_glace.ge.1) then
    1125             CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
     1152            tmp_var1d(:) = pplay(:,k)/paprs(:,1)
     1153            CALL icefrac_lsc(klon,zt(:),tmp_var1d,zfice(:))
    11261154         endif
    11271155         if (iflag_fisrtilp_qsat.lt.1) then
    … …  
    12421270         ENDDO
    12431271       ELSE ! of IF (iflag_t_glace.EQ.0)
    1244          CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:))
     1272         tmp_var1d(:) = pplay(:,k)/paprs(:,1)
     1273         CALL icefrac_lsc(klon,zt(:), tmp_var1d, zfice(:))
    12451274!         DO i = 1, klon
    12461275!            IF (rneb(i,k).GT.0.0) THEN

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_surf_wind.f90

    r5537 r5618  
    22        CONTAINS
    33
    4 SUBROUTINE surf_wind(klon,nsrfwnd,zu10m,zv10m,sigmaw,cstar,ustar,wstar,wind10ms,probu)
     4SUBROUTINE surf_wind(klon,nsurfwind,zu10m,zv10m,sigmaw,cstar,ustar,wstar,wind10ms,probu)
    55
    66USE lmdz_surf_wind_ini, ONLY : iflag_surf_wind
    77
    88IMPLICIT NONE
    9 INTEGER, INTENT(IN)                :: nsrfwnd, klon
     9INTEGER, INTENT(IN)                :: nsurfwind, klon
    1010REAL, DIMENSION(klon), INTENT(IN)  :: zu10m, zv10m
    1111REAL, DIMENSION(klon), INTENT(IN)  :: cstar
    1212REAL, DIMENSION(klon), INTENT(IN)  :: sigmaw
    1313REAL, DIMENSION(klon), INTENT(IN)  :: ustar, wstar
    14 REAL, DIMENSION(klon,nsrfwnd), INTENT(OUT)         :: wind10ms, probu
     14REAL, DIMENSION(klon,nsurfwind), INTENT(OUT)         :: wind10ms, probu
    1515
    1616
    17 REAL, DIMENSION(klon,nsrfwnd)         :: sigma_th, sigma_wk
    18 REAL, DIMENSION(klon,nsrfwnd)         :: xp, yp, zz
    19 REAL, DIMENSION(klon,nsrfwnd)         :: vwx, vwy, vw
    20 REAL, DIMENSION(klon,nsrfwnd)         :: vtx, vty
    21 REAL, DIMENSION(klon,nsrfwnd)         :: windx, windy, wind
     17REAL, DIMENSION(klon,nsurfwind)         :: sigma_th, sigma_wk
     18REAL, DIMENSION(klon,nsurfwind)         :: xp, yp, zz
     19REAL, DIMENSION(klon,nsurfwind)         :: vwx, vwy, vw
     20REAL, DIMENSION(klon,nsurfwind)         :: vtx, vty
     21REAL, DIMENSION(klon,nsurfwind)         :: windx, windy, wind
    2222REAL, DIMENSION(klon)                 :: ubwk, vbwk      ! ubwk et vbwk sont les vitesses moyennes dans les poches
    2323REAL, DIMENSION(klon)                 :: weilambda, U10mMOD
    … …  
    3030REAL    :: ktwk, ktth, kzth
    3131
    32 !print*,'LLLLLLLLLLLLLLLLLLLLL nsrfwnd=',nsrfwnd
     32!print*,'LLLLLLLLLLLLLLLLLLLLL nsurfwind=',nsurfwind
    3333pi=2.*acos(0.)
    3434ray=7000.
    … …  
    3737kzth=1.
    3838kref=3
    39 nwb=nsrfwnd
     39nwb=nsurfwind
    4040
    4141ubwk(klon) = zu10m(klon)
    … …  
    5353IF (iflag_surf_wind == 0) THEN
    5454    !U10mMOD=sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
    55     IF (nsrfwnd /= 1 ) THEN
    56             STOP 'Si iflag_surf_wind=0, nsrfwnd=1'
     55    IF (nsurfwind /= 1 ) THEN
     56            STOP 'Si iflag_surf_wind=0, nsurfwind=1'
    5757    ENDIF
    5858    DO i=1,klon
    … …  
    6666
    6767    DO i=1, klon
    68         DO nmc=1, nsrfwnd
     68        DO nmc=1, nsurfwind
    6969             ! Utilisation de la distribution de weibull
    7070             !U10mMOD=sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
    … …  
    9090
    9191    DO i=1, klon
    92         DO nmc=1, nsrfwnd
     92        DO nmc=1, nsurfwind
    9393            ! Utilisation de la distribution du vent a l interieur et a l exterieur des poches
    9494            call Random_number(zz)     ! tirage uniforme entre 0 et 1.
    … …  
    122122                  wind(i,nmc) = sqrt(windx(i,nmc)**2 + windy(i,nmc)**2)
    123123                  wind10ms(i,nmc) = wind(i,nmc)
    124                   probu(i,nmc) = wind(i,nmc)/nsrfwnd
     124                  probu(i,nmc) = wind(i,nmc)/nsurfwind
    125125
    126126            ELSE
    … …  
    143143                  wind(i,nmc) = sqrt(windx(i,nmc)**2 + windy(i,nmc)**2)
    144144                  wind10ms(i,nmc) = wind(i,nmc)
    145                   probu(i,nmc) = wind(i,nmc)/nsrfwnd
     145                  probu(i,nmc) = wind(i,nmc)/nsurfwind
    146146                  ! print*, 'wind10ms', wind10ms(i,nmc)         
    147147            ENDIF

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_down.f90

    r5390 r5618  
    4343   integer ig,ilay
    4444   real, dimension(ngrid,nlay):: s1,s2,num !coefficients pour la resolution implicite
    45    integer :: iflag_impl=1 ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement
    46    
     45   integer :: iflag_impl ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement
     46 
    4747   fdn(:,:)=0.
    4848   fup(:,:)=0.
    … …  
    5959   s2(:,:)=0.
    6060   num(:,:)=1.
     61   
     62   iflag_impl=1 ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement
    6163
    6264   if ( iflag_thermals_down < 10 ) then

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_dq.f90

    r5450 r5618  
    3838
    3939      integer niter,iter
    40       CHARACTER (LEN=20) :: modname='thermcell_dq'
     40      CHARACTER (LEN=20), PARAMETER :: modname='thermcell_dq'
    4141      CHARACTER (LEN=80) :: abort_message
    4242
    … …  
    190190      real ztimestep
    191191      integer niter,iter
    192       CHARACTER (LEN=20) :: modname='thermcell_dq'
     192      CHARACTER (LEN=20), PARAMETER :: modname='thermcell_dq'
    193193      CHARACTER (LEN=80) :: abort_message
    194194

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_dry.f90

    r5390 r5618  
    3333       REAL linter(ngrid),zlevinter(ngrid)
    3434       INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid)
    35       CHARACTER (LEN=20) :: modname='thermcell_dry'
    36       CHARACTER (LEN=80) :: abort_message
     35       CHARACTER (LEN=20), PARAMETER :: modname='thermcell_dry'
     36       CHARACTER (LEN=80) :: abort_message
    3737       INTEGER l,ig
    3838

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_env.f90

    r5390 r5618  
    5151! Calcul de l'humidite a saturation et de la condensation
    5252
    53    call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
     53   call thermcell_qsat(ngrid, nlay,mask,pplev,pt,po,pqsat)
    5454   do ll=1,nlay
    5555      do ig=1,ngrid

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_flux2.f90

    r5390 r5618  
    1616!---------------------------------------------------------------------------
    1717
    18       USE lmdz_thermcell_ini, ONLY : prt_level,iflag_thermals_optflux
     18      USE lmdz_thermcell_ini, ONLY : prt_level,iflag_thermals_optflux, thermals_fomass_max, thermals_alphamax
    1919      IMPLICIT NONE
    2020     
    … …  
    4848      REAL f_old,ddd0,eee0,ddd,eee,zzz
    4949
    50       REAL,SAVE :: fomass_max=0.5
    51       REAL,SAVE :: alphamax=0.7
    52 !$OMP THREADPRIVATE(fomass_max,alphamax)
    53 
    5450      logical check_debug,labort_physic
    5551
    56       character (len=20) :: modname='thermcell_flux2'
     52      character (len=20), PARAMETER :: modname='thermcell_flux2'
    5753      character (len=80) :: abort_message
    5854
    … …  
    391387        do ig=1,ngrid
    392388           if (zw2(ig,l+1).gt.1.e-10) then
    393            zfm=rhobarz(ig,l+1)*zw2(ig,l+1)*alphamax
     389           zfm=rhobarz(ig,l+1)*zw2(ig,l+1)*thermals_alphamax
    394390           if ( fm(ig,l+1) .gt. zfm) then
    395391              f_old=fm(ig,l+1)
    … …  
    430426            eee0=entr(ig,l)
    431427            ddd0=detr(ig,l)
    432             eee=entr(ig,l)-masse(ig,l)*fomass_max/ptimestep
     428            eee=entr(ig,l)-masse(ig,l)*thermals_fomass_max/ptimestep
    433429            ddd=detr(ig,l)-eee
    434430            if (eee.gt.0.) then
    … …  
    470466                         print*,'detr',detr(ig,l)
    471467                         print*,'masse',masse(ig,l)
    472                          print*,'fomass_max',fomass_max
    473                          print*,'masse(ig,l)*fomass_max/ptimestep',masse(ig,l)*fomass_max/ptimestep
     468                         print*,'thermal_fomass_max',thermals_fomass_max
     469                         print*,'masse(ig,l)*fomass_max/ptimestep',masse(ig,l)*thermals_fomass_max/ptimestep
    474470                         print*,'ptimestep',ptimestep
    475471                         print*,'lmax(ig)',lmax(ig)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_ini.f90

    r5450 r5618  
    11MODULE lmdz_thermcell_ini
     2  USE strings_mod, ONLY : maxlen
    23
    34IMPLICIT NONE
    … …  
    3435integer, protected :: thermals_flag_alim=0       !
    3536integer, protected :: iflag_thermals_tenv=0      !
     37real,    protected :: thermals_fomass_max=0.5    ! Limitation du "vidage" des mailles sur un pas de temps 'thermcell_flux2'
     38real,    protected :: thermals_alphamax=0.7      ! fraction max des thermiques dans 'thermcell_flux2'
    3639
    3740   ! WARNING !!! fact_epsilon is not protected. It can be modified in thermcell_plume*
    … …  
    4750!$OMP THREADPRIVATE(detr_min, entr_min, detr_q_coef, detr_q_power)
    4851!$OMP THREADPRIVATE( mix0, thermals_flag_alim)
    49 !$OMP THREADPRIVATE(iflag_thermals_tenv)
     52!$OMP THREADPRIVATE(thermals_fomass_max)
     53!$OMP THREADPRIVATE(thermals_alphamax)
    5054
    5155integer, protected       :: thermals_subsid_advect_more_than_one=1
    52 character*6, protected :: thermals_subsid_advect_scheme = 'upwind' ! or 'center'
     56character(LEN=maxlen), protected :: thermals_subsid_advect_scheme = 'upwind' ! or 'center'
    5357
    5458!$OMP THREADPRIVATE(thermals_subsid_advect_scheme,thermals_subsid_advect_more_than_one)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_main.F90

    r5390 r5618  
    140140
    141141
    142       integer,save :: igout=1
    143 !$OMP THREADPRIVATE(igout)
    144       integer,save :: lunout1=6
    145 !$OMP THREADPRIVATE(lunout1)
    146       integer,save :: lev_out=10
    147 !$OMP THREADPRIVATE(lev_out)
     142      integer, parameter :: igout=1
     143      integer, parameter :: lunout1=6
     144      integer, parameter :: lev_out=10
    148145
    149146      real lambda, zf,zf2,var,vardiff,CHI
    … …  
    166163      logical, dimension(ngrid,nlay) :: mask
    167164
    168       character (len=20) :: modname='thermcell_main'
     165      character (len=20), parameter :: modname='thermcell_main'
    169166      character (len=80) :: abort_message
    170167
    … …  
    191188       sorties=.true.
    192189      IF(ngrid.NE.ngrid) THEN
    193          PRINT*
    194190         PRINT*,'STOP dans convadj'
    195191         PRINT*,'ngrid    =',ngrid
    … …  
    240236        !    SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
    241237        ! &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out)
    242         ! contenu thermcell_env : call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
     238        ! contenu thermcell_env : call thermcell_qsat(ngrid, nlay,mask,pplev,pt,po,pqsat)
    243239        ! contenu thermcell_env : do ll=1,nlay
    244240        ! contenu thermcell_env :    do ig=1,ngrid
    … …  
    272268            enddo
    273269        enddo
    274         call thermcell_qsat(ngrid*nlay,mask,pplev,ptemp_env,p_o,zqsat)
     270        call thermcell_qsat(ngrid, nlay, mask,pplev,ptemp_env,p_o,zqsat)
    275271         
    276272      endif

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_old.f90

    r5450 r5618  
    5252  REAL fraca(ngrid, nlay+1), zw2(ngrid, nlay+1)
    5353
    54   INTEGER, SAVE :: idetr = 3, lev_out = 1
    55   !$OMP THREADPRIVATE(idetr,lev_out)
     54  INTEGER :: idetr, lev_out
    5655
    5756  ! local:
    5857  ! ------
    5958
    60   INTEGER, SAVE :: dvdq = 0, flagdq = 0, dqimpl = 1
    61   LOGICAL, SAVE :: debut = .TRUE.
    62   !$OMP THREADPRIVATE(dvdq,flagdq,debut,dqimpl)
     59  INTEGER :: dvdq, flagdq, dqimpl
     60  LOGICAL :: debut
     61
    6362
    6463  INTEGER ig, k, l, lmax(klon, klev+1), lmaxa(klon), lmix(klon)
    … …  
    117116  EXTERNAL scopy
    118117
    119   INTEGER ncorrec, ll
    120   SAVE ncorrec
    121   DATA ncorrec/0/
    122   !$OMP THREADPRIVATE(ncorrec)
     118  INTEGER ll
    123119
    124120
    … …  
    126122  ! initialisation:
    127123  ! ---------------
     124
     125idetr=3
     126lev_out=1
    128127
    129128  sorties = .TRUE.
    … …  
    174173  ! -----------------------------------------------------------------------
    175174
    176   IF (debut) THEN
    177     flagdq = (iflag_thermals-1000)/100
    178     dvdq = (iflag_thermals-(1000+flagdq*100))/10
    179     IF (flagdq==2) dqimpl = -1
    180     IF (flagdq==3) dqimpl = 1
    181     debut = .FALSE.
    182   END IF
    183   PRINT *, 'TH flag th ', iflag_thermals, flagdq, dvdq, dqimpl
     175  flagdq = (iflag_thermals-1000)/100
     176  dvdq = (iflag_thermals-(1000+flagdq*100))/10
     177  IF (flagdq==2) dqimpl = -1
     178  IF (flagdq==3) dqimpl = 1
     179  !PRINT *, 'TH flag th ', iflag_thermals, flagdq, dvdq, dqimpl
    184180
    185181  DO l = 2, nlay
    … …  
    764760
    765761  INTEGER idetr
    766   SAVE idetr
    767   DATA idetr/3/
    768   !$OMP THREADPRIVATE(idetr)
    769762
    770763  ! local:
    … …  
    778771  REAL zmix(klon), fracazmix(klon)
    779772  REAL alpha
    780   SAVE alpha
    781   DATA alpha/1./
    782   !$OMP THREADPRIVATE(alpha)
    783773
    784774  ! RC
    … …  
    890880  REAL f_old
    891881  REAL zlevinter(klon)
    892   LOGICAL, SAVE :: first = .TRUE.
     882  LOGICAL,SAVE :: first = .TRUE.
    893883  !$OMP THREADPRIVATE(first)
    894884  ! data first /.false./
    … …  
    915905  EXTERNAL scopy
    916906
    917   INTEGER ncorrec, ll
    918   SAVE ncorrec
    919   DATA ncorrec/0/
    920   !$OMP THREADPRIVATE(ncorrec)
    921 
    922 
     907  INTEGER ll
     908
     909
     910  idetr=3
     911  alpha=1.
    923912
    924913  ! -----------------------------------------------------------------------
    … …  
    23652354
    23662355  INTEGER idetr
    2367   SAVE idetr
    2368   DATA idetr/3/
    2369   !$OMP THREADPRIVATE(idetr)
    23702356
    23712357  ! local:
    … …  
    24592445  EXTERNAL scopy
    24602446
    2461   INTEGER ncorrec, ll
    2462   SAVE ncorrec
    2463   DATA ncorrec/0/
    2464   !$OMP THREADPRIVATE(ncorrec)
     2447  INTEGER ll
    24652448
    24662449
    … …  
    24702453  ! ---------------
    24712454
     2455  idetr=3
    24722456  sorties = .TRUE.
    24732457  IF (ngrid/=klon) THEN
    … …  
    32943278
    32953279  INTEGER idetr
    3296   SAVE idetr
    3297   DATA idetr/3/
    3298   !$OMP THREADPRIVATE(idetr)
    32993280
    33003281  ! local:
    … …  
    33753356  EXTERNAL scopy
    33763357
    3377   INTEGER ncorrec, ll
    3378   SAVE ncorrec
    3379   DATA ncorrec/0/
    3380   !$OMP THREADPRIVATE(ncorrec)
     3358  INTEGER ll
    33813359
    33823360
    … …  
    33853363  ! ---------------
    33863364
     3365  idetr=3
    33873366  sorties = .TRUE.
    33883367  IF (ngrid/=klon) THEN
    … …  
    45074486
    45084487  INTEGER idetr
    4509   SAVE idetr
    4510   DATA idetr/3/
    4511   !$OMP THREADPRIVATE(idetr)
    45124488
    45134489  ! local:
    … …  
    45724548  REAL f(klon), f0(klon)
    45734549  REAL zlevinter(klon)
    4574   LOGICAL first
    4575   DATA first/.FALSE./
    4576   SAVE first
    4577   !$OMP THREADPRIVATE(first)
    4578   ! RC
    45794550
    45804551  CHARACTER *2 str2
    … …  
    45884559  EXTERNAL scopy
    45894560
    4590   INTEGER ncorrec, ll
    4591   SAVE ncorrec
    4592   DATA ncorrec/0/
    4593   !$OMP THREADPRIVATE(ncorrec)
     4561  INTEGER ll
    45944562
    45954563
    … …  
    45984566  ! ---------------
    45994567
     4568  idetr=3
    46004569  sorties = .TRUE.
    46014570  IF (ngrid/=klon) THEN
    … …  
    46124581  ! print*,'0 OK convect8'
    46134582
     4583  idetr=3
    46144584  DO l = 1, nlay
    46154585    DO ig = 1, ngrid
    … …  
    53375307
    53385308  INTEGER idetr
    5339   SAVE idetr
    5340   DATA idetr/3/
    5341   !$OMP THREADPRIVATE(idetr)
    53425309  ! local:
    53435310  ! ------
    … …  
    53765343
    53775344  REAL count_time
    5378   ! integer isplit,nsplit
    5379   INTEGER isplit, nsplit, ialt
    5380   PARAMETER (nsplit=10)
    5381   DATA isplit/0/
    5382   SAVE isplit
    5383   !$OMP THREADPRIVATE(isplit)
    53845345
    53855346  LOGICAL sorties
    … …  
    54275388  EXTERNAL scopy
    54285389
    5429   INTEGER ncorrec
    5430   SAVE ncorrec
    5431   DATA ncorrec/0/
    5432   !$OMP THREADPRIVATE(ncorrec)
    54335390
    54345391
    … …  
    54375394  ! ---------------
    54385395
     5396  idetr=3
    54395397  sorties = .TRUE.
    54405398  IF (ngrid/=klon) THEN
    … …  
    62266184    ! print*,'15 OK convect8'
    62276185
    6228     isplit = isplit + 1
    62296186
    62306187  END IF

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_plume.f90

    r5450 r5618  
    218218
    219219   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
    220    call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
     220   call thermcell_qsat(ngrid, 1, active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
    221221    do ig=1,ngrid
    222222!       print*,'active',active(ig),ig,l
    … …  
    351351
    352352   ztemp(:)=zpspsk(:,l)*ztla(:,l)
    353    call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
     353   call thermcell_qsat(ngrid, 1, activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
    354354   do ig=1,ngrid
    355355      if (activetmp(ig)) then

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_plume_6A.f90

    r5450 r5618  
    216216
    217217   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
    218    call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
     218   call thermcell_qsat(ngrid, 1, active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
    219219    do ig=1,ngrid
    220220!       print*,'active',active(ig),ig,l
    … …  
    556556
    557557   ztemp(:)=zpspsk(:,l)*ztla(:,l)
    558    call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
     558   call thermcell_qsat(ngrid, 1, activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
    559559   do ig=1,ngrid
    560560      if (activetmp(ig)) then
    … …  
    917917
    918918   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
    919    call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
     919   call thermcell_qsat(ngrid, 1, active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
    920920
    921921    do ig=1,ngrid
    … …  
    10051005
    10061006   ztemp(:)=zpspsk(:,l)*ztla(:,l)
    1007    call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
     1007   call thermcell_qsat(ngrid, 1, activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
    10081008
    10091009   do ig=1,ngrid

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_qsat.f90

    r5390 r5618  
    11MODULE lmdz_thermcell_qsat
     2
     3  REAL, PARAMETER :: DDT0=.01
     4
    25CONTAINS
    36
    4 subroutine thermcell_qsat(klon,active,pplev,ztemp,zqta,zqsat)
     7subroutine thermcell_qsat(klon, nlev, active,pplev,ztemp,zqta,zqsat)
    58USE yoethf_mod_h
    69  USE yomcst_mod_h
     10
     11
    712implicit none
    813
    … …  
    1621
    1722! Arguments
    18 INTEGER klon
    19 REAL zpspsk(klon),pplev(klon)
    20 REAL ztemp(klon),zqta(klon),zqsat(klon)
    21 LOGICAL active(klon)
     23INTEGER, INTENT(IN) :: klon
     24INTEGER, INTENT(IN) :: nlev  ! number of vertical to apply qsat
     25REAL zpspsk(klon, nlev),pplev(klon, nlev)
     26REAL ztemp(klon, nlev),zqta(klon,nlev),zqsat(klon,nlev)
     27LOGICAL active(klon, nlev)
    2228
    2329! Variables locales
    2430INTEGER ig,iter
    25 REAL Tbef(klon),DT(klon)
     31REAL Tbef(klon,nlev),DT(klon,nlev)
    2632REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT
    2733logical Zsat
    2834REAL RLvCp
    2935
    30 REAL, SAVE :: DDT0=.01
    31 !$OMP THREADPRIVATE(DDT0)
    32 
    33 LOGICAL afaire(klon),tout_converge
    34 
     36LOGICAL afaire(klon, nlev),tout_converge
     37INTEGER :: l
    3538!====================================================================
    3639! INITIALISATIONS
    … …  
    3942RLvCp = RLVTT/RCPD
    4043tout_converge=.false.
    41 afaire(:)=.false.
    42 DT(:)=0.
     44afaire(:,:)=.false.
     45DT(:,:)=0.
    4346
    4447
    … …  
    4851! converge= false des que la convergence est atteinte.
    4952!====================================================================
    50 
    51 do ig=1,klon
    52    if (active(ig)) then
    53                Tbef(ig)=ztemp(ig)
    54                zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
    55                qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
     53do l=1,nlev
     54  do ig=1,klon
     55     if (active(ig,l)) then
     56               Tbef(ig,l)=ztemp(ig,l)
     57               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig,l)))
     58               qsatbef= R2ES * FOEEW(Tbef(ig,l),zdelta)/pplev(ig,l)
    5659               qsatbef=MIN(0.5,qsatbef)
    5760               zcor=1./(1.-retv*qsatbef)
    5861               qsatbef=qsatbef*zcor
    59                qlbef=max(0.,zqta(ig)-qsatbef)
    60                DT(ig) = 0.5*RLvCp*qlbef
    61                zqsat(ig)=qsatbef
     62               qlbef=max(0.,zqta(ig,l)-qsatbef)
     63               DT(ig,l) = 0.5*RLvCp*qlbef
     64               zqsat(ig,l)=qsatbef
    6265     endif
     66  enddo
    6367enddo
    64 
    6568! Traitement du cas ou il y a condensation mais faible
    6669! On ne condense pas mais on dit que le qsat est le qta
    67 do ig=1,klon
    68    if (active(ig)) then
    69       if (0.<abs(DT(ig)).and.abs(DT(ig))<=DDT0) then
    70          zqsat(ig)=zqta(ig)
    71       endif
    72    endif
     70do l=1,nlev
     71  do ig=1,klon
     72     if (active(ig,l)) then
     73       if (0.<abs(DT(ig,l)).and.abs(DT(ig,l))<=DDT0) then
     74           zqsat(ig,l)=zqta(ig,l)
     75        endif
     76     endif
     77  enddo
    7378enddo
    7479
    7580do iter=1,10
    76     afaire(:)=abs(DT(:)).gt.DDT0
    77     do ig=1,klon
    78                if (afaire(ig)) then
    79                  Tbef(ig)=Tbef(ig)+DT(ig)
    80                  zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
    81                  qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
     81    do l=1,nlev
     82      afaire(:,l)=abs(DT(:,l)).gt.DDT0
     83      do ig=1,klon
     84               if (afaire(ig,l)) then
     85                 Tbef(ig,l)=Tbef(ig,l)+DT(ig,l)
     86                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig,l)))
     87                 qsatbef= R2ES * FOEEW(Tbef(ig,l),zdelta)/pplev(ig,l)
    8288                 qsatbef=MIN(0.5,qsatbef)
    8389                 zcor=1./(1.-retv*qsatbef)
    8490                 qsatbef=qsatbef*zcor
    85                  qlbef=zqta(ig)-qsatbef
    86                  zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
     91                 qlbef=zqta(ig,l)-qsatbef
     92                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig,l)))
    8793                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
    8894                 zcor=1./(1.-retv*qsatbef)
    89                  dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef,zcor)
    90                  num=-Tbef(ig)+ztemp(ig)+RLvCp*qlbef
     95                 dqsat_dT=FOEDE(Tbef(ig,l),zdelta,zcvm5,qsatbef,zcor)
     96                 num=-Tbef(ig,l)+ztemp(ig,l)+RLvCp*qlbef
    9197                 denom=1.+RLvCp*dqsat_dT
    92                  zqsat(ig) = qsatbef
    93                  DT(ig)=num/denom
     98                 zqsat(ig,l) = qsatbef
     99                 DT(ig,l)=num/denom
    94100               endif
     101      enddo
    95102    enddo
    96103enddo

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/lmdz_wake.f90

    r5536 r5618  
    44
    55  IMPLICIT NONE; PRIVATE
    6   PUBLIC wake
     6 
     7  LOGICAL, PARAMETER :: phys_sub=.false.
     8  LOGICAL            :: first_call=.true.
     9  !$OMP THREADPRIVATE(first_call)
     10
     11  PUBLIC wake, wake_first
    712
    813CONTAINS
     14
     15SUBROUTINE wake_first(klev, dtime)           
     16USE lmdz_wake_ini , ONLY : wk_nsub
     17IMPLICIT NONE 
     18  INTEGER, INTENT(IN) :: klev
     19  REAL, INTENT(IN)    :: dtime
     20  REAL                :: dtimesub
     21
     22  dtimesub = dtime/wk_nsub
     23  !
     24  IF (first_call) THEN
     25    IF (CPPKEY_IOPHYS_WK) THEN
     26      IF (phys_sub) THEN
     27        call iophys_ini(dtimesub,klev)
     28      ELSE
     29        call iophys_ini(dtime,klev)
     30      ENDIF
     31    END IF
     32    first_call = .false.
     33  ENDIF   !(first_call)
     34
     35END SUBROUTINE wake_first
    936
    1037SUBROUTINE wake(klon,klev,znatsurf, p, ph, pi, dtime, &
    … …  
    306333  REAL, DIMENSION(klon)                                 :: wdens_in, awdens_in   ! pour les prints
    307334
    308 !!!  LOGICAL                                               :: phys_sub=.true.
    309   LOGICAL                                               :: phys_sub=.false.
    310 
    311   LOGICAL                                               :: first_call=.true.
    312 
    313 
    314335  !!-- variables liees au nouveau calcul de ptop et hw
    315336  REAL, DIMENSION (klon, klev)                          :: int_dth
    … …  
    350371  ! alpk = 0.05
    351372!
    352  igout = klon/2+1/klon
     373 igout = klon/2+1/klon 
    353374!
    354375!   sub-time-stepping parameters
    355376  dtimesub = dtime/wk_nsub
    356377!
    357 IF (first_call) THEN
    358 IF (CPPKEY_IOPHYS_WK) THEN
    359   IF (phys_sub) THEN
    360     call iophys_ini(dtimesub)
    361   ELSE
    362     call iophys_ini(dtime)
    363   ENDIF
    364 END IF
    365   first_call = .false.
    366 ENDIF   !(first_call)
    367 
    368378 IF (iflag_wk_pop_dyn == 0) THEN
    369379  ! Initialisation de toutes des densites a wdens_ref.

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/modd_csts.f90

    r5536 r5618  
    8888REAL,SAVE     :: XSURF_EPSILON       ! minimum space with 1.0
    8989!
     90!$OMP THREADPRIVATE(XPI,XDAY,XSIYEA,XSIDAY,XKARMAN,XLIGHTSPEED,XPLANCK,XBOLTZ,XAVOGADRO)
     91!$OMP THREADPRIVATE(XRADIUS,XOMEGA,XG,XP00,XSTEFAN,XI0,XMD,XMV,XRD,XRV)
     92!$OMP THREADPRIVATE(XCPD,XCPV,XRHOLW,XCL,XCI,XTT,XTTSI,XTTS,XICEC,XLVTT,XLSTT,XLMTT,XESTT)
     93!$OMP THREADPRIVATE(XALPW,XBETAW,XGAMW,XALPI,XBETAI,XGAMI,XTH00)
     94!$OMP THREADPRIVATE(XRHOLI,XCONDI,NDAYSEC)
     95!$OMP THREADPRIVATE(XSURF_TINY,XSURF_TINY_12,XSURF_EPSILON)
     96
    9097END MODULE MODD_CSTS
    9198

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/oasis.F90

    r5536 r5618  
    137137    CHARACTER (len = 20)               :: modname = 'inicma'
    138138    CHARACTER (len = 80)               :: abort_message
     139    !! WARNING: cpl_current_omp should NOT be put in a THREADPRIVATE statement, it is shared between tasks
    139140    LOGICAL, SAVE                      :: cpl_current_omp
    140141    INTEGER, DIMENSION(klon_mpi)       :: ind_cell_glo_mpi
     142
    141143
    142144!*    1. Initializations

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/ocean_forced_mod.F90

    r5536 r5618  
    335335    REAL                        :: zfra
    336336    REAL, PARAMETER             :: t_grnd=271.35
    337     REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol
     337    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol, icesub
    338338    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
    339339    REAL, DIMENSION(klon)       :: soilcap, soilflux
    … …  
    452452    CALL fonte_neige( knon, is_sic, knindex, dtime, &
    453453         tsurf_tmp, precip_rain, precip_snow, &
    454          snow, qsol, tsurf_new, evap &
     454         snow, qsol, tsurf_new, evap, icesub &
    455455#ifdef ISO   
    456456     &  ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/output_physiqex_mod.f90

    r5536 r5618  
    5858
    5959   !$OMP MASTER
    60    CALL iophys_ini(pdtphys)
     60   CALL iophys_ini(pdtphys,klev)
    6161   !$OMP END MASTER
    6262   !$OMP BARRIER

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/pbl_surface_mod.F90

    r5536 r5618  
    277277!>jyg
    278278       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,  zxsnowerosion,      &
    279        alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
     279       icesub_lic, alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
    280280       zxtsol,    zxfluxlat, zt2m,     qsat2m, zn2mout,                 &
    281281       d_t,       d_q,    d_qbs,    d_u,      d_v, d_t_diss,            &
    … …  
    522522    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxevap     ! water vapour flux at surface, positiv upwards
    523523    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxsnowerosion     ! blowing snow flux at surface
     524    REAL, DIMENSION(klon),        INTENT(OUT)       :: icesub_lic ! ice (no snow!) sublimation over ice sheet
    524525    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxtsol     ! temperature at surface, mean for each grid point
    525526!!! jyg le ???
    … …  
    745746    REAL, DIMENSION(klon)              :: AcoefQBS, BcoefQBS
    746747    REAL, DIMENSION(klon)              :: ypsref
    747     REAL, DIMENSION(klon)              :: yevap, yevap_pot, ytsurf_new, yalb3_new
     748    REAL, DIMENSION(klon)              :: yevap, yevap_pot, ytsurf_new, yalb3_new, yicesub_lic
    748749!albedo SB >>>
    749750    REAL, DIMENSION(klon,nsw)          :: yalb_dir_new, yalb_dif_new
    … …  
    12461247 zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.; zxfluxqbs(:,:)=0.
    12471248 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
    1248  runoff(:)=0.
     1249 runoff(:)=0. ; icesub_lic(:)=0.
    12491250#ifdef ISO
    12501251zxxtevap(:,:)=0.
    … …  
    24982499                  ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, &
    24992500                  ysnow, yqsurf, yqsol,yqbs1, yagesno, &
    2500                   ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
     2501                  ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yicesub_lic, yfluxsens,yfluxlat, &
    25012502                  yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, &
    25022503                  yzmea, yzsig, ycldt, &
    … …  
    25212522                sissnow(i)   = ysissnow(j)
    25222523                runoff(i)    = yrunoff(j)
     2524                icesub_lic(i) = yicesub_lic(j)*ypct(j)
    25232525             ENDDO
    25242526             ! Martin
    … …  
    32253227
    32263228       ENDIF  ! (iflag_split .eq.0)
    3227 !!!
     3229
    32283230
    32293231       ! tendencies of blowing snow

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phyetat0_mod.f90

    r5609 r5618  
    549549     it = 0
    550550     DO iq = 1, nqtot
    551         IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     551        IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    552552        it = it+1
    553553        tname = tracers(iq)%name

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phyredem.f90

    r5609 r5618  
    365365       it = 0
    366366       DO iq = 1, nqtot
    367           IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     367          IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    368368          it = it+1
    369369          CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it))

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phys_local_var_mod.F90

    r5609 r5618  
    385385      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw, water_budget
    386386!$OMP THREADPRIVATE(dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw, water_budget)
     387      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: icesub_lic
     388!$OMP THREADPRIVATE(icesub_lic)
    387389      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zustar, zu10m, zv10m, rh2m
    388390!$OMP THREADPRIVATE(zustar, zu10m, zv10m, rh2m)
    … …  
    494496      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: proba_notrig, random_notrig
    495497!$OMP THREADPRIVATE(proba_notrig, random_notrig)
     498      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: coef_clos, coef_clos_eff
     499!$OMP THREADPRIVATE(coef_clos, coef_clos_eff)
    496500      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: fsolsw, wfbils
    497501!$OMP THREADPRIVATE(fsolsw, wfbils)
    … …  
    958962      ALLOCATE(dv_gwd_rando(klon,klev),dv_gwd_front(klon,klev))
    959963      ALLOCATE(east_gwstress(klon,klev),west_gwstress(klon,klev))
    960       east_gwstress(:,:)=0 !ym missing init
    961       west_gwstress(:,:)=0 !ym missing init
     964      east_gwstress(:,:)=0. !ym missing init
     965      west_gwstress(:,:)=0. !ym missing init
    962966      ALLOCATE(d_t_hin(klon,klev))
    963967      ALLOCATE(d_q_ch4(klon,klev))
    … …  
    10611065      ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon))
    10621066      ALLOCATE(JrNt(klon))
    1063       ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon))
     1067      ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon), icesub_lic(klon))
    10641068      ALLOCATE(prw(klon), prlw(klon), prsw(klon), prbsw(klon), water_budget(klon), zustar(klon), zu10m(klon), zv10m(klon), rh2m(klon))
    10651069      ALLOCATE(s_lcl(klon))
    … …  
    11341138      alp_bl_stat(:)=0
    11351139      ALLOCATE(proba_notrig(klon), random_notrig(klon))
     1140      ALLOCATE(coef_clos(klon), coef_clos_eff(klon))
     1141      coef_clos(:)=0.
     1142      coef_clos_eff(:)=0.
    11361143
    11371144      ALLOCATE(dnwd0(klon, klev))
    … …  
    15101517      DEALLOCATE(cldm, cldq, cldt, qsat2m)
    15111518      DEALLOCATE(JrNt)
    1512       DEALLOCATE(dthmin, evap, snowerosion, fder, plcl, plfc)
     1519      DEALLOCATE(dthmin, evap, snowerosion, icesub_lic, fder, plcl, plfc)
    15131520      DEALLOCATE(prw, prlw, prsw, prbsw, water_budget, zustar, zu10m, zv10m, rh2m, s_lcl)
    15141521      DEALLOCATE(s_pblh, s_pblt, s_therm)
    … …  
    15681575      DEALLOCATE(alp_bl_stat, n2, s2, strig, zcong, zlcl_th)
    15691576      DEALLOCATE(proba_notrig, random_notrig)
     1577      DEALLOCATE(coef_clos, coef_clos_eff)
    15701578!FC
    15711579      DEALLOCATE(zxfluxq,zxfluxt)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phys_output_ctrlout_mod.F90

    r5609 r5618  
    384384  TYPE(ctrl_out), SAVE :: o_snowerosion = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    385385   'snowerosion', 'blowing snow flux', 'kg/(s*m2)', (/ ('', i=1, 10) /))
     386  TYPE(ctrl_out), SAVE :: o_icesub_lic = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     387   'icesub_lic', 'sublimation of ice over landice tiles, mesh-averaged', 'kg/(s*m2)', (/ ('', i=1, 10) /))
    386388  TYPE(ctrl_out), SAVE :: o_ustart_lic = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
    387389    'ustart_lic', 'threshold velocity', 'm/s', (/ ('', i=1, 10) /))
    … …  
    928930  TYPE(ctrl_out), SAVE :: o_wape = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11, 11/), &
    929931    'wape', '', 'm2/s2', (/ ('', i=1, 10) /))
     932!!
     933  TYPE(ctrl_out), SAVE :: o_coef_clos = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11, 11/), &
     934    'coef_clos', 'closure coefficient', '', (/ ('', i=1, 10) /))
     935  TYPE(ctrl_out), SAVE :: o_coef_clos_eff = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11, 11/), &
     936    'coef_clos_eff', 'effective closure coefficient', '', (/ ('', i=1, 10) /))
     937
    930938
    931939!!! nrlmd le 10/04/2012
    … …  
    20072015  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_sat(:)
    20082016  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_uscav(:)
    2009   TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet_con(:)
     2017  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet_cv(:)
     2018  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet(:)
    20102019  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_dry(:)
    20112020

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phys_output_mod.F90

    r5536 r5618  
    77  USE phys_output_write_mod, ONLY : phys_output_write
    88  REAL, DIMENSION(nfiles),SAVE :: ecrit_files
     9
    910
    1011! Abderrahmane 12 2007
    … …  
    139140    REAL, DIMENSION(nfiles), SAVE ::  phys_out_latmin  = [   -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.]
    140141    REAL, DIMENSION(nfiles), SAVE ::  phys_out_latmax  = [    90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.]
     142
    141143    REAL, DIMENSION(klev,2) :: Ahyb_bounds, Bhyb_bounds
    142144    REAL, DIMENSION(klev+1)   :: lev_index
    … …  
    172174    ALLOCATE(o_dtr_evapls(nqtot),o_dtr_ls(nqtot),o_dtr_trsp(nqtot))
    173175    ALLOCATE(o_dtr_sscav(nqtot),o_dtr_sat(nqtot),o_dtr_uscav(nqtot))
    174     ALLOCATE(o_dtr_wet_con(nqtot))
     176    ALLOCATE(o_dtr_wet_cv(nqtot), o_dtr_wet(nqtot))
    175177    ALLOCATE(o_dtr_dry(nqtot),o_dtr_vdf(nqtot))
    176178IF (CPPKEY_STRATAER) THEN
    … …  
    513515          itr = 0; itrb = 0
    514516          DO iq = 1, nqtot
    515             IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     517            IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    516518            itr = itr + 1
    517519            dn = 'd'//TRIM(tracers(iq)%name)//'_'
    … …  
    542544
    543545            lnam = 'tracer convective wet deposition'//TRIM(tracers(iq)%longName)
    544             tnam = TRIM(dn)//'wet_con';       o_dtr_wet_con       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     546            tnam = TRIM(dn)//'wet_cv';       o_dtr_wet_cv       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     547            lnam = 'tracer total wet deposition'//TRIM(tracers(iq)%longName)
     548            tnam = TRIM(dn)//'wet';       o_dtr_wet       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    545549            lnam = 'tracer tendency dry deposition'//TRIM(tracers(iq)%longName)
    546550            tnam = 'cum'//TRIM(dn)//'dry';  o_dtr_dry       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    … …  
    636640
    637641!  DO iq=1,nqtot
    638 !    IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     642!    IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    639643!    WRITE(*,'(a,i1,a,10i3)')'trac(',iq,')%flag = ',o_trac(iq)%flag
    640644!    WRITE(*,'(a,i1,a)')'trac(',iq,')%name = '//TRIM(o_trac(iq)%name)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phys_output_var_mod.f90

    r5536 r5618  
    104104  !$OMP THREADPRIVATE(clef_files, clef_stations, lev_files,nid_files,nnid_files)
    105105  INTEGER, DIMENSION(nfiles), SAVE :: nnhorim
    106 
    107106  INTEGER, DIMENSION(nfiles), SAVE :: nhorim, nvertm
    108107  INTEGER, DIMENSION(nfiles), SAVE :: nvertap, nvertbp, nvertAlt
    109108  REAL, DIMENSION(nfiles), SAVE                :: zoutm
    110109  CHARACTER(LEN=20), DIMENSION(nfiles), SAVE   :: type_ecri
    111   !$OMP THREADPRIVATE(nnhorim, nhorim, nvertm, zoutm,type_ecri)
     110  !$OMP THREADPRIVATE(nnhorim,nhorim,nvertm,nvertap,nvertbp,nvertAlt,zoutm,type_ecri)
    112111  CHARACTER(LEN=20), DIMENSION(nfiles), SAVE  :: type_ecri_files, phys_out_filetypes
    113112  !$OMP THREADPRIVATE(type_ecri_files, phys_out_filetypes)

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phys_output_write_mod.F90

    r5609 r5618  
    66  USE phytrac_mod, ONLY : d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, &
    77       d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls,  &
    8        d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, flux_tr_wet, flux_tr_dry
     8       d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav,  &
     9       flux_tr_wet_cv, flux_tr_wet, flux_tr_dry
    910
    1011  ! Author: Abderrahmane IDELKADI (original include file)
    … …  
    4849         o_psol, o_mass, o_qsurf, o_qsol, &
    4950         o_precip, o_rain_fall, o_rain_con, o_ndayrain, o_plul, o_pluc, o_plun, &
    50          o_snow, o_msnow, o_fsnow, o_evap, o_snowerosion, o_ustart_lic, o_qsalt_lic, o_rhosnow_lic, o_bsfall, &
     51         o_snow, o_msnow, o_fsnow, o_evap, o_snowerosion, o_ustart_lic, o_qsalt_lic, o_rhosnow_lic, o_bsfall, &
     52         o_icesub_lic, &
    5153         o_ep,o_epmax_diag, & ! epmax_cape
    5254         o_tops, o_tops0, o_topl, o_topl0, &
    … …  
    105107         o_alp_bl_fluct_m, o_alp_bl_fluct_tke, &
    106108         o_alp_bl_conv, o_alp_bl_stat, &
     109         o_coef_clos, o_coef_clos_eff, &
    107110         o_slab_qflux, o_tslab, o_slab_bils, &
    108111         o_slab_bilg, o_slab_sic, o_slab_tice, &
    … …  
    190193         o_dtr_insc, o_dtr_bcscav, o_dtr_evapls, &
    191194         o_dtr_ls, o_dtr_trsp, o_dtr_sscav, o_dtr_dry, &
    192          o_dtr_sat, o_dtr_uscav, o_dtr_wet_con, &
     195         o_dtr_sat, o_dtr_uscav, o_dtr_wet_cv, o_dtr_wet, &
    193196         o_trac_cum, o_du_gwd_rando, o_dv_gwd_rando, &
    194197         o_ustr_gwd_hines,o_vstr_gwd_hines,o_ustr_gwd_rando,o_vstr_gwd_rando, &
    … …  
    326329    USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, &
    327330         zn2mout, t2m_min_mon, t2m_max_mon, evap, &
    328          snowerosion, zxustartlic, zxrhoslic, zxqsaltlic, &
     331         snowerosion, icesub_lic, zxustartlic, zxrhoslic, zxqsaltlic, &
    329332         l_mixmin,l_mix, pbl_eps, tke_shear, tke_buoy, tke_trans, &
    330333         zu10m, zv10m, zq2m, zustar, zxqsurf, &
    … …  
    351354         wake_h, &
    352355         wake_omg, d_t_wake, d_q_wake, Vprecip, qtaa, Clw, &
     356         coef_clos, coef_clos_eff, &
    353357         wdtrainA, wdtrainS, wdtrainM, n2, s2, strig, zcong, zlcl_th, proba_notrig, &
    354358         random_notrig, &
    … …  
    934938       CALL histwrite_phy(o_fsnow, zfra_o)
    935939       CALL histwrite_phy(o_evap, evap)
     940       CALL histwrite_phy(o_icesub_lic, icesub_lic)
    936941
    937942       IF (ok_bs) THEN
    … …  
    14681473          CALL histwrite_phy(o_cape_max, cape)
    14691474
     1475          CALL histwrite_phy(o_coef_clos, coef_clos)
     1476          CALL histwrite_phy(o_coef_clos_eff, coef_clos_eff)
    14701477          CALL histwrite_phy(o_upwd, upwd)
    14711478          CALL histwrite_phy(o_Ma, Ma)
    … …  
    17221729            ENDIF
    17231730          ENDIF
    1724           IF (slab_ekman.GT.0) THEN
    1725             IF (nslay.EQ.1) THEN
    1726                 IF (vars_defined) zx_tmp_fi2d(:)=dt_ekman(:,1)
    1727                 CALL histwrite_phy(o_slab_ekman, zx_tmp_fi2d)
    1728             ELSE
    1729                 CALL histwrite_phy(o_slab_ekman, dt_ekman(:,1:nslay))
    1730             ENDIF
    1731           ENDIF
     1731          !IF (slab_ekman.GT.0) THEN
     1732          !  IF (nslay.EQ.1) THEN
     1733          !      IF (vars_defined) zx_tmp_fi2d(:)=dt_ekman(:,1)
     1734          !      CALL histwrite_phy(o_slab_ekman, zx_tmp_fi2d)
     1735          !  ELSE
     1736          !      CALL histwrite_phy(o_slab_ekman, dt_ekman(:,1:nslay))
     1737          !  ENDIF
     1738          !ENDIF
    17321739       ENDIF !type_ocean == force/slab
    17331740       CALL histwrite_phy(o_weakinv, weak_inversion)
    … …  
    17891796!--OLIVIER
    17901797!This is warranted by treating INCA aerosols as offline aerosols
    1791 #ifndef CPP_ECRAD
     1798!!#ifndef CPP_ECRAD
    17921799       IF (flag_aerosol.GT.0) THEN
    17931800          IF (type_trac/='inca' .OR. config_inca=='aeNP') THEN
    … …  
    20502057!solbnd end
    20512058       ENDIF
    2052 #endif
     2059!!#endif
    20532060
    20542061       IF (flag_aerosol_strat.EQ.2) THEN
    … …  
    29252932             CALL histwrite_phy(o_dtr_uscav(itr),d_tr_uscav(:,:,itr))
    29262933            !--2D fields
    2927              CALL histwrite_phy(o_dtr_wet_con(itr), flux_tr_wet(:,itr))
     2934             ! flux*_wet and _wet_cv are introduced in r5473. They work with IOIPSL.
     2935             ! For XIOS, the corresponding fields must be added in field_def_lmdz.xml for the LMDZ tracers. 
     2936             ! Until then, these outputs are commented out.
     2937             !CALL histwrite_phy(o_dtr_wet_cv(itr), flux_tr_wet_cv(:,itr))
     2938             !CALL histwrite_phy(o_dtr_wet(itr), flux_tr_wet(:,itr))
    29282939             CALL histwrite_phy(o_dtr_dry(itr), flux_tr_dry(:,itr))
    29292940             zx_tmp_fi2d=0.

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phys_state_var_mod.F90

    r5609 r5618  
    667667!
    668668      ALLOCATE(Mipsh(klon,klev))
     669      Mipsh(:,:)=0.0
    669670      ALLOCATE(Ma(klon,klev))
    670671      ALLOCATE(qcondc(klon,klev))

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90

    r5609 r5618  
    3939    USE ioipsl_getin_p_mod, ONLY : getin_p
    4040    USE indice_sol_mod
    41     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, addPhase
     41    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, addPhase, ivap, iliq, isol, ibs, icf, iqvc, icfa, ipcf, iqva, iqia
    4242    USE strings_mod,  ONLY: strIdx
    4343    USE iophy
    … …  
    7878    USE lmdz_lscp, ONLY : lscp
    7979    USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop
    80     USE lmdz_lscp_old, ONLY : fisrtilp
     80    USE lmdz_lscp_old, ONLY : fisrtilp, fisrtilp_first
    8181    USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim
     82    USE calwake_mod, ONLY : calwake, calwake_first
    8283    USE lmdz_wake_ini, ONLY : wake_ini
    8384    USE lmdz_surf_wind_ini, ONLY : surf_wind_ini, iflag_surf_wind
    … …  
    8687    USE lmdz_atke_turbulence_ini, ONLY : atke_ini
    8788    USE lmdz_thermcell_ini, ONLY : thermcell_ini, iflag_thermals_tenv
     89    USE calltherm_mod, ONLY : calltherm
    8890    USE lmdz_thermcell_dtke, ONLY : thermcell_dtke
    8991    USE lmdz_blowing_snow_ini, ONLY : blowing_snow_ini , qbst_bs
    … …  
    113115                        ptrop, ttrop, ztrop, gravit, itroprep, Z1, Z2, fac, B, chemini_rep, chemtime_rep, coord_hyb_rep, &
    114116            rtime
    115     USE strataer_local_var_mod
    116     USE strataer_emiss_mod, ONLY: strataer_emiss_init
    117117    USE time_phylmdz_mod,    ONLY: annee_ref, day_ini, day_ref, start_time
    118118    USE vertical_layers_mod, ONLY: aps, bps, ap, bp
    … …  
    125125
    126126    USE phys_local_var_mod, ONLY: d_q_emiss
    127     USE strataer_local_var_mod
     127    USE strataer_local_var_mod, ONLY: strataer_init,flag_emit,flh2o,ok_qemiss,flag_verbose_strataer, &
     128         year_emit_vol,mth_emit_vol,day_emit_vol,nErupt,nAerErupt,injdur,m_H2O_emiss_vol_daily,m_H2O_emiss_vol, &
     129         ponde_lonlat_vol,altemiss_vol,sigma_alt_vol,xlat_min_vol,xlat_max_vol,xlon_min_vol,xlon_max_vol
    128130    USE strataer_nuc_mod, ONLY: strataer_nuc_init
    129131    USE strataer_emiss_mod, ONLY: strataer_emiss_init
    130 
     132   
    131133    USE lmdz_xios, ONLY: xios_update_calendar, xios_context_finalize
    132134    USE lmdz_xios, ONLY: xios_get_field_attr, xios_field_is_active, xios_context
    133135    USE lmdz_xios, ONLY: xios_set_current_context
    134     use wxios_mod, ONLY: missing_val, using_xios
     136    USE wxios_mod, ONLY: missing_val, using_xios
     137    USE lmdz_spla_ini, ONLY : spla_ini
    135138
    136139#ifndef CPP_XIOS
    … …  
    248251       cldh, cldl,cldm, cldq, cldt,      &
    249252       JrNt,                             &
    250        dthmin, evap, snowerosion,fder, plcl, plfc,   &
     253       dthmin, evap, snowerosion, icesub_lic, fder, plcl, plfc,   &
    251254       prw, prlw, prsw, prbsw, water_budget,         &
    252255       s_lcl, s_pblh, s_pblt, s_therm,   &
    … …  
    304307       !    Deep convective variables used in phytrac
    305308       pmflxr, pmflxs,  &
     309       coef_clos, coef_clos_eff, &
    306310       wdtrainA, wdtrainS, wdtrainM, wdtrainAS,  &
    307311       upwd, dnwd, &
    … …  
    381385       USE phys_output_write_spl_mod, ONLY: phys_output_write_spl
    382386       USE phytracr_spl_mod, ONLY: phytracr_spl_out_init, phytracr_spl
     387       USE s2s, ONLY : s2s_initialize
    383388    IMPLICIT NONE
    384389    !>======================================================================
    … …  
    517522    !======================================================================
    518523    !
    519     ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional)
    520     INTEGER,SAVE :: ivap, iliq, isol, ibs, icf, iqvc, icfa, ipcf, iqia, iqva
    521 !$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, iqvc, icfa, ipcf, iqia, iqva)
    522     !
    523524    !
    524525    ! Variables argument:
    … …  
    10261027
    10271028    REAL picefra(klon,klev)
    1028     REAL zrel_oro(klon)
     1029    REAL nm_oro(klon)
    10291030    !IM cf. AM 081204 END
    10301031    !
    … …  
    11021103    LOGICAL, SAVE ::  ok_sync, ok_sync_omp
    11031104    !$OMP THREADPRIVATE(ok_sync)
     1105    ! ok_sync_omp should not be in a THREADPRIVATE statement
    11041106    REAL date0
    11051107
    … …  
    11111113    REAL ztsol(klon)
    11121114    REAL q2m(klon,nbsrf)  ! humidite a 2m
    1113     REAL fsnowerosion(klon,nbsrf) ! blowing snow flux at surface
    11141115    REAL qbsfra  ! blowing snow fraction
    11151116    !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels
    … …  
    12771278    ! Subgrid scale wind :
    12781279    ! Need to be allocatable/save because the number of bin is not known (provided by surf_wind_ini)
    1279     integer, save :: nsrfwnd=1
     1280    integer, save :: nsurfwind=1
    12801281    real, dimension(:,:), allocatable, save :: surf_wind_value, surf_wind_proba ! module and probability of sugrdi wind wind sample
    1281     !$OMP THREADPRIVATE(nsrfwnd,surf_wind_value, surf_wind_proba)
     1282    !$OMP THREADPRIVATE(nsurfwind,surf_wind_value, surf_wind_proba)
    12821283   
    12831284
    … …  
    13591360
    13601361    IF (first) THEN
    1361        ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
    1362        iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
    1363        isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
    1364        ibs  = strIdx(tracers(:)%name, addPhase('H2O', 'b'))
    1365        icf  = strIdx(tracers(:)%name, 'CLDFRA')
    1366        iqvc = strIdx(tracers(:)%name, 'CLDVAP_g')
    1367        icfa = strIdx(tracers(:)%name, 'CONTFRA')
    1368        ipcf = strIdx(tracers(:)%name, 'PERSCONTFRA')
    1369        iqva = strIdx(tracers(:)%name, 'CONTWATER_g')
    1370        iqia = strIdx(tracers(:)%name, 'CONTWATER_s')
     1362       
     1363        CALL s2s_initialize     ! initialization of source to source tools
     1364       
    13711365!       CALL init_etat0_limit_unstruct
    13721366!       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
    … …  
    18601854!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    18611855       CALL surf_wind_ini(klon,lunout)
    1862        CALL getin_p('nsrfwnd',nsrfwnd)
    1863        allocate(surf_wind_value(klon,nsrfwnd),surf_wind_proba(klon,nsrfwnd))
     1856       CALL getin_p('nsurfwind',nsurfwind)
     1857       allocate(surf_wind_value(klon,nsurfwind),surf_wind_proba(klon,nsurfwind))
    18641858   
    18651859!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    19181912IF (CPPKEY_DUST) THEN
    19191913       ! Quand on utilise SPLA, on force iflag_phytrac=1
     1914       CALL spla_ini(is_oce,RNAVO,RG,RD,RCPD,RLVTT,RLSTT,RETV,RTT,              &
     1915               R2ES,R3LES,R3IES,R4LES,R4IES,R5LES,R5IES,RVTMP2)
    19201916       CALL phytracr_spl_out_init()
    19211917       CALL phys_output_write_spl(itap, pdtphys, paprs, pphis,                  &
    … …  
    29612957            cdragh,    cdragm,  u1,    v1,            &
    29622958            beta_aridity, &
    2963                                 !albedo SB >>>
    2964                                 ! albsol1,   albsol2,   sens,    evap,      &
    2965             albsol_dir,   albsol_dif,   sens,    evap, snowerosion, &
    2966                                 !albedo SB <<<
     2959            albsol_dir,   albsol_dif,   sens,    evap, snowerosion, icesub_lic, &
    29672960            albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
    29682961            zxtsol,    zxfluxlat, zt2m,    qsat2m,  zn2mout, &
    … …  
    33193312                                !!     .        pmflxr,pmflxs,da,phi,mp,
    33203313                                !!     .        ftd,fqd,lalim_conv,wght_th)
    3321                pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,qtaa,clw,elij, &
     3314               pmflxr,pmflxs, &
     3315               coef_clos, coef_clos_eff, &
     3316               da,phi,mp,phi2,d1a,dam,sij,qtaa,clw,elij, &
    33223317               ftd,fqd,lalim_conv,wght_th, &
    33233318               ev, ep,epmlmMm,eplaMm, &
    … …  
    35853580          !
    35863581          !calcul caracteristiques de la poche froide
     3582          CALL calWAKE_first(phys_tstep)
    35873583          CALL calWAKE (iflag_wake_tend, paprs, pplay, phys_tstep, &
    35883584               t_seri, q_seri, omega,  &
    … …  
    37523748          ENDIF
    37533749          !>jyg
    3754           CALL calltherm(pdtphys &
     3750          CALL calltherm(itap, pdtphys &
    37553751               ,pplay,paprs,pphi,weak_inversion &
    37563752                        ! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
    … …  
    37803776             !  poches, la tendance moyenne associ\'ee doit etre
    37813777             !  multipliee par la fraction surfacique qu'ils couvrent.
     3778             IF (mod(iflag_pbl_split/10,10) == 1) THEN
     3779                ! On tient compte du splitting pour modifier les profils deltatq/T des poches
     3780                DO k=1,klev
     3781                   DO i=1,klon
     3782                      d_deltat_the(i,k) = - d_t_ajs(i,k)
     3783                      d_deltaq_the(i,k) = - d_q_ajs(i,k)
     3784                   ENDDO
     3785                ENDDO
     3786             ELSE
     3787                d_deltat_the(:,:) = 0.
     3788                d_deltaq_the(:,:) = 0.
     3789             ENDIF
     3790
    37823791             DO k=1,klev
    37833792                DO i=1,klon
    3784                    !
    3785                    d_deltat_the(i,k) = - d_t_ajs(i,k)
    3786                    d_deltaq_the(i,k) = - d_q_ajs(i,k)
    3787                    !
    37883793                   d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i))
    37893794                   d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i))
    37903795                   d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i))
    37913796                   d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i))
    3792                    !
    37933797                ENDDO
    37943798             ENDDO
    … …  
    38813885    !===================================================================
    38823886    ! Computation of subrgid scale near-surface wind distribution
    3883     call surf_wind(klon,nsrfwnd,u10m,v10m,wake_s,wake_Cstar,ustar,wstar,surf_wind_value,surf_wind_proba)
     3887    call surf_wind(klon,nsurfwind,u10m,v10m,wake_s,wake_Cstar,ustar,wstar,surf_wind_value,surf_wind_proba)
    38843888
    38853889    !===================================================================
    … …  
    39843988
    39853989    ELSE
    3986 
     3990   
     3991    CALL fisrtilp_first(klon, klev, phys_tstep, pfrac_impa, pfrac_nucl, pfrac_1nucl)
    39873992    CALL fisrtilp(klon,klev,phys_tstep,paprs,pplay, &
    39883993         t_seri, q_seri,ptconv,ratqs,sigma_qtherm, &
    … …  
    49544959    ! a l'echelle sous-maille:
    49554960    !
     4961
     4962    ! calculation of nm_oro
     4963    DO i=1,klon
     4964          ! nm_oro is a proxy for the number of subgrid scale mountains
     4965          ! -> condition on nm_oro can deactivate the lifting on tilted planar terrains
     4966          !    such as ice sheets (work by V. Wiener)
     4967          ! in such a case, the SSO scheme should activate only where nm_oro>0 i.e. by setting
     4968          ! nm_oro_t=0.
     4969          nm_oro(i)=zsig(i)*sqrt(cell_area(i)*(pctsrf(i,is_ter)+pctsrf(i,is_lic)))/(4.*MAX(zstd(i),1.e-8))-1.
     4970    ENDDO
     4971
    49564972    IF (prt_level .GE.10) THEN
    49574973       print *,' call orography ? ', ok_orodr
    … …  
    49644980       DO i=1,klon
    49654981          itest(i)=0
    4966           zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i)))
    4967           !zrel_oro: relative mountain height wrt relief explained by mean slope
    4968           ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains
    4969           !    such as ice sheets (work by V. Wiener)
    49704982          ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to
    49714983          ! earn computation time but they are not physical.
    4972           IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
     4984          IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN
    49734985             itest(i)=1
    49744986             igwd=igwd+1
    … …  
    50195031       DO i=1,klon
    50205032          itest(i)=0
    5021           !zrel_oro: relative mountain height wrt relief explained by mean slope
    5022           ! -> condition on zrel_oro can deactivate the lifting on tilted planar terrains
    5023           !    such as ice sheets (work by V. Wiener)
    5024           zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i)))
    5025           IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
     5033          IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN
    50265034             itest(i)=1
    50275035             igwd=igwd+1
    … …  
    52645272! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE
    52655273! Mais attention, cela ne va pas dans le sens de la conservation de l'energie!
    5266           IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
     5274          IF ((zstd(i).GT.1.0) .AND.(nm_oro(i).GT.nm_oro_t)) THEN
    52675275             itest(i)=1
    52685276             igwd=igwd+1
    … …  
    52765284       DO i=1,klon
    52775285          itest(i)=0
    5278         IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
     5286        IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN
    52795287             itest(i)=1
    52805288             igwd=igwd+1
    … …  
    56065614      !--compute ratio of what q+ql should be with conservation to what it is
    56075615      IF (ok_bs) THEN
    5608         corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i)-bs_fall(i))*pdtphys)/qql2(i)
     5616        corrqql=(qql1(i)+(evap(i)-snowerosion(i)-rain_fall(i)-snow_fall(i)-bs_fall(i))*pdtphys)/qql2(i)
    56095617      ELSE
    56105618        corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i))*pdtphys)/qql2(i)
    … …  
    59545962
    59555963IF (CPPKEY_INCA) THEN
    5956           IF (type_trac == 'inca') THEN
    5957              IF (is_omp_master .AND. grid_type==unstructured) THEN
     5964          IF (ANY(type_trac == ['inca','inco'])) THEN
     5965             IF (is_omp_master) THEN
    59585966                CALL finalize_inca
    59595967             ENDIF

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phystokenc_mod.f90

    r5536 r5618  
    142142  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: upwd
    143143  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: dnwd
    144  
     144!$OMP THREADPRIVATE(sh,da,phi,mp,upwd,dnwd)
     145
    145146  REAL, SAVE :: dtcum
    146147  INTEGER, SAVE:: iadvtr=0

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/phytrac_mod.f90

    r5536 r5618  
    3535  REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat
    3636  REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav
    37   REAL,DIMENSION(:,:),ALLOCATABLE,SAVE   :: flux_tr_wet ! tracer wet deposit (surface)                    jyg
     37  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE   :: flux_tr_wet    ! tracer wet deposit (surface)                    jyg
     38  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE   :: flux_tr_wet_cv ! tracer convective wet deposit (surface)         jyg
    3839  REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra dans pluie,air descente insaturee
    3940  REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel
    … …  
    4849
    4950!$OMP THREADPRIVATE(qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa,d_tr_lessi_nucl)
    50 !$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet,qPr,qDi)
     51!$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav)
     52!$OMP THREADPRIVATE(flux_tr_wet,flux_tr_wet_cv,qPr,qDi)
    5153!$OMP THREADPRIVATE(d_tr_insc,d_tr_bcscav,d_tr_evapls,d_tr_ls,qPrls)
    5254!$OMP THREADPRIVATE(d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv)
    … …  
    6971    ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr))
    7072    ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr))
    71     ALLOCATE(flux_tr_wet(klon,nbtr))
     73    ALLOCATE(flux_tr_wet(klon,nbtr),flux_tr_wet_cv(klon,nbtr))
    7274    ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
    7375    ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
    … …  
    411413          flux_tr_dry(i,it)=0.
    412414          flux_tr_wet(i,it)=0.
     415          flux_tr_wet_cv(i,it)=0.
    413416       ENDDO
    414417    ENDDO
    … …  
    700703                !--with the full array tr_seri even if only item it is processed
    701704
    702                 CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep,                &
    703                      sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,                     &    
    704                      pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM,                    &  
    705                      paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con,                   &
    706                      ccntrAA_3d,ccntrENV_3d,coefcoli_3d,                             &
    707                      d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet,  &
    708                      qDi,qPr,                                                        &
    709                      qPa,qMel,qTrdi,dtrcvMA,Mint,                                    &
     705                CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep,                 &
     706                     sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,                      &   
     707                     pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM,                     & 
     708                     paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con,                    &
     709                     ccntrAA_3d,ccntrENV_3d,coefcoli_3d,                              &
     710                     d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet_cv, &
     711                     qDi,qPr,                                                         &
     712                     qPa,qMel,qTrdi,dtrcvMA,Mint,                                     &
    710713                     zmfd1a,zmfphi2,zmfdam)
    711714
    … …  
    923926                           beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc,d_tr_bcscav,d_tr_evapls,qPrls)
    924927
     928             !total wet deposit = large scale wet deposit + convective wet deposit
     929             DO i = 1, klon
     930               flux_tr_wet(i, it) = flux_tr_wet_cv(i, it) + &
     931                                    qPrls(i, it)*(prfl(i, 1)+psfl(i, 1))*pdtphys
     932             ENDDO  ! i = 1, klon
     933
    925934             !large scale scavenging tendency
    926935             DO k = 1, klev

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/readaerosol_interp.f90

    r5292 r5618  
    1313! 4) Test for negative mass values
    1414
    15 USE chem_mod_h
     15!USE chem_mod_h
    1616    USE clesphys_mod_h
    1717  USE ioipsl
    … …  
    190190        ENDIF
    191191     ELSE  IF (aer_type == 'mix2') THEN
    192         ! Special case using a mix of decenal sulfate file and natrual aerosols
     192        ! Special case using a mix of decenal sulfate file and natural aerosols
    193193        IF (name_aero(id_aero) == 'SO4') THEN
    194194           filename='so4.run '
    … …  
    199199        ENDIF
    200200     ELSE  IF (aer_type == 'mix3') THEN
    201         ! Special case using a mix of annual sulfate file and natrual aerosols
     201        ! Special case using a mix of annual sulfate file and natural aerosols
    202202        IF (name_aero(id_aero) == 'SO4') THEN
    203203           filename='aerosols'

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/readaerosol_mod.f90

    r5536 r5618  
    44
    55  REAL, SAVE :: not_valid=-333.
    6  
     6!$OMP THREADPRIVATE(not_valid) 
    77  INTEGER, SAVE :: nbp_lon_src
    88!$OMP THREADPRIVATE(nbp_lon_src) 
    … …  
    1010!$OMP THREADPRIVATE(nbp_lat_src) 
    1111  REAL, ALLOCATABLE, SAVE    :: psurf_interp(:,:)
     12!psurf_interp is a shared array -> no omp threadprivate
    1213
    1314CONTAINS

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/surf_land_bucket_mod.F90

    r5536 r5618  
    102102    REAL, DIMENSION(klon) :: soilcap, soilflux
    103103    REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
    104     REAL, DIMENSION(klon) :: alb_neig, alb_lim
     104    REAL, DIMENSION(klon) :: alb_neig, alb_lim, icesub
    105105    REAL, DIMENSION(klon) :: zfra
    106106    REAL, DIMENSION(klon) :: radsol       ! total net radiance at surface
    … …  
    239239    CALL fonte_neige( knon, is_ter, knindex, dtime, &
    240240         tsurf, precip_rain, precip_snow, &
    241          snow, qsol, tsurf_new, evap &
     241         snow, qsol, tsurf_new, evap, icesub &
    242242#ifdef ISO   
    243243     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/surf_landice_mod.F90

    r5536 r5618  
    1818       ps, u1, v1, gustiness, rugoro, pctsrf, &
    1919       snow, qsurf, qsol, qbs1, agesno, &
    20        tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, fluxbs, &
     20       tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, icesub_lic, fluxsens, fluxlat, fluxbs, &
    2121       tsurf_new, dflux_s, dflux_l, &
    2222       alt, slope, cloudf, &
    … …  
    4848#endif
    4949 
    50 !FC
    5150    USE clesphys_mod_h
    5251    USE yomcst_mod_h
    53 USE ioipsl_getin_p_mod, ONLY : getin_p
     52    USE ioipsl_getin_p_mod, ONLY : getin_p
    5453    USE lmdz_blowing_snow_ini, ONLY : c_esalt_bs, zeta_bs, pbst_bs, prt_bs, rhoice_bs, rhohard_bs
    5554    USE lmdz_blowing_snow_ini, ONLY : rhofresh_bs, tau_eqsalt_bs, tau_dens0_bs, tau_densmin_bs
    … …  
    6059    USE dimsoil_mod_h, ONLY: nsoilmx
    6160
    62 !    INCLUDE "indicesol.h"
    6361
    6462
    … …  
    121119    REAL, DIMENSION(klon,nsw), INTENT(OUT)        :: alb_dir,alb_dif
    122120!albedo SB <<<
    123     REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
     121    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat, icesub_lic
    124122    REAL, DIMENSION(klon), INTENT(OUT)            :: fluxbs
    125123    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
    … …  
    135133#ifdef ISO
    136134    REAL, DIMENSION(ntiso,klon), INTENT(OUT)     :: xtevap     
    137 !    real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de
    138 !    fonte_neige
    139135#endif
    140136 
    … …  
    163159    REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
    164160    REAL, DIMENSION(klon) :: snow_prec,qsol_prec
    165 !    real, DIMENSION(klon) :: run_off_lic_0_diag
    166161#endif
    167162
    … …  
    257252!  landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ... 
    258253!  landice_opt = 1  : prepare and call INterace Lmdz SISvat (INLANDSIS)
     254!  landice_opt = 2  : skip surf_landice and use orchidee over all land surfaces
    259255!****************************************************************************************
    260256
    … …  
    375371!
    376372!****************************************************************************************
    377 !    beta(:) = 1.0
    378 !    dif_grnd(:) = 0.0
    379373
    380374! Suppose zero surface speed
    … …  
    393387#ifdef ISO
    394388#ifdef ISOVERIF
    395      !write(*,*) 'surf_land_ice 1499'   
    396389     DO i=1,knon
    397390       IF (iso_eau > 0) THEN
    … …  
    427420!
    428421!****************************************************************************************
    429 
    430 !
    431 !IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
    432 !       alb1(1 : knon)  = 0.6 !IM cf FH/GK
    433 !       alb1(1 : knon)  = 0.82
    434 !       alb1(1 : knon)  = 0.77 !211003 Ksta0.77
    435 !       alb1(1 : knon)  = 0.8 !KstaTER0.8 & LMD_ARMIP5
    436 !IM: KstaTER0.77 & LMD_ARMIP6   
    437422
    438423! Attantion: alb1 and alb2 are not the same!
    … …  
    622607    CALL fonte_neige(knon, is_lic, knindex, dtime, &
    623608         tsurf, precip_rain, precip_totsnow, &
    624          snow, qsol, tsurf_new, evap_totsnow &
     609         snow, qsol, tsurf_new, evap_totsnow, icesub_lic &
    625610#ifdef ISO   
    626611     &  ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag     &

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/traclmdz_mod.f90

    r5536 r5618  
    261261    it = 0
    262262    DO iq = 1, nqtot
    263        IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     263       IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    264264       it = it+1
    265265       ! Test if tracer is zero everywhere.
    … …  
    310310   
    311311    USE yomcst_mod_h
    312 USE dimphy
     312    USE dimphy
    313313    USE infotrac_phy, ONLY: nbtr, pbl_flg
    314314    USE strings_mod,  ONLY: int2str

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/tropopause_m.f90

    r5344 r5618  
    2020  USE lmdz_reprobus_wrappers, ONLY: itroprep
    2121  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
     22  USE print_control_mod, ONLY: lunout
    2223
    2324!-------------------------------------------------------------------------------
    … …  
    9394  DO i = 1, klon
    9495    !--- UPPER TROPOPAUSE: |PV|=2PVU POINT STARTING FROM TOP
    95     DO kt=klev-1,1,-1; savkt = kt; IF(ALL(ABS(pvor_cen(i,kt-nadj:kt))<=pv0)) EXIT; END DO
     96!    DO kt=klev-1,1,-1
     97!      savkt = kt
     98!      IF (kt-nadj == 0) THEN
     99!        WRITE(lunout,*)'ABORT_PHYSIC tropopause_m kt= ',kt
     100!        call abort_physic("tropopause_m", " kt = nadj", 1)
     101!      ENDIF
     102!      IF(ALL(ABS(pvor_cen(i,kt-nadj:kt))<=pv0)) THEN
     103!        EXIT
     104!      ENDIF
     105!    END DO
     106    DO kt=klev-1,nadj+1,-1; savkt = kt; IF(ALL(ABS(pvor_cen(i,kt-nadj:kt))<=pv0))  EXIT; END DO
    96107    kt = savkt
    97     IF (kt == 0 ) THEN
    98        call abort_physic("dyn_tropopause", " kt = 1", 1)
    99     ENDIF
    100108    !--- LOWER TROPOPAUSE: |PV|=2PVU POINT STARTING FROM BOTTOM
    101109    DO kb=k0,klev-1;   IF(ALL(ABS(pvor_cen(i,kb:kb+nadj))> pv0)) EXIT; END DO; kb=kb-1

  • TabularUnified LMDZ6/branches/contrails/libf/phylmd/yamada_c.F90

    r5536 r5618  
    138138        CALL getin_p('iflag_tke_diff',iflag_tke_diff)
    139139        allocate(l0(klon))
    140 #define IOPHYS
    141 #ifdef IOPHYS
    142 !        call iophys_ini(timestep)
    143 #endif
    144140        firstcall=.false.
    145141      endif
    146142
    147143   IF (ngrid<=0) RETURN ! Bizarre : on n a pas ce probeleme pour coef_diff_turb
    148 
    149 #ifdef IOPHYS
    150 if (okiophys) then
    151 call iophys_ecrit('q2i',klev,'q2 debut my','m2/s2',q2(:,1:klev))
    152 call iophys_ecrit('kmi',klev,'Kz debut my','m/s2',km(:,1:klev))
    153 endif
    154 #endif
    155144
    156145      nlay=klev

  • TabularUnified LMDZ6/branches/contrails/libf/phylmdiso/phyetat0_mod.F90

    r5536 r5618  
    549549     it = 0
    550550     DO iq = 1, nqtot
    551         IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     551        IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    552552        it = it+1
    553553        tname = tracers(iq)%name

  • TabularUnified LMDZ6/branches/contrails/libf/phylmdiso/phyredem.F90

    r5536 r5618  
    370370       it = 0
    371371       DO iq = 1, nqtot
    372           IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     372          IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    373373          it = it+1
    374374          CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it))

  • TabularUnified LMDZ6/branches/contrails/libf/phylmdiso/physiq_mod.F90

    r5536 r5618  
    3939    USE ioipsl_getin_p_mod, ONLY : getin_p
    4040    USE indice_sol_mod
    41     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,addPhase, ivap, iliq, isol
     41    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,addPhase, ivap, iliq, isol, ibs, icf, irvc
    4242    USE strings_mod,  ONLY: strIdx
    4343    USE iophy
    … …  
    8383    USE lmdz_atke_turbulence_ini, ONLY : atke_ini
    8484    USE lmdz_thermcell_ini, ONLY : thermcell_ini, iflag_thermals_tenv
     85    USE calltherm_mod, ONLY : calltherm
    8586    USE lmdz_thermcell_dtke, ONLY : thermcell_dtke
    8687    USE lmdz_blowing_snow_ini, ONLY : blowing_snow_ini , qbst_bs
    … …  
    133134    USE lmdz_xios, ONLY: xios_set_current_context
    134135    use wxios_mod, ONLY: missing_val, using_xios
     136    USE lmdz_spla_ini, ONLY : spla_ini
    135137
    136138#ifndef CPP_XIOS
    … …  
    290292       cldh, cldl,cldm, cldq, cldt,      &
    291293       JrNt,                             &
    292        dthmin, evap, snowerosion,fder, plcl, plfc,   &
     294       dthmin, evap, snowerosion, icesub_lic, fder, plcl, plfc,   &
    293295       prw, prlw, prsw, prbsw, water_budget,         &
    294296       s_lcl, s_pblh, s_pblt, s_therm,   &
    … …  
    579581    !======================================================================
    580582    !
    581     ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional)
    582 !    INTEGER,SAVE :: ivap, iliq, isol, irneb, ibs
    583 !!$OMP THREADPRIVATE(ivap, iliq, isol, irneb, ibs)
    584 ! Camille Risi 25 juillet 2023: ivap,iliq,isol deja definis dans infotrac_phy.
    585 ! Et ils sont utiles ailleurs que dans physiq_mod (ex:
    586 ! reevap -> je commente les 2 lignes au dessus et je laisse la definition
    587 ! plutot dans infotrac_phy
    588     INTEGER,SAVE :: irneb, ibs, icf,irvc
    589 !$OMP THREADPRIVATE(irneb, ibs, icf,irvc)
    590 !
    591583    !
    592584    ! Variables argument:
    … …  
    11211113
    11221114    REAL picefra(klon,klev)
    1123     REAL zrel_oro(klon)
     1115    REAL nm_oro(klon)
    11241116    !IM cf. AM 081204 END
    11251117    !
    … …  
    14591451
    14601452    IF (first) THEN
    1461        ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
    1462        iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
    1463        isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
    1464        ibs  = strIdx(tracers(:)%name, addPhase('H2O', 'b'))
    1465        icf  = strIdx(tracers(:)%name, addPhase('H2O', 'f'))
    1466        irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c'))
    14671453!       CALL init_etat0_limit_unstruct
    14681454       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
    … …  
    20312017IF (CPPKEY_DUST) THEN
    20322018       ! Quand on utilise SPLA, on force iflag_phytrac=1
     2019       CALL spla_ini(is_oce,RNAVO,RG,RD,RCPD,RLVTT,RLSTT,RETV,RTT,              &
     2020               R2ES,R3LES,R3IES,R4LES,R4IES,R5LES,R5IES,RVTMP2)
    20332021       CALL phytracr_spl_out_init()
    20342022       CALL phys_output_write_spl(itap, pdtphys, paprs, pphis,                  &
    … …  
    33183306                                !albedo SB >>>
    33193307                                ! albsol1,   albsol2,   sens,    evap,      &
    3320             albsol_dir,   albsol_dif,   sens,    evap, snowerosion, & 
     3308            albsol_dir,   albsol_dif,   sens,    evap, snowerosion, icesub_lic, & 
    33213309                                !albedo SB <<<
    33223310            albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
    … …  
    47484736          endif
    47494737
    4750           CALL calltherm(pdtphys &
     4738          CALL calltherm(itap, pdtphys &
    47514739               ,pplay,paprs,pphi,weak_inversion &
    47524740                        ! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
    … …  
    62836271    ! a l'echelle sous-maille:
    62846272    !
     6273   
     6274    ! calculation of nm_oro
     6275    DO i=1,klon
     6276          ! nm_oro is a proxy for the number of subgrid scale mountains
     6277          ! -> condition on nm_oro can deactivate the lifting on tilted planar terrains
     6278          !    such as ice sheets (work by V. Wiener)
     6279          ! in such a case, the SSO scheme should activate only where nm_oro>0 i.e. by setting
     6280          ! nm_oro_t=0.
     6281          nm_oro(i)=zsig(i)*sqrt(cell_area(i)*(pctsrf(i,is_ter)+pctsrf(i,is_lic)))/(4.*MAX(zstd(i),1.e-8))-1.
     6282    END DO
     6283
    62856284    IF (prt_level .GE.10) THEN
    62866285       print *,' call orography ? ', ok_orodr
    62876286    ENDIF
    6288     !
     6287
    62896288    IF (ok_orodr) THEN
    62906289       !
    … …  
    62936292       DO i=1,klon
    62946293          itest(i)=0
    6295           zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i)))
    6296           !zrel_oro: relative mountain height wrt relief explained by mean slope
    6297           ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains
    6298           !    such as ice sheets (work by V. Wiener)
    62996294          ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to
    63006295          ! earn computation time but they are not physical.
    6301           IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
     6296          IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN
    63026297             itest(i)=1
    63036298             igwd=igwd+1
    … …  
    63526347       DO i=1,klon
    63536348          itest(i)=0
    6354           !zrel_oro: relative mountain height wrt relief explained by mean slope
    6355           ! -> condition on zrel_oro can deactivate the lifting on tilted planar terrains
    6356           !    such as ice sheets (work by V. Wiener)
    6357           zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i)))
    6358           IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
     6349          IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN
    63596350             itest(i)=1
    63606351             igwd=igwd+1
    … …  
    66306621! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE
    66316622! Mais attention, cela ne va pas dans le sens de la conservation de l'energie!
    6632           IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
     6623          IF ((zstd(i).GT.1.0) .AND.(nm_oro(i).GT.nm_oro_t)) THEN
    66336624             itest(i)=1
    66346625             igwd=igwd+1
    … …  
    66426633       DO i=1,klon
    66436634          itest(i)=0
    6644         IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN
     6635        IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN
    66456636             itest(i)=1
    66466637             igwd=igwd+1
Note: See TracChangeset for help on using the changeset viewer.