Changeset 5203 for LMDZ6/branches/cirrus/libf
- Timestamp:
- Sep 20, 2024, 1:10:18 PM (7 weeks ago)
- Location:
- LMDZ6/branches/cirrus
- Files:
-
- 24 edited
-
. (modified) (1 prop)
-
libf/dyn3d/check_isotopes.F90 (modified) (4 diffs)
-
libf/dyn3d/dynetat0.F90 (modified) (8 diffs)
-
libf/dyn3d/iniacademic.F90 (modified) (5 diffs)
-
libf/dyn3d/qminimum.F (modified) (1 diff)
-
libf/dyn3d_common/infotrac.F90 (modified) (18 diffs)
-
libf/dyn3d_common/iso_verif_dyn.F (modified) (2 diffs)
-
libf/dyn3dmem/check_isotopes_loc.F90 (modified) (4 diffs)
-
libf/dyn3dmem/dynetat0_loc.F90 (modified) (7 diffs)
-
libf/dyn3dmem/iniacademic_loc.F90 (modified) (5 diffs)
-
libf/dyn3dmem/qminimum_loc.F (modified) (1 diff)
-
libf/phylmd/infotrac_phy.F90 (modified) (18 diffs)
-
libf/phylmd/lmdz_lscp.F90 (modified) (1 diff)
-
libf/phylmd/lmdz_wake.F90 (modified) (27 diffs)
-
libf/phylmd/lmdz_wake_ini.F90 (modified) (1 diff)
-
libf/phylmd/phyetat0_mod.F90 (modified) (1 diff)
-
libf/phylmd/phys_local_var_mod.F90 (modified) (3 diffs)
-
libf/phylmd/physiq_mod.F90 (modified) (4 diffs)
-
libf/phylmd/surf_landice_mod.F90 (modified) (5 diffs)
-
libf/phylmdiso/isotopes_mod.F90 (modified) (7 diffs)
-
libf/phylmdiso/isotopes_routines_mod.F90 (modified) (2 diffs)
-
libf/phylmdiso/isotrac_mod.F90 (modified) (1 diff)
-
libf/phylmdiso/phyetat0_mod.F90 (modified) (1 diff)
-
libf/phylmdiso/physiq_mod.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/cirrus
- Property svn:mergeinfo changed
/LMDZ6/trunk merged: 5181,5183-5184,5188-5191,5196-5201
- Property svn:mergeinfo changed
-
LMDZ6/branches/cirrus/libf/dyn3d/check_isotopes.F90
r5202 r5203 3 3 USE infotrac, ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, & 4 4 ntiso, iH2O, nzone, tracers, isoName, itZonIso, getKey 5 #ifdef CPP_IOIPSL 6 USE ioipsl, ONLY: getin 7 #else 8 USE ioipsl_getincom, ONLY: getin 9 #endif 5 10 IMPLICIT NONE 6 11 include "dimensions.h" … … 20 25 deltaDmin =-999.0, & 21 26 ridicule = 1e-12 22 INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, & 23 iso_O17, iso_HTO 24 LOGICAL, SAVE :: first=.TRUE. 25 LOGICAL, PARAMETER :: tnat1=.TRUE. 27 INTEGER, SAVE :: iso_eau, iso_O17, iso_O18, iso_HDO, iso_HTO 28 LOGICAL, SAVE :: ltnat1, first=.TRUE. 26 29 27 30 modname='check_isotopes' … … 30 33 IF(niso == 0) RETURN !--- No isotopes => finished 31 34 IF(first) THEN 35 ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1) 36 ALLOCATE(tnat(niso)) 32 37 iso_eau = strIdx(isoName,'H216O') 38 iso_O17 = strIdx(isoName,'H217O') 39 iso_O18 = strIdx(isoName,'H218O') 33 40 iso_HDO = strIdx(isoName,'HDO') 34 iso_O18 = strIdx(isoName,'H218O')35 iso_O17 = strIdx(isoName,'H217O')36 41 iso_HTO = strIdx(isoName,'HTO') 37 if (tnat1) then38 39 else42 IF(ltnat1) THEN 43 tnat(:)=1.0 44 ELSE 40 45 IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1) 41 endif46 END IF 42 47 first = .FALSE. 43 48 END IF … … 51 56 DO k = 1, llm 52 57 DO i = 1, ip1jmp1 53 IF(ABS(q(i,k,iq)) < borne) CYCLE58 IF(ABS(q(i,k,iq)) <= borne) CYCLE 54 59 WRITE(msg1,'(s,"(",i0,",",i0,",",i0,") = ",ES12.4)')TRIM(isoName(ixt)),i,k,iq,q(i,k,iq) 55 60 CALL msg(msg1, modname) -
LMDZ6/branches/cirrus/libf/dyn3d/dynetat0.F90
r5202 r5203 6 6 ! Purpose: Initial state reading. 7 7 !------------------------------------------------------------------------------- 8 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName 8 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName, & 9 new2oldH2O, newHNO3, oldHNO3, getKey 9 10 USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str 10 11 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, & 11 12 NF90_CLOSE, NF90_GET_VAR, NF90_NoErr 12 USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey13 13 USE control_mod, ONLY: planet_type 14 14 USE assert_eq_m, ONLY: assert_eq … … 19 19 USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time 20 20 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 21 #ifdef CPP_IOIPSL 22 USE IOIPSL, ONLY: getin 23 #else 24 USE ioipsl_getincom, ONLY: getin 25 #endif 21 26 22 27 IMPLICIT NONE … … 42 47 INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase 43 48 REAL :: time, tnat, alpha_ideal, tab_cntrl(length) !--- RUN PARAMS TABLE 44 LOGICAL :: lSkip, ll 45 LOGICAL,PARAMETER :: tnat1=.TRUE. 49 LOGICAL :: lSkip, ll, ltnat1 46 50 !------------------------------------------------------------------------------- 47 51 modname="dynetat0" … … 116 120 var="temps" 117 121 IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN 118 CALL msg(' missing field <temps> ; trying with <Time>', modname)122 CALL msg('Missing field <temps> ; trying with <Time>', modname) 119 123 var="Time" 120 124 CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) … … 133 137 ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr !--- DETECT OLD REPRO start.nc FILE 134 138 #endif 139 ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1) 135 140 DO iq=1,nqtot 136 141 var = tracers(iq)%name … … 148 153 !-------------------------------------------------------------------------------------------------------------------------- 149 154 ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN !=== TRY WITH ALTERNATE NAME 150 CALL msg(' Tracer <'//TRIM(var)//'> is missing=> initialized to <'//TRIM(oldVar)//'>', modname)155 CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to <'//TRIM(oldVar)//'>', modname) 151 156 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",oldVar) 152 157 !-------------------------------------------------------------------------------------------------------------------------- … … 156 161 iqParent = tracers(iq)%iqParent 157 162 IF(tracers(iq)%iso_iZone == 0) THEN 158 if (tnat1) then159 tnat=1.0160 alpha_ideal=1.0161 write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'162 else163 IF(ltnat1) THEN 164 tnat = 1.0 165 alpha_ideal = 1.0 166 CALL msg(' !!! Beware: alpha_ideal put to 1 !!!', modname) 167 ELSE 163 168 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 164 169 CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) 165 endif166 CALL msg(' Tracer <'//TRIM(var)//'> is missing=> initialized with a simplified Rayleigh distillation law.', modname)170 END IF 171 CALL msg('Missing tracer <'//TRIM(var)//'> => initialized with a simplified Rayleigh distillation law.', modname) 167 172 q(:,:,:,iq) = q(:,:,:,iqParent)*tnat*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal-1.) 168 173 ELSE 169 CALL msg(' Tracer <'//TRIM(var)//'> is missing=> initialized to its parent isotope concentration.', modname)174 CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to its parent isotope concentration.', modname) 170 175 ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à 171 176 ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme … … 181 186 !-------------------------------------------------------------------------------------------------------------------------- 182 187 ELSE !=== MISSING: SET TO 0 183 CALL msg(' Tracer <'//TRIM(var)//'> is missing=> initialized to zero', modname)188 CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to zero', modname) 184 189 q(:,:,:,iq)=0. 185 190 !-------------------------------------------------------------------------------------------------------------------------- -
LMDZ6/branches/cirrus/libf/dyn3d/iniacademic.F90
r5202 r5203 5 5 6 6 USE filtreg_mod, ONLY: inifilr 7 USE infotrac, ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName 7 USE infotrac, ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName, addPhase 8 8 USE control_mod, ONLY: day_step,planet_type 9 9 use exner_hyb_m, only: exner_hyb … … 21 21 USE temps_mod, ONLY: annee_ref, day_ini, day_ref 22 22 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 23 USE readTracFiles_mod, ONLY: addPhase24 23 use netcdf, only : NF90_NOWRITE,NF90_OPEN,NF90_NOERR,NF90_INQ_VARID 25 24 use netcdf, only : NF90_CLOSE, NF90_GET_VAR … … 80 79 81 80 REAL zdtvr, tnat, alpha_ideal 82 LOGICAL ,PARAMETER :: tnat1=.true.81 LOGICAL :: ltnat1 83 82 84 83 character(len=*),parameter :: modname="iniacademic" … … 309 308 ! bulk initialization of tracers 310 309 if (planet_type=="earth") then 310 ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1) 311 311 ! Earth: first two tracers will be water 312 312 do iq=1,nqtot … … 322 322 iqParent = tracers(iq)%iqParent 323 323 IF(tracers(iq)%iso_iZone == 0) THEN 324 if (tnat1) then325 tnat=1.0326 alpha_ideal=1.0327 write(*,*) 'Attention dans iniacademic: alpha_ideal=1'328 else324 IF(ltnat1) THEN 325 tnat = 1.0 326 alpha_ideal = 1.0 327 WRITE(lunout, *)'In '//TRIM(modname)//': !!! Beware: alpha_ideal put to 1 !!!' 328 ELSE 329 329 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 330 330 CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) 331 endif331 END IF 332 332 q(:,:,iq) = q(:,:,iqParent)*tnat*(q(:,:,iqParent)/30.e-3)**(alpha_ideal-1.) 333 333 ELSE !IF(tracers(iq)%iso_iZone == 0) THEN -
LMDZ6/branches/cirrus/libf/dyn3d/qminimum.F
r5202 r5203 4 4 SUBROUTINE qminimum( q,nqtot,deltap ) 5 5 6 USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers6 USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers, addPhase 7 7 USE strings_mod, ONLY: strIdx 8 USE readTracFiles_mod, ONLY: addPhase9 8 IMPLICIT none 10 9 c -
LMDZ6/branches/cirrus/libf/dyn3d_common/infotrac.F90
r5202 r5203 7 7 delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, & 8 8 addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck 9 USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3 9 10 IMPLICIT NONE 10 11 … … 16 17 PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions 17 18 PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys 19 PUBLIC :: new2oldH2O, newHNO3, oldHNO3 !--- For backwards compatibility in dynetat0 20 PUBLIC :: addPhase, delPhase !--- Add/remove the phase from the name of a tracer 18 21 19 22 !=== FOR ISOTOPES: General … … 21 24 PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index 22 25 !=== FOR ISOTOPES: Specific to water 23 PUBLIC :: iH2O !--- H2O isotopes class index26 PUBLIC :: iH2O !--- Value of "ixIso" for "H2O" isotopes class 24 27 PUBLIC :: min_qParent, min_qMass, min_ratio !--- Min. values for various isotopic quantities 25 28 !=== FOR ISOTOPES: Depending on the selected isotopes family 26 PUBLIC :: isotope , isoKeys !--- Selected isotopes database + associated keys (cf.getKey)27 PUBLIC :: iso Name, isoZone, isoPhas !--- Isotopes andtagging zones names, phases28 PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number29 PUBLIC :: itZonIso !--- i dx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)30 PUBLIC :: iqIsoPha !--- i dx "iq" (in "qx") = function(isotope idx, phase idx) + aliases29 PUBLIC :: isotope !--- Selected isotopes database (argument of getKey) 30 PUBLIC :: isoKeys, isoName, isoZone, isoPhas !--- Isotopes keys & names, tagging zones names, phases 31 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) 31 34 PUBLIC :: isoCheck !--- Run isotopes checking routines 32 35 !=== FOR BOTH TRACERS AND ISOTOPES … … 36 39 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 37 40 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 38 ! | phases: H2O_[gls ]| isotopes | | | for higher order schemes |41 ! | phases: H2O_[glsrb]| isotopes | | | for higher order schemes | 39 42 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 40 43 ! | | | | | | … … 61 64 ! |-------------+------------------------------------------------------+-------------+------------------------+ 62 65 ! | name | Name (short) | tname | | 66 ! | keys | key/val pairs accessible with "getKey" routine | / | | 63 67 ! | gen0Name | Name of the 1st generation ancestor | / | | 64 68 ! | parent | Name of the parent | / | | 65 69 ! | longName | Long name (with adv. scheme suffix) for outputs | ttext | | 66 70 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 67 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 71 ! | phase | Phases list ("g"as / "l"iquid / "s"olid | | [g|l|s|r|b] | 72 ! | | "r"(cloud) / "b"lowing) | / | | 68 73 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 69 74 ! | iGeneration | Generation (>=1) | / | | … … 72 77 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 73 78 ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | 74 ! | keys | key/val pairs accessible with "getKey" routine | / | |75 79 ! | iadv | Advection scheme number | iadv | 1,2,10-20(exc.15,19),30| 76 ! | isAdvected | advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values |77 ! | isInPhysics | tracers not extracted from the main table in physics | / | nqtottr .TRUE. values |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 | 78 82 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 79 83 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | … … 91 95 ! | trac | ntiso | Isotopes + tagging tracers list + number | / | ntraciso | | 92 96 ! | zone | nzone | Geographic tagging zones list + number | / | ntraceurs_zone | | 93 ! | phase | nphas | Phases list + number | | [g ][l][s], 1:3|97 ! | phase | nphas | Phases list + number | | [g|l|s|r|b] 1:5 | 94 98 ! | iqIsoPha | Index in "qx" = f(name(1:ntiso)),phas) | iqiso | 1:nqtot | 95 99 ! | itZonIso | Index in "trac(1:ntiso)"= f(zone, name(1:niso)) | index_trac | 1:ntiso | … … 99 103 100 104 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 101 INTEGER, SAVE :: nqtot, &!--- Tracers nb in dynamics (incl. higher moments + H2O)102 nbtr, &!--- Tracers nb in physics (excl. higher moments + H2O)103 nqo, &!--- Number of water phases105 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 104 108 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 105 109 nqCO2 !--- Number of tracers of CO2 (ThL) 106 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type 110 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) 107 111 108 112 !=== VARIABLES FOR INCA 109 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr)110 pbl_flg(:) !--- Boundary layer activation ; needed for INCA(nbtr)113 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: & 114 conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr) 111 115 112 116 CONTAINS … … 115 119 USE control_mod, ONLY: planet_type 116 120 #ifdef REPROBUS 117 USE CHEM_REP, 121 USE CHEM_REP, ONLY: Init_chem_rep_trac 118 122 #endif 119 123 IMPLICIT NONE … … 160 164 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 161 165 TYPE(trac_type), POINTER :: t1, t(:) 162 CHARACTER(LEN=maxlen), ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type(s), parsed version 163 166 CHARACTER(LEN=maxlen), ALLOCATABLE :: types_trac(:) !--- Keywords for tracers type(s), parsed version 164 167 CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac" 165 168 !------------------------------------------------------------------------------------------------------------------------------ … … 171 174 descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP'] 172 175 descrq(30) = 'PRA' 173 174 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)175 176 176 177 lerr=strParse(type_trac, '|', types_trac, n=nt) 177 178 IF (nt .GT. 1) THEN 178 179 IF (nt .GT. 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) 179 if(nt .EQ. 2) type_trac=types_trac(2)180 IF (nt .EQ. 2) type_trac=types_trac(2) 180 181 ENDIF 181 182 183 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 182 184 183 185 … … 213 215 214 216 !============================================================================================================================== 215 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)216 !============================================================================================================================== 217 texp = type_trac !=== EXPANDED VERSION OF "type_trac", WITH "|" SEPARATOR217 ! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT 218 !============================================================================================================================== 219 texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" 218 220 IF(texp == 'inco') texp = 'co2i|inca' 219 221 IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) 220 221 !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE222 222 IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 223 223 ttp = type_trac; IF(fType /= 1) ttp = texp 224 225 224 IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 226 !--------------------------------------------------------------------------------------------------------------------------- 227 IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1) 228 !--------------------------------------------------------------------------------------------------------------------------- 229 IF(fType == 1 .AND. ANY(['inca','inco']==type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def" 225 226 !============================================================================================================================== 227 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. 228 !============================================================================================================================== 229 !--------------------------------------------------------------------------------------------------------------------------- 230 IF(fType == 0) CALL abort_gcm(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1) 231 !--------------------------------------------------------------------------------------------------------------------------- 232 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def" 230 233 !--------------------------------------------------------------------------------------------------------------------------- 231 234 #ifdef INCA … … 264 267 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 265 268 !--------------------------------------------------------------------------------------------------------------------------- 266 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' & 267 .AND. tracers(:)%component == 'lmdz') !--- Number of water phases 268 nqtrue = SIZE(tracers) !--- Total number of "true" tracers 269 nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' & 270 .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac 269 nqtrue = SIZE(tracers) !--- "true" tracers 270 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases 271 nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac 272 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 271 273 #ifdef INCA 272 nqINCA =COUNT(tracers(:)%component == 'inca')273 #endif 274 lerr = getKey('hadv', hadv, ky=tracers(:)%keys)275 lerr = getKey('vadv', vadv, ky=tracers(:)%keys)274 nqINCA = COUNT(tracers(:)%component == 'inca') 275 #endif 276 IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "hadv"', 1) 277 IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "vadv"', 1) 276 278 !--------------------------------------------------------------------------------------------------------------------------- 277 279 END IF … … 279 281 280 282 #ifdef REPROBUS 281 !--- Transfert the number of tracers to Reprobus282 283 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 283 284 #endif 284 #endif 285 285 286 !============================================================================================================================== 286 287 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). … … 332 333 IF(iad == -1) CALL abort_gcm(modname, msg1, 1) 333 334 334 !--- SET FIELDS %longName, %iadv, %isAdvected, %isInPhysics335 !--- SET FIELDS longName, iadv, isAdvected, isInPhysics 335 336 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 336 337 t1%iadv = iad 337 338 t1%isAdvected = iad >= 0 338 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' & 339 .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD... 339 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O 340 340 ttr(iq) = t1 341 341 … … 347 347 ttr(jq+1:jq+nm) = t1 348 348 ttr(jq+1:jq+nm)%name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 349 ttr(jq+1:jq+nm)%gen0Name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 349 350 ttr(jq+1:jq+nm)%parent = [ (TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 350 351 ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] … … 356 357 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 357 358 358 !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen359 !--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren 359 360 IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem with tracers indices update', 1) 360 361 361 362 !=== TEST ADVECTION SCHEME 362 DO iq =1,nqtot ; t1 => tracers(iq); iad = t1%iadv363 DO iq = 1, nqtot ; t1 => tracers(iq); iad = t1%iadv 363 364 364 365 !--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers) … … 405 406 #endif 406 407 t => tracers 407 CALL msg('Information stored in infotrac :', modname) 408 409 IF(dispTable('isssssssssiiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & 410 'isPh', 'isAd', 'iadv', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & 411 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), & 412 bool2str(t%isAdvected)), & 408 CALL msg('Information stored in '//TRIM(modname)//': ', modname) 409 IF(dispTable('isssssssiiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & 410 'iAdv', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & 411 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component), & 413 412 cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & 414 413 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & -
LMDZ6/branches/cirrus/libf/dyn3d_common/iso_verif_dyn.F
r4325 r5203 64 64 function iso_verif_aberrant_nostop 65 65 : (x,iso,q,err_msg) 66 #ifdef CPP_IOIPSL 67 USE IOIPSL, ONLY: getin 68 #else 69 USE ioipsl_getincom, ONLY: getin 70 #endif 66 71 USE infotrac, ONLY: isoName, getKey 67 72 implicit none … … 77 82 parameter (qmin=1e-11) 78 83 parameter (deltaDmax=200.0,deltaDmin=-999.9) 84 LOGICAL, SAVE :: ltnat1 85 LOGICAL, SAVE :: lFirst=.TRUE. 79 86 80 87 ! output 81 88 integer iso_verif_aberrant_nostop 82 89 90 IF(lFirst) THEN 91 ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1) 92 lFirst = .FALSE. 93 END IF 83 94 iso_verif_aberrant_nostop=0 84 95 85 96 ! verifier que HDO est raisonable 86 97 if (q.gt.qmin) then 87 IF(getKey('tnat', tnat, isoName(iso))) THEN 98 IF(ltnat1) THEN 99 tnat = 1.0 100 ELSE IF(getKey('tnat', tnat, isoName(iso))) THEN 88 101 err_msg = 'Missing isotopic parameter "tnat"' 89 102 iso_verif_aberrant_nostop=1 -
LMDZ6/branches/cirrus/libf/dyn3dmem/check_isotopes_loc.F90
r5202 r5203 4 4 USE infotrac, ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, & 5 5 ntiso, iH2O, nzone, tracers, isoName, itZonIso, getKey 6 #ifdef CPP_IOIPSL 7 USE ioipsl, ONLY: getin 8 #else 9 USE ioipsl_getincom, ONLY: getin 10 #endif 6 11 IMPLICIT NONE 7 12 include "dimensions.h" … … 21 26 deltaDmin =-999.0, & 22 27 ridicule = 1e-12 23 INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, & !--- OpenMP shared variables 24 iso_O17, iso_HTO 28 INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO 29 !$OMP THREADPRIVATE(iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO) 30 LOGICAL :: ltnat1 25 31 LOGICAL, SAVE :: first=.TRUE. 26 LOGICAL, PARAMETER :: tnat1=.TRUE.27 32 !$OMP THREADPRIVATE(first) 28 33 … … 33 38 IF(first) THEN 34 39 !$OMP MASTER 40 ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1) 41 ALLOCATE(tnat(niso)) 35 42 iso_eau = strIdx(isoName,'H216O') 43 iso_O17 = strIdx(isoName,'H217O') 44 iso_O18 = strIdx(isoName,'H218O') 36 45 iso_HDO = strIdx(isoName,'HDO') 37 iso_O18 = strIdx(isoName,'H218O')38 iso_O17 = strIdx(isoName,'H217O')39 46 iso_HTO = strIdx(isoName,'HTO') 40 if (tnat1) then41 42 else47 IF(ltnat1) THEN 48 tnat(:)=1.0 49 ELSE 43 50 IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1) 44 endif51 END IF 45 52 !$OMP END MASTER 46 53 !$OMP BARRIER … … 57 64 DO k = 1, llm 58 65 DO i = ijb, ije 59 IF(ABS(q(i,k,iq)) <=borne) CYCLE66 IF(ABS(q(i,k,iq)) <= borne) CYCLE 60 67 WRITE(msg1,'(s,"(",i0,",",i0,",",i0,") = ",ES12.4)')TRIM(isoName(ixt)),i,k,iq,q(i,k,iq) 61 68 CALL msg(msg1, modname) -
LMDZ6/branches/cirrus/libf/dyn3dmem/dynetat0_loc.F90
r5202 r5203 7 7 !------------------------------------------------------------------------------- 8 8 USE parallel_lmdz 9 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName 9 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName, & 10 new2oldH2O, newHNO3, oldHNO3, getKey 10 11 USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx 11 12 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, & 12 13 NF90_CLOSE, NF90_GET_VAR, NF90_INQUIRE_VARIABLE, NF90_NoErr 13 USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey14 14 USE control_mod, ONLY: planet_type 15 15 USE assert_eq_m, ONLY: assert_eq … … 20 20 USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time 21 21 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 22 #ifdef CPP_IOIPSL 23 USE IOIPSL, ONLY: getin 24 #else 25 USE ioipsl_getincom, ONLY: getin 26 #endif 22 27 23 28 IMPLICIT NONE … … 47 52 REAL, ALLOCATABLE :: ucov_glo(:,:), q_glo(:,:), phis_glo(:) 48 53 REAL, ALLOCATABLE :: teta_glo(:,:) 49 LOGICAL :: lSkip, ll 50 LOGICAL,PARAMETER :: tnat1=.TRUE. 54 LOGICAL :: lSkip, ll, ltnat1 51 55 !------------------------------------------------------------------------------- 52 56 modname="dynetat0_loc" … … 158 162 ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr !--- DETECT OLD REPRO start.nc FILE 159 163 #endif 164 ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1) 160 165 DO iq=1,nqtot 161 166 var = tracers(iq)%name … … 173 178 !-------------------------------------------------------------------------------------------------------------------------- 174 179 ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN !=== TRY WITH ALTERNATE NAME 175 CALL msg(' Tracer <'//TRIM(var)//'> is missing=> initialized to <'//TRIM(oldVar)//'>', modname)180 CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to <'//TRIM(oldVar)//'>', modname) 176 181 CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:) 177 182 !-------------------------------------------------------------------------------------------------------------------------- … … 181 186 iqParent = tracers(iq)%iqParent 182 187 IF(tracers(iq)%iso_iZone == 0) THEN 183 if (tnat1) then184 tnat=1.0185 alpha_ideal=1.0186 write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'187 else188 IF(ltnat1) THEN 189 tnat = 1.0 190 alpha_ideal = 1.0 191 CALL msg(' !!! Beware: alpha_ideal put to 1 !!!', modname) 192 ELSE 188 193 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 189 194 CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) 190 endif191 CALL msg(' Tracer <'//TRIM(var)//'> is missing=> initialized with a simplified Rayleigh distillation law.', modname)195 END IF 196 CALL msg('Missing tracer <'//TRIM(var)//'> => initialized with a simplified Rayleigh distillation law.', modname) 192 197 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.) 193 198 ! Camille 9 mars 2023: point de vigilence: initialisation incohérente 194 199 ! avec celle de xt_ancien dans la physiq. 195 200 ELSE 196 CALL msg(' Tracer <'//TRIM(var)//'> is missing=> initialized to its parent isotope concentration.', modname)201 CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to its parent isotope concentration.', modname) 197 202 ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à 198 203 ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme … … 208 213 !-------------------------------------------------------------------------------------------------------------------------- 209 214 ELSE !=== MISSING: SET TO 0 210 CALL msg(' Tracer <'//TRIM(var)//'> is missing=> initialized to zero', modname)215 CALL msg('missing tracer <'//TRIM(var)//'> => initialized to zero', modname) 211 216 q(ijb_u:ije_u,:,iq)=0. 212 217 !-------------------------------------------------------------------------------------------------------------------------- -
LMDZ6/branches/cirrus/libf/dyn3dmem/iniacademic_loc.F90
r5202 r5203 5 5 6 6 USE filtreg_mod, ONLY: inifilr 7 USE infotrac, ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName 7 USE infotrac, ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName, addPhase 8 8 USE control_mod, ONLY: day_step,planet_type 9 9 use exner_hyb_m, only: exner_hyb … … 22 22 USE temps_mod, ONLY: annee_ref, day_ini, day_ref 23 23 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 24 USE readTracFiles_mod, ONLY: addPhase25 24 use netcdf, only : NF90_NOWRITE,NF90_OPEN,NF90_NOERR,NF90_INQ_VARID 26 25 use netcdf, only : NF90_CLOSE, NF90_GET_VAR … … 85 84 86 85 REAL zdtvr, tnat, alpha_ideal 87 LOGICAL ,PARAMETER :: tnat1=.true.86 LOGICAL :: ltnat1 88 87 89 88 character(len=*),parameter :: modname="iniacademic" … … 311 310 ! bulk initialization of tracers 312 311 if (planet_type=="earth") then 312 ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1) 313 313 ! Earth: first two tracers will be water 314 314 do iq=1,nqtot … … 324 324 iqParent = tracers(iq)%iqParent 325 325 IF(tracers(iq)%iso_iZone == 0) THEN 326 if (tnat1) then327 tnat=1.0328 alpha_ideal=1.0329 write(*,*) 'Attention dans iniacademic: alpha_ideal=1'330 else326 IF(ltnat1) THEN 327 tnat = 1.0 328 alpha_ideal = 1.0 329 WRITE(lunout, *) 'In '//TRIM(modname)//': !!! Beware: alpha_ideal put to 1 !!!' 330 ELSE 331 331 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 332 332 CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) 333 endif333 END IF 334 334 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.) 335 335 ELSE !IF(tracers(iq)%iso_iZone == 0) THEN -
LMDZ6/branches/cirrus/libf/dyn3dmem/qminimum_loc.F
r5202 r5203 4 4 SUBROUTINE qminimum_loc( q,nqtot,deltap ) 5 5 USE parallel_lmdz 6 USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers, 6 USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers, addPhase, 7 7 & isoCheck, min_qParent 8 8 USE strings_mod, ONLY: strIdx 9 USE readTracFiles_mod, ONLY: addPhase10 9 IMPLICIT none 11 10 c -
LMDZ6/branches/cirrus/libf/phylmd/infotrac_phy.F90
r5202 r5203 7 7 delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, & 8 8 addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck 9 USE readTracFiles_mod, ONLY: new2oldH2O 9 10 IMPLICIT NONE 10 11 … … 16 17 PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions 17 18 PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys 18 #ifdef CPP_StratAer 19 PUBLIC :: new2oldH2O !--- For backwards compatibility in phyetat0 20 PUBLIC :: addPhase, delPhase !--- Add/remove the phase from the name of a tracer 21 #if defined CPP_StratAer || defined REPROBUS 19 22 PUBLIC :: nbtr_bin, nbtr_sulgas !--- Number of aerosols bins and sulfur gases for StratAer model 20 23 PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat 21 24 #endif 22 25 23 !=== FOR WATER24 PUBLIC :: ivap, iliq, isol25 26 !=== FOR ISOTOPES: General 26 27 PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families 27 28 PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index 28 29 !=== FOR ISOTOPES: Specific to water 29 PUBLIC :: iH2O !--- H2O isotopes class index 30 PUBLIC :: iH2O !--- Value of "ixIso" for "H2O" isotopes class 31 PUBLIC :: ivap, iliq, isol 30 32 !=== FOR ISOTOPES: Depending on the selected isotopes family 31 PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey) 32 PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases 33 PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number 34 PUBLIC :: itZonIso !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx) 35 PUBLIC :: iqIsoPha !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases 36 PUBLIC :: iqWIsoPha !--- Same as iqIsoPha but with normal water phases 37 33 PUBLIC :: isotope !--- Selected isotopes database (argument of getKey) 34 PUBLIC :: isoKeys, isoName, isoZone, isoPhas !--- Isotopes keys & names, tagging zones names, phases 35 PUBLIC :: niso, ntiso, nzone, nphas !--- Number of " " 36 PUBLIC :: itZonIso !--- Index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx) 37 PUBLIC :: iqIsoPha !--- Index "iq" in "qx" = f(isotope idx, phase idx) 38 PUBLIC :: iqWIsoPha !--- Same as iqIsoPha but with normal water phases 38 39 PUBLIC :: isoCheck !--- Run isotopes checking routines 39 40 !=== FOR BOTH TRACERS AND ISOTOPES … … 43 44 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 44 45 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 45 ! | phases: H2O_[gls ]| isotopes | | | for higher order schemes |46 ! | phases: H2O_[glsrb]| isotopes | | | for higher order schemes | 46 47 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 47 48 ! | | | | | | … … 68 69 ! |-------------+------------------------------------------------------+-------------+------------------------+ 69 70 ! | name | Name (short) | tname | | 71 ! | keys | key/val pairs accessible with "getKey" routine | / | | 70 72 ! | gen0Name | Name of the 1st generation ancestor | / | | 71 73 ! | parent | Name of the parent | / | | 72 74 ! | longName | Long name (with adv. scheme suffix) for outputs | ttext | | 73 75 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 74 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 76 ! | phase | Phases list ("g"as / "l"iquid / "s"olid | | [g|l|s|r|b] | 77 ! | | "r"(cloud) / "b"lowing) | / | | 75 78 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 76 79 ! | iGeneration | Generation (>=1) | / | | … … 79 82 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 80 83 ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | 81 ! | keys | key/val pairs accessible with "getKey" routine | / | | 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 | 84 ! | isAdvected | Advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | 85 ! | isInPhysics | Tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | 84 86 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 85 87 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | … … 97 99 ! | trac | ntiso | Isotopes + tagging tracers list + number | / | ntraciso | | 98 100 ! | zone | nzone | Geographic tagging zones list + number | / | ntraceurs_zone | | 99 ! | phase | nphas | Phases list + number | | [g ][l][s], 1:3|101 ! | phase | nphas | Phases list + number | | [g|l|s|r|b] 1:5 | 100 102 ! | iqIsoPha | Index in "qx" = f(name(1:ntiso)),phas) | iqiso | 1:nqtot | 101 ! | iqWIsoPha | Index in "qx" = f(name(1:ntiso)),phas) | iqiso| 1:nqtot |103 ! | iqWIsoPha | Index in "qx" = f(name(1:ntiso+nqo)),phas) | / | 1:nqtot | 102 104 ! | itZonIso | Index in "trac(1:ntiso)"= f(zone, name(1:niso)) | index_trac | 1:ntiso | 103 105 ! +-----------------+--------------------------------------------------+--------------------+-----------------+ 104 106 107 !=== INDICES FOR WATER 108 INTEGER, SAVE :: ivap, iliq, isol 109 !$OMP THREADPRIVATE(ivap, iliq, isol) 110 105 111 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 106 INTEGER, SAVE :: nqtot, &!--- Tracers nb in dynamics (incl. higher moments + H2O)107 nbtr, &!--- Tracers nb in physics (excl. higher moments + H2O)108 nqo, &!--- Number of water phases112 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 113 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 114 nqo, & !--- Number of water phases 109 115 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 110 116 nqCO2 !--- Number of tracers of CO2 (ThL) … … 112 118 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac) 113 119 114 !=== INDICES OF WATER115 INTEGER, SAVE :: ivap,iliq,isol ! Indices for vap, liq and ice116 !$OMP THREADPRIVATE(ivap,iliq,isol)117 118 120 !=== VARIABLES FOR INCA 119 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr)120 pbl_flg(:) !--- Boundary layer activation ; needed for INCA(nbtr)121 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: & 122 conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr) 121 123 !$OMP THREADPRIVATE(conv_flg, pbl_flg) 122 124 123 #if def CPP_StratAer125 #if defined CPP_StratAer || defined REPROBUS 124 126 !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB) 125 127 INTEGER, SAVE :: nbtr_bin, nbtr_sulgas !--- number of aerosols bins and sulfur gases for StratAer model … … 173 175 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 174 176 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 175 CHARACTER(LEN=maxlen) :: msg1, texp, ttp !--- String for messages and expanded tracers type177 CHARACTER(LEN=maxlen) :: msg1, texp, ttp !--- Strings for messages and expanded tracers type 176 178 INTEGER :: fType !--- Tracers description file type ; 0: none 177 179 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 178 180 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 179 181 INTEGER :: iad !--- Advection scheme number 180 INTEGER :: iq, jq, nt, im, nm , k!--- Indexes and temporary variables182 INTEGER :: iq, jq, nt, im, nm !--- Indexes and temporary variables 181 183 LOGICAL :: lerr, lInit 182 184 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 183 185 TYPE(trac_type), POINTER :: t1, t(:) 184 CHARACTER(LEN=maxlen), ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type(s), parsed version 185 186 CHARACTER(LEN=maxlen), ALLOCATABLE :: types_trac(:) !--- Keywords for tracers type(s), parsed version 186 187 CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy" 187 188 !------------------------------------------------------------------------------------------------------------------------------ … … 202 203 ENDIF 203 204 204 205 205 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 206 206 lInit = .NOT.ALLOCATED(tracers) … … 243 243 244 244 !============================================================================================================================== 245 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)246 !============================================================================================================================== 247 texp = type_trac !=== EXPANDED VERSION OF "type_trac", WITH "|" SEPARATOR245 ! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT 246 !============================================================================================================================== 247 texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" 248 248 IF(texp == 'inco') texp = 'co2i|inca' 249 249 IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) 250 251 !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE252 250 IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_physic(modname, 'problem with tracers file(s)',1) 253 254 251 ttp = type_trac; IF(fType /= 1) ttp = texp 255 252 … … 262 259 !############################################################################################################################## 263 260 264 !--------------------------------------------------------------------------------------------------------------------------- 265 IF(fType == 0) CALL abort_physic(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1) 266 !--------------------------------------------------------------------------------------------------------------------------- 267 IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN !=== FOUND OLD STYLE INCA "traceur.def" 261 !============================================================================================================================== 262 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. 263 !============================================================================================================================== 264 !--------------------------------------------------------------------------------------------------------------------------- 265 IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1) 266 !--------------------------------------------------------------------------------------------------------------------------- 267 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac) .AND. lInit) THEN !=== FOUND OLD STYLE INCA "traceur.def" 268 268 !--------------------------------------------------------------------------------------------------------------------------- 269 269 #ifdef INCA … … 281 281 ttr(1+nqo:nqCO2+nqo )%component = 'co2i' 282 282 ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' 283 ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca]283 ttr(1+nqo :nqtrue)%name = [('CO2 ', iq=1, nqCO2), solsym_inca] 284 284 ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 285 285 ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' … … 302 302 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 303 303 !--------------------------------------------------------------------------------------------------------------------------- 304 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' & 305 .AND. tracers(:)%component == 'lmdz') !--- Number of water phases 306 nqtrue = SIZE(tracers) !--- Total number of "true" tracers 307 nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' & 308 .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac 304 nqtrue = SIZE(tracers) !--- "true" tracers 305 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases 306 nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac 307 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 309 308 #ifdef INCA 310 nqINCA = COUNT(tracers(:)%component == 'inca') 311 #endif 312 lerr = getKey('hadv', hadv, ky=tracers(:)%keys) 313 lerr = getKey('vadv', vadv, ky=tracers(:)%keys) 314 !--------------------------------------------------------------------------------------------------------------------------- 315 END IF 316 !--------------------------------------------------------------------------------------------------------------------------- 317 318 !--- Transfert the number of tracers to Reprobus 309 nqINCA = COUNT(tracers(:)%component == 'inca') 310 #endif 311 IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1) 312 IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1) 313 !--------------------------------------------------------------------------------------------------------------------------- 314 END IF 315 !--------------------------------------------------------------------------------------------------------------------------- 316 319 317 #ifdef REPROBUS 320 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 318 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus 321 319 #endif 322 320 … … 359 357 IF(iad == -1) CALL abort_physic(modname, msg1, 1) 360 358 361 !--- SET FIELDS %longName, %isAdvected, %isInPhysics359 !--- SET FIELDS longName, isAdvected, isInPhysics 362 360 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 363 361 t1%isAdvected = iad >= 0 364 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' & 365 .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD... 362 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O 366 363 ttr(iq) = t1 367 364 … … 372 369 IF(nm == 0) CYCLE !--- No higher moments 373 370 ttr(jq+1:jq+nm) = t1 374 ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 375 ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 376 ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 377 ttr(jq+1:jq+nm)%isAdvected = [(.FALSE., im=1, nm) ] 371 ttr(jq+1:jq+nm)%name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 372 ttr(jq+1:jq+nm)%gen0Name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 373 ttr(jq+1:jq+nm)%parent = [ (TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 374 ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 375 ttr(jq+1:jq+nm)%isAdvected = [ (.FALSE., im=1, nm) ] 376 ttr(jq+1:jq+nm)%isInPhysics = [ (.FALSE., im=1, nm) ] 378 377 jq = jq + nm 379 378 END DO … … 381 380 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 382 381 383 !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen384 IF(indexUpdate(tracers)) CALL abort_ gcm(modname, 'problem when processing isotopes parameters', 1)382 !--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren, iGeneration 383 IF(indexUpdate(tracers)) CALL abort_physic(modname, 'problem with tracers indices update', 1) 385 384 386 385 !############################################################################################################################## … … 404 403 !############################################################################################################################## 405 404 !--- Convection / boundary layer activation for all tracers 406 IF 407 IF (.NOT.ALLOCATED(pbl_flg)) ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1405 IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 406 IF(.NOT.ALLOCATED( pbl_flg)) ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 408 407 409 408 !--- Note: nqtottr can differ from nbtr when nmom/=0 … … 424 423 #endif 425 424 t => tracers 426 CALL msg('Information stored in infotrac_phy :', modname) 427 IF(dispTable('issssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & 428 'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & 429 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),& 425 CALL msg('Information stored in '//TRIM(modname)//': ', modname) 426 IF(dispTable('isssssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & 427 'isPh', 'isAd', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & 428 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, & 429 bool2str(t%isInPhysics), bool2str(t%isAdvected)), & 430 430 cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & 431 431 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & -
LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp.F90
r5202 r5203 1526 1526 znebprecipcld(i)=0.0 1527 1527 ENDIF 1528 !IF ( ((1-zfice(i))*zoliq(i) .GT. 0.) .AND. (zt(i) .LE. 233.15) ) THEN1529 !print*,'WARNING LEA OLIQ A <-40°C '1530 !print*,'zt,Tbef,oliq,oice,cldfraliq,icefrac,rneb',zt(i),Tbef(i),(1-zfice(i))*zoliq(i),zfice(i)*zoliq(i),cldfraliq(i,k),zfice(i),rneb(i,k)1531 !ENDIF1532 1528 ENDDO 1533 1529 -
LMDZ6/branches/cirrus/libf/phylmd/lmdz_wake.F90
r4908 r5203 1 1 MODULE lmdz_wake 2 2 3 ! $Id$ 3 USE lmdz_wake_ini, ONLY: CPPKEY_IOPHYS_WK 4 5 IMPLICIT NONE; PRIVATE 6 PUBLIC wake 4 7 5 8 CONTAINS … … 353 356 ! 354 357 IF (first_call) THEN 355 !!#define IOPHYS_WK 356 #undef IOPHYS_WK 357 #ifdef IOPHYS_WK 358 IF (CPPKEY_IOPHYS_WK) THEN 358 359 IF (phys_sub) THEN 359 360 call iophys_ini(dtimesub) … … 361 362 call iophys_ini(dtime) 362 363 ENDIF 363 #endif 364 END IF 364 365 first_call = .false. 365 366 ENDIF !(first_call) … … 771 772 772 773 END DO 773 #ifdef IOPHYS_WK 774 IF (CPPKEY_IOPHYS_WK) THEN 774 775 IF (.not.phys_sub) CALL iophys_ecrit('wape_a',1,'wape_a','J/kg',wape) 775 #endif 776 END IF 776 777 777 778 ! 2.2 Prognostic variable update … … 1007 1008 !!-------------------------------------------------------- 1008 1009 ELSEIF (iflag_wk_pop_dyn == 3) THEN 1009 #ifdef IOPHYS_WK 1010 IF (CPPKEY_IOPHYS_WK) THEN 1010 1011 IF (phys_sub) THEN 1011 1012 CALL iophys_ecrit('ptop',1,'ptop','Pa',ptop) … … 1018 1019 CALL iophys_ecrit('irad_wk',1,'irad_wk','m',irad_wk) 1019 1020 ENDIF 1020 #endif 1021 END IF 1021 1022 ! 1022 1023 CALL wake_popdyn_3 ( klon, klev, phys_sub, wk_adv, dtimesub, wgen, & … … 1072 1073 !!-------------------------------------------------------- 1073 1074 1074 #ifdef IOPHYS_WK 1075 IF (CPPKEY_IOPHYS_WK) THEN 1075 1076 IF (phys_sub) THEN 1076 1077 CALL iophys_ecrit('wdensa',1,'wdensa','m',wdens) … … 1079 1080 CALL iophys_ecrit('asigmawa',1,'asigmawa','m',asigmaw) 1080 1081 ENDIF 1081 #endif 1082 END IF 1082 1083 ! calcul de la difference de vitesse verticale poche - zone non perturbee 1083 1084 ! IM 060208 differences par rapport au code initial; init. a 0 dp_deltomg … … 1669 1670 END DO 1670 1671 1671 #ifdef IOPHYS_WK 1672 IF (CPPKEY_IOPHYS_WK) THEN 1672 1673 IF (phys_sub) THEN 1673 1674 CALL iophys_ecrit('wdensb',1,'wdensb','m',wdens) … … 1702 1703 CALL iophys_ecrit('d_asig_bnd2',1,'d_asig_bnd2','m',d_asig_bnd2) 1703 1704 ENDIF 1704 #endif 1705 END IF 1705 1706 ENDIF ! (iflag_wk_pop_dyn == 3) 1706 1707 ENDIF ! (iflag_wk_pop_dyn >= 2) … … 1866 1867 ! 1867 1868 1868 #ifdef IOPHYS_WK 1869 IF (CPPKEY_IOPHYS_WK) THEN 1869 1870 IF (.not.phys_sub) CALL iophys_ecrit('wape_b',1,'wape_b','J/kg',wape) 1870 #endif 1871 END IF 1871 1872 IF (prt_level>=10) THEN 1872 1873 PRINT *, 'wake-5, sigmaw(igout), cstar(igout), wape(igout), ptop(igout) ', & … … 2009 2010 END IF 2010 2011 END DO 2011 #ifdef IOPHYS_WK 2012 IF (CPPKEY_IOPHYS_WK) THEN 2012 2013 IF (.not.phys_sub) CALL iophys_ecrit('wape2_a',1,'wape2_a','J/kg',wape2) 2013 #endif 2014 END IF 2014 2015 2015 2016 … … 2041 2042 END DO 2042 2043 END IF 2043 #ifdef IOPHYS_WK 2044 IF (CPPKEY_IOPHYS_WK) THEN 2044 2045 IF (.not.phys_sub) CALL iophys_ecrit('wape2_b',1,'wape2_b','J/kg',wape2) 2045 #endif 2046 END IF 2046 2047 2047 2048 … … 2087 2088 gwake(i) = .TRUE. 2088 2089 END IF 2089 #ifdef IOPHYS_WK 2090 IF (CPPKEY_IOPHYS_WK) THEN 2090 2091 IF (.not.phys_sub) CALL iophys_ecrit('cstar2',1,'cstar2','J/kg',cstar2) 2091 #endif 2092 END IF 2092 2093 END IF ! (ok_qx_qw(i)) 2093 2094 END DO … … 2123 2124 END DO 2124 2125 IF (iflag_wk_pop_dyn >= 3) THEN 2125 #ifdef IOPHYS_WK 2126 IF (CPPKEY_IOPHYS_WK) THEN 2126 2127 IF (.not.phys_sub) THEN 2127 2128 CALL iophys_ecrit('fip',1,'fip','J/kg',fip) … … 2163 2164 CALL iophys_ecrit('d_asig_bnd2',1,'d_asig_bnd2','m',d_asig_bnd2) 2164 2165 ENDIF ! (.not.phys_sub) 2165 #endif 2166 END IF 2166 2167 ENDIF ! (iflag_wk_pop_dyn >= 3) 2167 2168 ! Limitation de sigmaw … … 2268 2269 wape(igout),wape2(igout),ktopw(igout),OK_qx_qw(igout) 2269 2270 ENDIF 2270 #ifdef IOPHYS_WK 2271 IF (CPPKEY_IOPHYS_WK) THEN 2271 2272 IF (.not.phys_sub) CALL iophys_ecrit('wape_c',1,'wape_c','J/kg',wape) 2272 #endif 2273 END IF 2273 2274 2274 2275 … … 3255 3256 d_sig_spread(i) = d_sig_spread(i)*dtimesub 3256 3257 d_sigmaw(i) = d_sig_gen(i) + d_sig_death(i) + d_sig_col(i) + d_sig_spread(i) 3257 #ifdef IOPHYS_WK 3258 IF (CPPKEY_IOPHYS_WK) THEN 3258 3259 IF (phys_sub) call iophys_ecrit('d_sigmaw0',1,'d_sigmaw0','',d_sigmaw) 3259 #endif 3260 END IF 3260 3261 3261 3262 … … 3266 3267 d_sigmaw(i) = d_sigmaw_targ 3267 3268 !! d_sigmaw(i) = max(d_sigmaw(i), sigmad-sigmaw(i)) 3268 #ifdef IOPHYS_WK 3269 IF (CPPKEY_IOPHYS_WK) THEN 3269 3270 IF (phys_sub) THEN 3270 3271 call iophys_ecrit('tauwk_inv',1,'tau_wk_inv_min','',tau_wk_inv_min) … … 3276 3277 call iophys_ecrit('d_sig_bnd',1,'d_sig_bnd','',d_sig_bnd) 3277 3278 ENDIF 3278 #endif 3279 END IF 3279 3280 d_asig_death(i) = - asigmaw(i)/tau_prime(i) 3280 3281 d_asig_aicol(i) = (agfl(i)*iwdens(i) + igfl(i)*awdens(i))*cstar(i)*is_wk(i) … … 3287 3288 d_asig_spread(i) = d_asig_spread(i)*dtimesub 3288 3289 d_asigmaw(i) = d_sig_gen(i) + d_asig_death(i) + d_asig_aicol(i) + d_asig_iicol(i) + d_asig_spread(i) 3289 #ifdef IOPHYS_WK 3290 IF (CPPKEY_IOPHYS_WK) THEN 3290 3291 IF (phys_sub) call iophys_ecrit('d_asigmaw0',1,'d_asigmaw0','',d_asigmaw) 3291 #endif 3292 END IF 3292 3293 3293 3294 d_sigmaw_targ = min(max(d_asigmaw(i),-asigmaw(i)), sigmaw(i)-asigmaw(i)) … … 3295 3296 d_asig_bnd(i) = d_sigmaw_targ - d_asigmaw(i) 3296 3297 d_asigmaw(i) = d_sigmaw_targ 3297 #ifdef IOPHYS_WK 3298 IF (CPPKEY_IOPHYS_WK) THEN 3298 3299 IF (phys_sub) THEN 3299 3300 call iophys_ecrit('d_asigmaw',1,'d_asigmaw','',d_asigmaw) … … 3304 3305 call iophys_ecrit('d_asig_bnd',1,'d_asig_bnd','',d_asig_bnd) 3305 3306 ENDIF 3306 #endif 3307 END IF 3307 3308 d_dens_gen(i) = wgen(i) 3308 3309 d_dens_death(i) = - iwdens(i)*tau_wk_inv_min … … 3318 3319 d_dens_bnd(i) = d_wdens_targ - d_wdens(i) 3319 3320 d_wdens(i) = d_wdens_targ 3320 #ifdef IOPHYS_WK 3321 IF (CPPKEY_IOPHYS_WK) THEN 3321 3322 IF (phys_sub) THEN 3322 3323 call iophys_ecrit('d_wdens',1,'d_wdens','',d_wdens) … … 3325 3326 call iophys_ecrit('d_dens_col',1,'d_dens_col','',d_dens_col) 3326 3327 ENDIF 3327 #endif 3328 END IF 3328 3329 3329 3330 d_adens_death(i) = -awdens(i)/tau_prime(i) … … 3335 3336 d_adens_acol(i) = d_adens_acol(i)*dtimesub 3336 3337 d_awdens(i) = d_dens_gen(i) + d_adens_death(i) + d_adens_icol(i) + d_adens_acol(i) 3337 #ifdef IOPHYS_WK 3338 IF (CPPKEY_IOPHYS_WK) THEN 3338 3339 IF (phys_sub) THEN 3339 3340 call iophys_ecrit('d_awdens',1,'d_awdens','',d_awdens) … … 3342 3343 call iophys_ecrit('d_adens_acol',1,'d_adens_acol','',d_adens_acol) 3343 3344 ENDIF 3344 #endif 3345 END IF 3345 3346 d_wdens_targ = min(max(d_awdens(i),-awdens(i)), wdens(i)-awdens(i)) 3346 3347 !! d_dens_bnd(i) = d_dens_bnd(i) + d_wdens_targ - d_wdens(i) -
LMDZ6/branches/cirrus/libf/phylmd/lmdz_wake_ini.F90
r4908 r5203 81 81 !$OMP THREADPRIVATE(wk_int_delta_t_min) 82 82 83 ! CPP key used only in this module for debugging purposes. jyg 09/24 84 !!#define IOPHYS_WK 85 #ifdef IOPHYS_WK 86 LOGICAL, PARAMETER :: CPPKEY_IOPHYS_WK = .TRUE. 87 #else 88 LOGICAL, PARAMETER :: CPPKEY_IOPHYS_WK = .FALSE. 89 #endif 90 83 91 84 92 -
LMDZ6/branches/cirrus/libf/phylmd/phyetat0_mod.F90
r4951 r5203 33 33 USE geometry_mod, ONLY: longitude_deg, latitude_deg 34 34 USE iostart, ONLY: close_startphy, get_field, get_var, open_startphy 35 USE infotrac_phy, ONLY: nqtot, nbtr, type_trac, tracers 36 USE readTracFiles_mod,ONLY: maxlen, new2oldH2O35 USE infotrac_phy, ONLY: nqtot, nbtr, type_trac, tracers, new2oldH2O 36 USE strings_mod, ONLY: maxlen 37 37 USE traclmdz_mod, ONLY: traclmdz_from_restart 38 38 USE carbon_cycle_mod, ONLY: carbon_cycle_init, carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, co2_send, RCO2_glo -
LMDZ6/branches/cirrus/libf/phylmd/phys_local_var_mod.F90
r5202 r5203 400 400 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: tpot, tpote, ue, uq, uwat, ve, vq, vwat, zxffonte 401 401 !$OMP THREADPRIVATE(tpot, tpote, ue, uq, uwat, ve, vq, vwat, zxffonte) 402 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxustartlic, zxrhoslic, zxqsaltlic 403 !$OMP THREADPRIVATE(zxustartlic, zxrhoslic, zxqsaltlic )402 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxustartlic, zxrhoslic, zxqsaltlic, tempsmoothlic 403 !$OMP THREADPRIVATE(zxustartlic, zxrhoslic, zxqsaltlic, tempsmoothlic) 404 404 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfqcalving 405 405 !$OMP THREADPRIVATE(zxfqcalving) … … 1051 1051 ALLOCATE(zxrunofflic(klon), runoff_diag(klon)) 1052 1052 runoff_diag(:)=0. 1053 ALLOCATE(zxustartlic(klon), zxrhoslic(klon), zxqsaltlic(klon) )1054 zxustartlic(:)=0. ; zxrhoslic(:)=0. ; zxqsaltlic(:)=0. 1053 ALLOCATE(zxustartlic(klon), zxrhoslic(klon), zxqsaltlic(klon), tempsmoothlic(klon)) 1054 zxustartlic(:)=0. ; zxrhoslic(:)=0. ; zxqsaltlic(:)=0. ; tempsmoothlic(:)=0. 1055 1055 ALLOCATE(rain_lsc(klon)) 1056 1056 ALLOCATE(rain_num(klon)) … … 1480 1480 ! SN runoff_diag 1481 1481 DEALLOCATE(zxrunofflic, runoff_diag) 1482 DEALLOCATE(zxustartlic, zxrhoslic, zxqsaltlic )1482 DEALLOCATE(zxustartlic, zxrhoslic, zxqsaltlic, tempsmoothlic) 1483 1483 DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf) 1484 1484 DEALLOCATE(rain_lsc) -
LMDZ6/branches/cirrus/libf/phylmd/physiq_mod.F90
r5202 r5203 39 39 USE ioipsl_getin_p_mod, ONLY : getin_p 40 40 USE indice_sol_mod 41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac 42 USE readTracFiles_mod, ONLY: addPhase 41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, addPhase 43 42 USE strings_mod, ONLY: strIdx 44 43 USE iophy … … 1270 1269 !albedo SB <<< 1271 1270 1271 !--Lea Raillard qs_ini 1272 REAL, dimension(klon,klev) :: qs_ini 1273 1272 1274 !--OB variables for mass fixer (hard coded for now) 1273 1275 REAL qql1(klon),qql2(klon),corrqql … … 2461 2463 ENDDO 2462 2464 ENDDO 2465 ! Lea Raillard qs_ini for cloud phase param. 2466 qs_ini(:,:)=qs_seri(:,:) 2463 2467 ! 2464 2468 !--OB water mass fixer … … 3858 3862 3859 3863 CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, & 3860 t_seri, q_seri,qs_ ancien,ptconv,ratqs, &3864 t_seri, q_seri,qs_ini,ptconv,ratqs, & 3861 3865 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 3862 3866 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & -
LMDZ6/branches/cirrus/libf/phylmd/surf_landice_mod.F90
r5202 r5203 36 36 USE cpl_mod, ONLY : cpl_send_landice_fields 37 37 USE calcul_fluxs_mod 38 USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic, zxqsaltlic 38 USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic, zxqsaltlic, tempsmoothlic 39 39 USE phys_output_var_mod, ONLY : snow_o,zfra_o 40 40 #ifdef ISO … … 185 185 186 186 REAL,DIMENSION(klon) :: alb1,alb2 187 REAL :: time_tempsmooth,coef_tempsmooth 187 188 REAL,DIMENSION(klon) :: precip_totsnow, evap_totsnow 188 189 REAL, DIMENSION (klon,6) :: alb6 … … 230 231 PRINT*, 'alb_nir_sno_lic',alb_nir_sno_lic 231 232 233 DO j=1,knon 234 i = knindex(j) 235 tempsmoothlic(i) = temp_air(j) 236 ENDDO 232 237 firstcall=.false. 233 238 ENDIF … … 445 450 z0h(1:knon) = z0h_landice 446 451 else 447 ! parameterization of z0=f(T) following measurements in Adelie Land by Amory et al 201 8452 ! parameterization of z0=f(T) following measurements in Adelie Land by Amory et al 2017 448 453 coefa = 0.1658 !0.1862 !Ant 449 454 coefb = -50.3869 !-55.7718 !Ant … … 456 461 coefc = log(z03/z02)/(ta3-ta2) 457 462 coefd = log(z03)-coefc*ta3 463 time_tempsmooth=2.*86400. 464 coef_tempsmooth=min(1.,dtime/time_tempsmooth) 465 !coef_tempsmooth=0. 458 466 do j=1,knon 459 if (temp_air(j) .lt. ta1) then 467 i=knindex(j) 468 tempsmoothlic(i)=temp_air(j)*coef_tempsmooth+tempsmoothlic(i)*(1.-coef_tempsmooth) 469 if (tempsmoothlic(i) .lt. ta1) then 460 470 z0m(j) = z01 461 else if (temp _air(j).ge.ta1 .and. temp_air(j).lt.ta2) then462 z0m(j) = exp(coefa*temp _air(j) + coefb)463 else if (temp _air(j).ge.ta2 .and. temp_air(j).lt.ta3) then471 else if (tempsmoothlic(i).ge.ta1 .and. tempsmoothlic(i).lt.ta2) then 472 z0m(j) = exp(coefa*tempsmoothlic(i) + coefb) 473 else if (tempsmoothlic(i).ge.ta2 .and. tempsmoothlic(i).lt.ta3) then 464 474 ! if st > 0, melting induce smooth surface 465 z0m(j) = exp(coefc*temp _air(j) + coefd)475 z0m(j) = exp(coefc*tempsmoothlic(i) + coefd) 466 476 else 467 477 z0m(j) = z03 -
LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_mod.F90
r5202 r5203 161 161 !=== Local variables: 162 162 INTEGER :: ixt 163 163 LOGICAL :: ltnat1 164 CHARACTER(LEN=maxlen) :: modname, sxt 164 165 165 166 !--- For H2[17]O … … 170 171 LOGICAL, PARAMETER :: ok_nocinsat = .FALSE. ! if T: no sursaturation effect for ice 171 172 LOGICAL, PARAMETER :: Rdefault_smow = .FALSE. ! if T: Rdefault=smow; if F: nul 172 LOGICAL, PARAMETER :: tnat1 = .TRUE. ! If T: all tnats are 1.173 173 174 174 !--- For [3]H 175 175 INTEGER :: iessai 176 177 CHARACTER(LEN=maxlen) :: modname, sxt178 176 179 177 modname = 'iso_init' … … 265 263 IF(ANY(isoName == 'HTO')) & 266 264 CALL get_in('ok_prod_nucl_tritium', ok_prod_nucl_tritium, .FALSE., .FALSE.) 265 CALL get_in('tnateq1', ltnat1, .TRUE.) 267 266 268 267 ! Ocean composition … … 295 294 tkcin1(ixt) = 0.0005016 296 295 tkcin2(ixt) = 0.0014432 297 if (tnat1) then 298 tnat(ixt)=1 299 else 300 tnat(ixt)=0. 301 endif 296 tnat(ixt) = 0.0; IF(ltnat1) tnat(ixt)=1 302 297 toce(ixt)=4.0E-19 ! rapport T/H = 0.2 TU Dreisigacker and Roether 1978 303 298 tcorr(ixt)=1. … … 318 313 tkcin1(ixt) = tkcin1_O18*fac_kcin 319 314 tkcin2(ixt) = tkcin2_O18*fac_kcin 320 if (tnat1) then 321 tnat(ixt)=1 322 else 323 tnat(ixt)=0.004/100. ! O17 représente 0.004% de l'oxygène 324 endif 315 tnat(ixt)=0.004/100. ! O17 représente 0.004% de l'oxygène 316 IF(ltnat1) tnat(ixt)=1 325 317 toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0)**pente_MWL 326 318 tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL ! donné par Amaelle … … 338 330 tkcin1(ixt) = tkcin1_O18 339 331 tkcin2(ixt) = tkcin2_O18 340 if (tnat1) then 341 tnat(ixt)=1 342 else 343 tnat(ixt)=2005.2E-6 344 endif 332 tnat(ixt)=2005.2E-6; IF(ltnat1) tnat(ixt)=1 345 333 toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0) 346 334 tcorr(ixt)=1.0+fac_enrichoce18 … … 362 350 tkcin1(ixt) = tkcin1_O18*fac_kcin 363 351 tkcin2(ixt) = tkcin2_O18*fac_kcin 364 if (tnat1) then 365 tnat(ixt)=1 366 else 367 tnat(ixt)=155.76E-6 368 endif 352 tnat(ixt)=155.76E-6; IF(ltnat1) tnat(ixt)=1 369 353 toce(ixt)=tnat(ixt)*(1.0+pente_MWL*deltaO18_oce/1000.0) 370 354 tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL -
LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_routines_mod.F90
r5202 r5203 16419 16419 USE isotopes_mod, ONLY: isoName,iso_HDO,iso_eau 16420 16420 USE phyetat0_get_mod, ONLY: phyetat0_get, phyetat0_srf 16421 USE readTracFiles_mod,ONLY: new2oldH2O16422 USE strings_mod, ONLY: strIdx, str Tail, maxlen, msg, int2str16421 USE infotrac_phy, ONLY: new2oldH2O 16422 USE strings_mod, ONLY: strIdx, strHead, strTail, maxlen, msg, int2str 16423 16423 #ifdef ISOVERIF 16424 16424 USE isotopes_verif_mod … … 16459 16459 outiso = isoName(ixt) 16460 16460 oldIso = strTail(new2oldH2O(outiso), '_') !--- Remove "H2O_" from "H2O_<iso>[_<tag>]" 16461 i = INDEX(outiso, '_', .TRUE.) 16462 oldIso2 = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso)) ! CR 2023: on ajoute cette possibilité aussi, elle correspond au cas le plus récent. 16461 oldIso2= TRIM(strHead(outiso,'_'))//strTail(outiso,'_') ! CR 2023: most recent possibility 16463 16462 ! write(*,*) 'tmp 16541:' 16464 16463 ! write(*,*) 'outiso=',outiso -
LMDZ6/branches/cirrus/libf/phylmdiso/isotrac_mod.F90
r4493 r5203 3 3 4 4 MODULE isotrac_mod 5 USE infotrac_phy, ONLY: niso, ntiso, nzone 6 USE readTracFiles_mod, ONLY: delPhase 7 USE isotopes_mod, ONLY: ridicule, get_in 5 USE infotrac_phy, ONLY: niso, ntiso, nzone, delPhase 6 USE isotopes_mod, ONLY: ridicule, get_in 8 7 9 8 IMPLICIT NONE -
LMDZ6/branches/cirrus/libf/phylmdiso/phyetat0_mod.F90
r5202 r5203 41 41 USE geometry_mod, ONLY: longitude_deg, latitude_deg 42 42 USE iostart, ONLY: close_startphy, get_field, get_var, open_startphy 43 USE infotrac_phy, ONLY: nqtot, nbtr, type_trac, tracers 44 USE readTracFiles_mod,ONLY: maxlen, new2oldH2O43 USE infotrac_phy, ONLY: nqtot, nbtr, type_trac, tracers, new2oldH2O 44 USE strings_mod, ONLY: maxlen 45 45 USE traclmdz_mod, ONLY: traclmdz_from_restart 46 46 USE carbon_cycle_mod, ONLY: carbon_cycle_init, carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, co2_send, RCO2_glo -
LMDZ6/branches/cirrus/libf/phylmdiso/physiq_mod.F90
r5202 r5203 39 39 USE ioipsl_getin_p_mod, ONLY : getin_p 40 40 USE indice_sol_mod 41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,ivap,iliq,isol 42 USE readTracFiles_mod, ONLY: addPhase 41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,addPhase, ivap, iliq, isol 43 42 USE strings_mod, ONLY: strIdx 44 43 USE iophy … … 1375 1374 !$OMP THREADPRIVATE(SFRWL) 1376 1375 !albedo SB <<< 1376 1377 !--Lea Raillard qs_ini 1378 REAL, dimension(klon,klev) :: qs_ini 1377 1379 1378 1380 !--OB variables for mass fixer (hard coded for now) … … 5090 5092 5091 5093 CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, & 5092 t_seri, q_seri,qs_ ancien,ptconv,ratqs, &5094 t_seri, q_seri,qs_ini,ptconv,ratqs, & 5093 5095 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, & 5094 5096 pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, & … … 7172 7174 ENDDO 7173 7175 ENDDO 7176 7177 ! Lea Raillard qs_ini for cloud phase param. 7178 qs_ini(:,:)=qs_seri(:,:) 7174 7179 7175 7180 ! C Risi: dispatcher les isotopes dans les xt_seri
Note: See TracChangeset
for help on using the changeset viewer.
