Changeset 5536 for LMDZ6/branches/contrails
- Timestamp:
- Feb 12, 2025, 10:08:35 AM (4 days ago)
- Location:
- LMDZ6/branches/contrails
- Files:
-
- 1 deleted
- 56 edited
-
. (modified) (1 prop)
-
DefLists/field_def_lmdz.xml (modified) (1 diff)
-
libf/dyn3d/replay3d.f90 (modified) (4 diffs)
-
libf/dyn3d_common/infotrac.f90 (modified) (16 diffs)
-
libf/dynphy_lonlat/calfis.f90 (modified) (2 diffs)
-
libf/dynphy_lonlat/calfis_loc.F90 (modified) (2 diffs)
-
libf/misc/readTracFiles_mod.f90 (modified) (2 diffs)
-
libf/misc/wxios_mod.F90 (modified) (2 diffs)
-
libf/phy_common/abort_physic.f90 (modified) (1 diff)
-
libf/phy_common/mod_phys_lmdz_mpi_transfert.f90 (modified) (1 diff)
-
libf/phy_common/mod_phys_lmdz_omp_transfert.f90 (modified) (1 diff)
-
libf/phy_common/mod_phys_lmdz_transfert_para.f90 (modified) (1 diff)
-
libf/phydev/infotrac_phy.f90 (modified) (1 diff)
-
libf/phylmd/Dust/read_dust.f90 (modified) (2 diffs)
-
libf/phylmd/Dust/read_surface.f90 (modified) (7 diffs)
-
libf/phylmd/Dust/read_vent.f90 (modified) (4 diffs)
-
libf/phylmd/calcul_fluxs_mod.f90 (modified) (1 diff)
-
libf/phylmd/carbon_cycle_mod.f90 (modified) (1 diff)
-
libf/phylmd/clesphys_mod_h.f90 (modified) (3 diffs)
-
libf/phylmd/conf_phys_m.f90 (modified) (4 diffs)
-
libf/phylmd/cv3_routines.f90 (modified) (5 diffs)
-
libf/phylmd/dimphy.f90 (modified) (1 diff)
-
libf/phylmd/dyn1d/replay1d.f90 (modified) (3 diffs)
-
libf/phylmd/fonte_neige_mod.F90 (modified) (5 diffs)
-
libf/phylmd/infotrac_phy.F90 (modified) (18 diffs)
-
libf/phylmd/iophy.F90 (modified) (2 diffs)
-
libf/phylmd/iophys.F90 (modified) (5 diffs)
-
libf/phylmd/iostart.f90 (modified) (1 diff)
-
libf/phylmd/iotd_ecrit.f90 (modified) (1 diff)
-
libf/phylmd/lmdz_cloudth.f90 (modified) (10 diffs)
-
libf/phylmd/lmdz_lscp_old.f90 (modified) (9 diffs)
-
libf/phylmd/lmdz_surf_wind.f90 (modified) (8 diffs)
-
libf/phylmd/lmdz_wake.f90 (modified) (1 diff)
-
libf/phylmd/modd_csts.f90 (modified) (1 diff)
-
libf/phylmd/oasis.F90 (modified) (1 diff)
-
libf/phylmd/ocean_forced_mod.F90 (modified) (2 diffs)
-
libf/phylmd/output_physiqex_mod.f90 (modified) (1 diff)
-
libf/phylmd/pbl_surface_mod.F90 (modified) (7 diffs)
-
libf/phylmd/phyetat0_mod.f90 (modified) (1 diff)
-
libf/phylmd/phyredem.f90 (modified) (1 diff)
-
libf/phylmd/phys_local_var_mod.F90 (modified) (3 diffs)
-
libf/phylmd/phys_output_ctrlout_mod.F90 (modified) (2 diffs)
-
libf/phylmd/phys_output_mod.F90 (modified) (6 diffs)
-
libf/phylmd/phys_output_var_mod.f90 (modified) (1 diff)
-
libf/phylmd/phys_output_write_mod.F90 (modified) (6 diffs)
-
libf/phylmd/physiq_mod.F90 (modified) (20 diffs)
-
libf/phylmd/phystokenc_mod.f90 (modified) (1 diff)
-
libf/phylmd/phytrac_mod.f90 (modified) (6 diffs)
-
libf/phylmd/readaerosol_mod.f90 (modified) (2 diffs)
-
libf/phylmd/s2s.F90 (deleted)
-
libf/phylmd/surf_land_bucket_mod.F90 (modified) (2 diffs)
-
libf/phylmd/surf_landice_mod.F90 (modified) (11 diffs)
-
libf/phylmd/traclmdz_mod.f90 (modified) (2 diffs)
-
libf/phylmd/yamada_c.F90 (modified) (1 diff)
-
libf/phylmdiso/phyetat0_mod.F90 (modified) (1 diff)
-
libf/phylmdiso/phyredem.F90 (modified) (1 diff)
-
libf/phylmdiso/physiq_mod.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/contrails
- Property svn:mergeinfo changed
/LMDZ6/trunk reverse-merged: 5451,5458,5460,5463,5468-5487
- Property svn:mergeinfo changed
-
LMDZ6/branches/contrails/DefLists/field_def_lmdz.xml
r5489 r5536 113 113 <field id="snow" long_name="Snow fall" unit="kg/(s*m2)" /> 114 114 <field id="evap" long_name="Evaporat" unit="kg/(s*m2)" /> 115 <field id="icesub_lic" long_name="sublimation of ice over landice, mesh-averaged" unit="kg/(s*m2)" />116 115 <field id="snowerosion" long_name="blowing snow erosion" unit="kg/(s*m2)" /> 117 116 <field id="bsfall" long_name="blowing snow precipitation" unit="kg/(s*m2)" /> -
LMDZ6/branches/contrails/libf/dyn3d/replay3d.f90
r5489 r5536 18 18 grossismx, grossismy, dzoomx, dzoomy,taux,tauy 19 19 USE mod_const_mpi, ONLY: comm_lmdz 20 USE ioipsl, only: getin21 22 20 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 23 21 ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique … … 28 26 USE dimensions_mod, ONLY: iim, jjm, llm, ndm 29 27 USE paramet_mod_h 30 31 28 IMPLICIT NONE 32 29 … … 74 71 75 72 integer :: ntime=10000,it,klon,klev 76 77 character*20 :: lmax_replay78 73 79 74 … … 167 162 168 163 164 CALL iophys_ini(900.) 169 165 print*,'Rlatu=',rlatu 170 166 klon=2+iim*(jjm-1) 171 172 print*,'AVANT getin'173 167 klev=llm 174 CALL getin('lmax_replay',lmax_replay)175 print*,'APRES getin',lmax_replay176 CALL getin(lmax_replay,klev)177 print*,'replay3d lmax_replay klev',lmax_replay,klev178 179 CALL iophys_ini(900.,klev)180 168 181 169 !--------------------------------------------------------------------- -
LMDZ6/branches/contrails/libf/dyn3d_common/infotrac.f90
r5489 r5536 3 3 MODULE infotrac 4 4 5 USE strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx6 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, oldHNO35 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 10 10 IMPLICIT NONE 11 11 … … 30 30 PUBLIC :: isoKeys, isoName, isoZone, isoPhas !--- Isotopes keys & names, tagging zones names, phases 31 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)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) 34 34 PUBLIC :: isoCheck !--- Run isotopes checking routines 35 35 !=== FOR BOTH TRACERS AND ISOTOPES … … 78 78 ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | 79 79 ! | 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 | 80 82 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 81 83 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | … … 101 103 102 104 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 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 phases106 INTEGER, SAVE :: nqtottr!--- Number of tracers passed to phytrac (TO BE DELETED ?)107 INTEGER, SAVE :: nqCO2!--- Number of tracers of CO2 (ThL)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) 108 110 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) 109 111 110 112 !=== VARIABLES FOR INCA 111 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:) !--- Convection / boundary layer activation (nbtr) 113 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: & 114 conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr) 112 115 113 116 CONTAINS … … 144 147 ! Local variables 145 148 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 146 152 INTEGER :: nqINCA 147 153 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 148 154 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 149 CHARACTER(LEN=maxlen) :: msg1, texp, ttp , nam, val!--- Strings for messages and expanded tracers type155 CHARACTER(LEN=maxlen) :: msg1, texp, ttp !--- Strings for messages and expanded tracers type 150 156 INTEGER :: fType !--- Tracers description file type ; 0: none 151 157 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 152 158 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 153 159 INTEGER :: iad !--- Advection scheme number 154 INTEGER :: iq, jq, nt, im, nm , ig!--- Indexes and temporary variables155 LOGICAL :: lerr 160 INTEGER :: iq, jq, nt, im, nm !--- Indexes and temporary variables 161 LOGICAL :: lerr, ll 156 162 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 157 163 TYPE(trac_type), POINTER :: t1, t(:) … … 167 173 descrq(30) = 'PRA' 168 174 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 169 181 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 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 !############################################################################################################################## 182 183 180 184 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 181 185 msg1 = 'For type_trac = "'//TRIM(type_trac)//'":' … … 193 197 SELECT CASE(type_trac) 194 198 CASE('inca', 'inco') 195 IF(.NOT.CPPKEY_INCA) CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) 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 196 202 CASE('repr') 197 IF(.NOT.CPPKEY_REPROBUS) CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 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 198 206 CASE('coag') 199 IF(.NOT.CPPKEY_STRATAER) CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 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 200 210 END SELECT 201 !############################################################################################################################## 202 END IF 203 !############################################################################################################################## 211 212 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 204 213 205 214 !============================================================================================================================== 206 215 ! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT 207 216 !============================================================================================================================== 208 texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac"217 texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" 209 218 IF(texp == 'inco') texp = 'co2i|inca' 210 219 IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) 211 220 IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 212 221 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 !============================================================================================================================== 213 227 !--------------------------------------------------------------------------------------------------------------------------- 214 228 IF(fType == 0) CALL abort_gcm(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1) 215 229 !--------------------------------------------------------------------------------------------------------------------------- 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) 218 !--------------------------------------------------------------------------------------------------------------------------- 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 !============================================================================================================================== 230 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def" 231 !--------------------------------------------------------------------------------------------------------------------------- 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 !--------------------------------------------------------------------------------------------------------------------------- 227 267 nqtrue = SIZE(tracers) !--- "true" tracers 228 268 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases 229 269 nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac 230 270 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 231 IF(CPPKEY_INCA) & 271 IF (CPPKEY_INCA) THEN 232 272 nqINCA = COUNT(tracers(:)%component == 'inca') 233 IF(CPPKEY_REPROBUS) CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 234 235 !============================================================================================================================== 236 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 237 !============================================================================================================================== 273 END IF 238 274 IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "hadv"', 1) 239 275 IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "vadv"', 1) 276 !--------------------------------------------------------------------------------------------------------------------------- 277 END IF 278 !--------------------------------------------------------------------------------------------------------------------------- 279 280 IF (CPPKEY_REPROBUS) THEN 281 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 282 END IF 283 284 !============================================================================================================================== 285 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 286 !============================================================================================================================== 240 287 DO iq = 1, nqtrue 241 288 IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE … … 255 302 256 303 !============================================================================================================================== 257 ! 3) Determine the advection scheme choice for water and tracers "iadv" and the field "long name".304 ! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected. 258 305 ! iadv = 1 "LMDZ-specific humidity transport" (for H2O vapour) LMV 259 306 ! iadv = 2 backward (for H2O liquid) BAK … … 273 320 !============================================================================================================================== 274 321 ALLOCATE(ttr(nqtot)) 275 jq = nqtrue+1 322 jq = nqtrue+1; tracers(:)%iadv = -1 276 323 DO iq = 1, nqtrue 277 324 t1 => tracers(iq) … … 284 331 IF(iad == -1) CALL abort_gcm(modname, msg1, 1) 285 332 286 !--- SET FIELDS longName and iadv333 !--- SET FIELDS longName, iadv, isAdvected, isInPhysics 287 334 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 288 335 t1%iadv = iad 336 t1%isAdvected = iad >= 0 337 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O 289 338 ttr(iq) = t1 290 339 … … 300 349 ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 301 350 ttr(jq+1:jq+nm)%iadv = [ (-iad, im=1, nm) ] 351 ttr(jq+1:jq+nm)%isAdvected = [ (.FALSE., im=1, nm) ] 302 352 jq = jq + nm 303 353 END DO … … 309 359 310 360 !=== TEST ADVECTION SCHEME 311 DO iq = 1, nqtot ; t1 => tracers(iq) 312 iad = t1%iadv 313 ig = t1%iGeneration 314 nam = t1%name 315 val = 'iadv='//TRIM(int2str(iad)) 361 DO iq = 1, nqtot ; t1 => tracers(iq); iad = t1%iadv 316 362 317 363 !--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers) 318 IF(ALL([10,14,0] /= iad)) CALL abort_gcm(modname, TRIM(val)//' has not been tested yet ; 10 or 14 only are allowed !', 1) 319 320 !--- ONLY TESTED VALUES SO FAR FOR PARENTS HAVING CHILDREN: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 0) 321 IF(ALL([10,14] /= iad) .AND. ig == 0 .AND. ANY(tracers(:)%parent==nam)) & 322 CALL abort_gcm(modname, TRIM(val)//' is not implemented for parents ; 10 or 14 only are allowed !', 1) 323 324 !--- ONLY TESTED VALUES SO FAR FOR DESCENDANTS (TRACERS OF GENERATION > 0): iadv = 10 ; WATER VAPOUR: iadv = 14 325 lerr = iad /= 10 .AND. ig > 0; IF(lerr) tracers(iq)%iadv = 10 326 CALL msg('WARNING! '//TRIM(val)// ' not implemented for children. Setting iadv=10 for "'//TRIM(nam)//'"', modname, lerr) 327 lerr = iad == 14 .AND. nam /= addPhase('H2O','g'); IF(lerr) tracers(iq)%iadv = 10 328 CALL msg('WARNING! '//TRIM(val)//' is valid for water vapour only. Setting iadv=10 for "'//TRIM(nam)//'"', modname, lerr) 364 IF(ALL([10,14,0] /= iad)) & 365 CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1) 366 367 !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1) 368 IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) & 369 CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1) 370 371 !--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1) 372 IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',& 373 modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10 374 375 !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR: iadv = 14 376 ll = t1%name /= addPhase('H2O','g') 377 IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', & 378 modname, iad == 14 .AND. ll)) t1%iadv = 10 329 379 END DO 330 380 … … 334 384 335 385 !--- Convection / boundary layer activation for all tracers 336 IF(.NOT.ALLOCATED(conv_flg))ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1337 IF(.NOT.ALLOCATED( pbl_flg))ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1386 ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 387 ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 338 388 339 389 !--- Note: nqtottr can differ from nbtr when nmom/=0 … … 343 393 344 394 !=== DISPLAY THE RESULTS 345 IF(.NOT..TRUE.) RETURN346 395 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 347 396 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) … … 350 399 CALL msg('niso = '//TRIM(int2str(niso)), modname) 351 400 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 352 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname, CPPKEY_INCA) 353 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname, CPPKEY_INCA) 401 IF (CPPKEY_INCA) THEN 402 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 403 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 404 END IF 354 405 t => tracers 355 406 CALL msg('Information stored in '//TRIM(modname)//': ', modname) … … 360 411 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & 361 412 CALL abort_gcm(modname, "problem with the tracers table content", 1) 362 CALL msg('No isotopes identified.', modname, nbIso == 0) 363 IF(nbIso == 0) RETURN 364 CALL msg('For isotopes family "H2O":', modname) 365 CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) 366 CALL msg(' isoName = '//strStack(isoName), modname) 367 CALL msg(' isoZone = '//strStack(isoZone), modname) 368 CALL msg(' isoPhas = '//TRIM(isoPhas), modname) 413 IF(niso > 0) THEN 414 CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname) 415 CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) 416 CALL msg(' isoName = '//strStack(isoName), modname) 417 CALL msg(' isoZone = '//strStack(isoZone), modname) 418 CALL msg(' isoPhas = '//TRIM(isoPhas), modname) 419 ELSE 420 CALL msg('No isotopes identified.', modname) 421 END IF 422 CALL msg('end', modname) 369 423 370 424 END SUBROUTINE init_infotrac -
LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis.f90
r5489 r5536 279 279 itr=0 280 280 DO iq=1,nqtot 281 IF( tracers(iq)%iadv < 0) CYCLE281 IF(.NOT.tracers(iq)%isAdvected) CYCLE 282 282 itr = itr + 1 283 283 DO l=1,llm … … 597 597 itr = 0 598 598 DO iq=1,nqtot 599 IF( tracers(iq)%iadv < 0) CYCLE599 IF(.NOT.tracers(iq)%isAdvected) CYCLE 600 600 itr = itr + 1 601 601 DO l=1,llm -
LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis_loc.F90
r5489 r5536 356 356 itr = 0 357 357 DO iq=1,nqtot 358 IF( tracers(iq)%iadv < 0) CYCLE358 IF(.NOT.tracers(iq)%isAdvected) CYCLE 359 359 itr = itr + 1 360 360 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) … … 1059 1059 itr = 0 1060 1060 DO iq=1,nqtot 1061 IF( tracers(iq)%iadv < 0) CYCLE1061 IF(.NOT.tracers(iq)%isAdvected) CYCLE 1062 1062 itr = itr + 1 1063 1063 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) -
LMDZ6/branches/contrails/libf/misc/readTracFiles_mod.f90
r5489 r5536 61 61 INTEGER :: nqChildren = 0 !--- Number of children (first generation) 62 62 INTEGER :: iadv = 10 !--- Advection scheme used 63 LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0. COUNT(isAdvected )=nqtrue 63 64 LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr 64 65 INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:) … … 184 185 ! * The "keys" component (of type keys_type) is in principle enough to store everything we could need. 185 186 ! But some variables are stored as direct-access keys to make the code more readable and because they are used often. 186 ! * Most of the direct-access keys are set in this module, but some are not (longName, iadv and isInPhysicsfor now).187 ! * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now). 187 188 ! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)" 188 189 ! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen). -
LMDZ6/branches/contrails/libf/misc/wxios_mod.F90
r5489 r5536 188 188 ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs 189 189 DO iq = 1, nqtot 190 IF(.NOT. tracers(iq)%isInPhysics) CYCLE190 IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 191 191 dn = 'd'//TRIM(tracers(iq)%name)//'_' 192 192 … … 241 241 ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs 242 242 DO iq = 1, nqtot 243 IF(.NOT. tracers(iq)%isInPhysics) CYCLE243 IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 244 244 245 245 unt = "kg m-2" -
LMDZ6/branches/contrails/libf/phy_common/abort_physic.f90
r5489 r5536 49 49 endif 50 50 endif 51 END SUBROUTINE abort_physic51 END -
LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_mpi_transfert.f90
r5489 r5536 65 65 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 66 66 67 !! -- Les chaine de charact ere -- !!67 !! -- Les chaine de charactère -- !! 68 68 69 69 SUBROUTINE bcast_mpi_c(var1) -
LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_omp_transfert.f90
r5489 r5536 116 116 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 117 117 118 !! -- Les chaine de charact ere -- !!118 !! -- Les chaine de charactère -- !! 119 119 120 120 SUBROUTINE bcast_omp_c(var) -
LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_transfert_para.f90
r5489 r5536 57 57 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 58 58 59 !! -- Les chaine de charact ere -- !!59 !! -- Les chaine de charactère -- !! 60 60 61 61 SUBROUTINE bcast_c(var) -
LMDZ6/branches/contrails/libf/phydev/infotrac_phy.f90
r5489 r5536 32 32 TYPE(keys_type) :: keys !--- <key>=<val> pairs vector 33 33 INTEGER :: iadv = 10 !--- Advection scheme used 34 LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0. COUNT(isAdvected )=nqtrue 34 35 LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr 35 36 INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:) -
LMDZ6/branches/contrails/libf/phylmd/Dust/read_dust.f90
r5489 r5536 21 21 save ncid1, varid1, ncid2, varid2 22 22 !$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2) 23 integer :: start _(4),count_(4)23 integer :: start(4),count(4), status 24 24 integer :: i, j, ig 25 25 ! … … 28 28 if (debutphy) then 29 29 ! 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 30 ncid1=nf90_open('dust.nc',nf90_nowrite,rcode) 31 varid1=nf90_inq_varid(ncid1,'EMISSION',rcode) 35 32 ! 36 33 endif 37 34 ! 38 start_(1)=1 39 start_(2)=1 40 start_(3)=step 41 start_(4)=0 35 start(1)=1 36 start(2)=1 37 start(4)=0 42 38 43 ! count _(1)=iip144 count _(1)=nbp_lon+145 ! count _(2)=jjp146 count _(2)=nbp_lat47 count _(3)=148 count _(4)=039 ! 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 49 45 ! 46 start(3)=step 50 47 ! 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 48 status = nf90_get_var(ncid1, varid1, dust_nc_glo, start, count) 53 49 54 50 ! -
LMDZ6/branches/contrails/libf/phylmd/Dust/read_surface.f90
r5489 r5536 31 31 real surfa_glo(klon_glo,5) 32 32 ! 33 integer ncid, varid, rcode , varlatid,tmpid34 integer start _(2),count_(2)33 integer ncid, varid, rcode 34 integer start(2),count(2),status 35 35 integer i,j,l,ig 36 36 character*1 str1 … … 41 41 real, dimension(nbp_lat) :: lats 42 42 real, dimension(nbp_lat) :: lats_glo 43 integer, dimension(1) :: start _j,endj43 integer, dimension(1) :: startj,endj 44 44 !JE20140526>> 45 45 !$OMP MASTER … … 47 47 48 48 print*,'Lecture du fichier donnees_lisa.nc' 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 49 ncid=nf90_open('donnees_lisa.nc',nf90_nowrite,rcode) 52 50 53 51 !JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa … … 56 54 isinversed=.false. 57 55 do i=1,5 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 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 68 68 enddo ! check if it inversed lat 69 start_j(1)=1 69 startj(1)=1 70 ! endj(1)=jjp1 70 71 endj(1)=nbp_lat 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 72 varid=nf90_inq_varid(ncid,latstr,rcode) 73 73 74 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 75 79 76 80 ! check if netcdf is latitude inversed or not. … … 82 86 write(str1,'(i1)') i 83 87 varname=trim(name)//str1 84 rcode=nf90_inq_varid(ncid,trim(varname),varid)85 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//' dans read_vent',1) ; endif88 print*,'lecture variable:',varname 89 varid=nf90_inq_varid(ncid,trim(varname),rcode) 86 90 ! varid=nf90_inq_varid(ncid,varname,rcode) 87 91 … … 89 93 ! ----------------------------------------------------- 90 94 91 start _(1)=192 start _(2)=193 count _(1)=nbp_lon+194 ! count _(1)=iip195 count _(2)=nbp_lat96 ! count _(2)=jjp195 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 97 101 98 102 ! mise a zero des tableaux … … 102 106 ! Lecture 103 107 ! ----------------------- 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 108 status = nf90_get_var(ncid, varid, tmp_dyn_glo, start, count) 106 109 107 110 ! call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn ') -
LMDZ6/branches/contrails/libf/phylmd/Dust/read_vent.f90
r5489 r5536 23 23 save ncidu1, varidu1, ncidv1, varidv1 24 24 !$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1) 25 integer :: start(4),count _(4)25 integer :: start(4),count(4), status 26 26 integer :: i, j, ig 27 27 … … 32 32 if (debutphy) then 33 33 ! 34 rcode=nf90_open('u10m.nc',nf90_nowrite,ncidu1) 35 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open u10m.nc dans read_vent',1) ; endif 36 rcode=nf90_inq_varid(ncidu1,'U10M',varidu1) 37 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get id u10m dans read_vent',1) ; endif 38 rcode=nf90_open('v10m.nc',nf90_nowrite,ncidv1) 39 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open v10m.nc dans read_vent',1) ; endif 40 rcode=nf90_inq_varid(ncidv1,'V10M',varidv1) 41 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get id v10m dans read_vent',1) ; endif 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) 42 38 ! 43 39 endif … … 45 41 start(1)=1 46 42 start(2)=1 47 start(3)=step48 43 start(4)=0 49 44 50 ! count _(1)=iip151 count _(1)=nbp_lon+152 ! count _(2)=jjp153 count _(2)=nbp_lat54 count _(3)=155 count _(4)=045 ! 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 56 51 ! 52 start(3)=step 57 53 ! 58 rcode = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count_) 59 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','lecture u10m dans read_vent',1) ; endif 60 rcode = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count_) 61 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','lecture v10m dans read_vent',1) ; endif 54 status = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count) 62 55 63 64 ! ------- Tests 2024/12/31-FH---------------------------------------- 65 ! print*,'nbp_lon,npb_lat ',nbp_lon,nbp_lat 66 ! print*,'start ',start 67 ! print*,'count_ ',count_ 68 ! print*,'satus lecture u10m ',rcode 69 ! call dump2d(nbp_lon+1,nbp_lat,u10m_nc_glo,'U10M global read_vent') 70 ! call dump2d(nbp_lon+1,nbp_lat,v10m_nc_glo,'V10M global read_vent') 71 ! stop 72 ! ------- Tests ----------------------------------------------------- 56 ! print *,status 57 ! 58 status = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count) 73 59 74 60 ! … … 77 63 ! print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1) 78 64 79 ! print *, rcode65 ! print *,status 80 66 ! call correctbid(iim,jjp1,u10m_nc) 81 67 ! call correctbid(iim,jjp1,v10m_nc) -
LMDZ6/branches/contrails/libf/phylmd/calcul_fluxs_mod.f90
r5489 r5536 177 177 zx_coefh(i) = cdragh(i) * zx_wind(i) * p1lay(i)/(RD*t1lay(i)) 178 178 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) 179 183 ENDDO 180 184 -
LMDZ6/branches/contrails/libf/phylmd/carbon_cycle_mod.f90
r5489 r5536 350 350 351 351 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 356 352 357 353 !----------------------------------------------------------------------- -
LMDZ6/branches/contrails/libf/phylmd/clesphys_mod_h.f90
r5489 r5536 22 22 , co2_ppm0 & 23 23 , tau_thermals & 24 , Cd_frein, nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t &24 , Cd_frein, zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t & 25 25 , ecrit_LES & 26 26 , ecrit_ins, ecrit_hf, ecrit_day & … … 55 55 56 56 ! threshold on to activate SSO schemes 57 REAL nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t 57 ! threshold on to activate SSO schemes 58 REAL zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t 58 59 INTEGER iflag_cycle_diurne 59 60 LOGICAL soil_model, new_oliq, ok_orodr, ok_orolf … … 178 179 !$OMP , co2_ppm0 & 179 180 !$OMP , tau_thermals & 180 !$OMP , Cd_frein, nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t &181 !$OMP , Cd_frein, zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t & 181 182 !$OMP , ecrit_LES & 182 183 !$OMP , ecrit_ins, ecrit_hf, ecrit_day & -
LMDZ6/branches/contrails/libf/phylmd/conf_phys_m.f90
r5489 r5536 213 213 LOGICAL, SAVE :: ok_lic_cond_omp 214 214 ! 215 REAL, SAVE :: nm_oro_t_omp, zstd_orodr_t_omp215 REAL, SAVE :: zrel_oro_t_omp, zstd_orodr_t_omp 216 216 REAL, SAVE :: zpmm_orodr_t_omp, zpmm_orolf_t_omp 217 217 INTEGER, SAVE :: iflag_cycle_diurne_omp … … 893 893 894 894 895 !Config Key = nm_oro_t896 !Config Desc = nm_oro_t897 !Config Def = -1895 !Config Key = zrel_oro_t 896 !Config Desc = zrel_oro_t 897 !Config Def = 9999. 898 898 !Config Help = Connais pas ! 899 nm_oro_t_omp = -1.900 CALL getin(' nm_oro_t', nm_oro_t_omp)899 zrel_oro_t_omp = 9999. 900 CALL getin('zrel_oro_t', zrel_oro_t_omp) 901 901 902 902 !Config Key = zstd_orodr_t … … 2313 2313 ok_orodr = ok_orodr_omp 2314 2314 ok_orolf = ok_orolf_omp 2315 nm_oro_t=nm_oro_t_omp2315 zrel_oro_t=zrel_oro_t_omp 2316 2316 zstd_orodr_t=zstd_orodr_t_omp 2317 2317 zpmm_orodr_t=zpmm_orodr_t_omp … … 2732 2732 WRITE(lunout,*) ' ok_orodr=',ok_orodr 2733 2733 WRITE(lunout,*) ' ok_orolf=',ok_orolf 2734 WRITE(lunout,*) ' nm_oro_t=',nm_oro_t2734 WRITE(lunout,*) ' zrel_oro_t=',zrel_oro_t 2735 2735 WRITE(lunout,*) ' zstd_orodr_t=',zstd_orodr_t 2736 2736 WRITE(lunout,*) ' zpmm_orodr_t=',zpmm_orodr_t -
LMDZ6/branches/contrails/libf/phylmd/cv3_routines.f90
r5489 r5536 4938 4938 USE lmdz_cv_ini, ONLY : nl 4939 4939 USE cvflag_mod_h 4940 USE ioipsl_getin_p_mod, ONLY : getin_p4941 4940 IMPLICIT NONE 4942 4941 4943 4942 4944 4943 !inputs: 4945 !------4946 4944 INTEGER, INTENT (IN) :: ncum, nd, na, nloc, len 4947 4945 INTEGER, DIMENSION (len), INTENT (IN) :: icb, inb … … 4951 4949 REAL, DIMENSION (len, nd+1), INTENT (IN) :: Vprecip 4952 4950 !ouputs: 4953 !------4954 4951 REAL, DIMENSION (len, na, na), INTENT (OUT) :: phi, phi2, epmlmMm 4955 4952 REAL, DIMENSION (len, na), INTENT (OUT) :: da, d1a, dam, eplaMm 4956 4953 ! 4954 ! variables pour tracer dans precip de l'AA et des mel 4957 4955 !local variables: 4958 !---------------4959 ! variables pour tracer dans precip de l'AA et des mel4960 4956 INTEGER i, j, k 4961 4957 REAL epm(nloc, na, na) 4962 !4963 LOGICAL,SAVE :: first=.TRUE.4964 LOGICAL,SAVE :: keep_bug_indices_cv3_tracer4965 !$OMP THREADPRIVATE(first, keep_bug_indices_cv3_tracer)4966 4958 4967 4959 ! variables d'Emanuel : du second indice au troisieme … … 4970 4962 ! variables personnelles : du troisieme au second indice 4971 4963 ! ---> tab(i,j,k) -> de k a j 4972 ! phi, phi2, epm, epmlmMm 4973 4974 IF (first) THEN 4975 keep_bug_indices_cv3_tracer = .FALSE. 4976 CALL getin_p('keep_bug_indices_cv3_tracer', keep_bug_indices_cv3_tracer) 4977 first = .FALSE. 4978 ENDIF ! (first) 4964 ! phi, phi2 4965 4979 4966 ! initialisations 4980 4967 … … 5035 5022 d1a(i, j) = d1a(i, j) + ment(i, k, j)*ep(i, k)*(1.-sigij(i,k,j)) 5036 5023 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)) 5037 5025 phi2(i, j, k) = phi(i, j, k)*epm(i, j, k) 5038 5026 END IF … … 5040 5028 END DO 5041 5029 END DO 5042 5043 IF (keep_bug_indices_cv3_tracer) THEN5044 DO j = 1, nl5045 DO k = 1, nl5046 DO i = 1, ncum5047 IF (k<=j) THEN5048 dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, k, j)*(1.-ep(i,k))*(1.-sigij(i,k,j))5049 END IF ! (k<=j)5050 END DO5051 END DO5052 END DO5053 ELSE ! (keep_bug_indices_cv3_tracer)5054 DO j = 1, nl5055 DO k = 1, nl5056 DO i = 1, ncum5057 IF (k<=j) THEN5058 dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, j, k)*(1.-ep(i,k))*(1.-sigij(i,k,j))5059 END IF ! (k<=j)5060 END DO5061 END DO5062 END DO5063 ENDIF ! (keep_bug_indices_cv3_tracer)5064 5030 5065 5031 RETURN -
LMDZ6/branches/contrails/libf/phylmd/dimphy.f90
r5489 r5536 13 13 INTEGER,SAVE :: kflev 14 14 15 !$OMP THREADPRIVATE(klon,k dlon,kfdia,kidia,klev,klevp1,klevm1,kflev)15 !$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon) 16 16 REAL,save,allocatable,dimension(:) :: zmasq 17 17 !$OMP THREADPRIVATE(zmasq) -
LMDZ6/branches/contrails/libf/phylmd/dyn1d/replay1d.f90
r5489 r5536 24 24 CHARACTER (len=10) :: calend 25 25 CHARACTER(len=20) :: calendrier 26 CHARACTER(len=20) :: lmax_replay 26 27 27 28 28 !--------------------------------------------------------------------- … … 56 56 call getin('calend',calend) 57 57 call getin('day_step',day_step) 58 59 print*,'AVANT getin'60 klev=llm61 CALL getin('lmax_replay',lmax_replay)62 print*,'APRES getin',lmax_replay63 CALL getin(lmax_replay,klev)64 print*,'replay1d lmax_replay klev',lmax_replay,klev65 66 58 calendrier=calend 67 59 if ( calendrier == "earth_360d" ) calendrier="360_day" … … 77 69 78 70 klon=1 71 klev=llm 79 72 call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,86400./day_step,calendrier) 80 73 ! Consistent with ... CALL iophys_ini(600.) -
LMDZ6/branches/contrails/libf/phylmd/fonte_neige_mod.F90
r5489 r5536 231 231 SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, & 232 232 tsurf, precip_rain, precip_snow, & 233 snow, qsol, tsurf_new, evap , ice_sub&233 snow, qsol, tsurf_new, evap & 234 234 #ifdef ISO 235 235 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & … … 288 288 REAL, DIMENSION(klon), INTENT(INOUT) :: evap 289 289 290 291 REAL, DIMENSION(klon), INTENT(OUT) :: ice_sub292 290 #ifdef ISO 293 291 ! sortie de quelques diagnostiques … … 299 297 REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag 300 298 REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag 301 REAL, INTENT(OUT) :: coeff_rel_diag 302 #endif 303 299 REAL, INTENT(OUT) :: coeff_rel_diag 300 #endif 304 301 305 302 ! Local variables … … 348 345 349 346 snow_evap = 0. 350 ice_sub(:) = 0.351 347 352 348 IF (.NOT. ok_lic_cond) THEN … … 367 363 368 364 bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime 369 370 IF (nisurf==is_lic) THEN371 DO i=1,knon372 ice_sub(i)=evap(i)-snow_evap(i)373 ENDDO374 ENDIF375 376 365 #ifdef ISO 377 366 snow_evap_diag(:) = snow_evap(:) -
LMDZ6/branches/contrails/libf/phylmd/infotrac_phy.F90
r5489 r5536 3 3 MODULE infotrac_phy 4 4 5 USE strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx6 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,new2oldH2O5 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 10 10 IMPLICIT NONE 11 11 … … 27 27 !=== FOR ISOTOPES: Specific to water 28 28 PUBLIC :: iH2O !--- Value of "ixIso" for "H2O" isotopes class 29 PUBLIC :: ivap, iliq, isol , ibs, icf, irvc, ircont29 PUBLIC :: ivap, iliq, isol 30 30 !=== FOR ISOTOPES: Depending on the selected isotopes family 31 31 PUBLIC :: isotope !--- Selected isotopes database (argument of getKey) … … 80 80 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 81 81 ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | 82 ! | isInPhysics | Advected tracers from the main table kept in physics | / | nqtottr .TRUE. values | 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 | 83 84 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 84 85 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | … … 103 104 104 105 !=== INDICES FOR WATER 105 INTEGER, SAVE :: ivap, iliq, isol , ibs, icf, irvc, ircont106 !$OMP THREADPRIVATE(ivap, iliq, isol , ibs, icf, irvc, ircont)106 INTEGER, SAVE :: ivap, iliq, isol 107 !$OMP THREADPRIVATE(ivap, iliq, isol) 107 108 108 109 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 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 phases112 INTEGER, SAVE :: nqtottr!--- Number of tracers passed to phytrac (TO BE DELETED ?)113 INTEGER, SAVE :: nqCO2!--- Number of tracers of CO2 (ThL)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) 114 115 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) 115 116 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac) 116 117 117 118 !=== VARIABLES FOR INCA 118 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:)!--- Convection / boundary layer activation (nbtr)119 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr) 119 120 !$OMP THREADPRIVATE(conv_flg, pbl_flg) 120 121 … … 132 133 USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_trac 133 134 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS, CPPKEY_STRATAER 134 USE mod_phys_lmdz_para, ONLY: is_master, is_omp_master 135 IMPLICIT NONE 135 IMPLICIT NONE 136 136 !============================================================================================================================== 137 137 ! … … 158 158 ! Local variables 159 159 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 160 163 INTEGER :: nqINCA 161 164 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:) … … 184 187 CALL getin_p('type_trac',type_trac) 185 188 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 SOON189 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 191 194 192 195 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) … … 194 197 195 198 !############################################################################################################################## 196 IF(lInit .AND. is_master) THEN!=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####199 IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 197 200 !############################################################################################################################## 198 201 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION … … 211 214 SELECT CASE(type_trac) 212 215 CASE('inca', 'inco') 213 IF(.NOT.CPPKEY_INCA) CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1) 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 214 219 CASE('repr') 215 IF(.NOT.CPPKEY_REPROBUS) CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 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 216 223 CASE('coag') 217 IF(.NOT.CPPKEY_STRATAER) CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 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 218 227 END SELECT 219 228 !############################################################################################################################## … … 221 230 !############################################################################################################################## 222 231 232 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 233 223 234 !============================================================================================================================== 224 235 ! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT 225 236 !============================================================================================================================== 226 texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac"237 texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" 227 238 IF(texp == 'inco') texp = 'co2i|inca' 228 239 IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) 229 IF(testTracersFiles(modname, texp, fType, lInit .AND.is_master)) CALL abort_physic(modname, 'problem with tracers file(s)',1)240 IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_physic(modname, 'problem with tracers file(s)',1) 230 241 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 !============================================================================================================================== 231 254 !--------------------------------------------------------------------------------------------------------------------------- 232 255 IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1) 233 256 !--------------------------------------------------------------------------------------------------------------------------- 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) 236 !--------------------------------------------------------------------------------------------------------------------------- 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 !============================================================================================================================== 257 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac) .AND. lInit) THEN !=== FOUND OLD STYLE INCA "traceur.def" 258 !--------------------------------------------------------------------------------------------------------------------------- 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 !--------------------------------------------------------------------------------------------------------------------------- 248 294 nqtrue = SIZE(tracers) !--- "true" tracers 249 295 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases 250 296 nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac 251 297 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 252 IF(CPPKEY_INCA) & 298 IF (CPPKEY_INCA) THEN 253 299 nqINCA = COUNT(tracers(:)%component == 'inca') 254 IF(CPPKEY_REPROBUS) CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus 255 256 !============================================================================================================================== 257 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 258 !============================================================================================================================== 300 END IF 259 301 IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1) 260 302 IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1) 303 !--------------------------------------------------------------------------------------------------------------------------- 304 END IF 305 !--------------------------------------------------------------------------------------------------------------------------- 306 307 IF (CPPKEY_REPROBUS) THEN 308 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus 309 END IF 310 311 !############################################################################################################################## 312 IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 313 !############################################################################################################################## 314 315 !============================================================================================================================== 316 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 317 !============================================================================================================================== 261 318 DO iq = 1, nqtrue 262 319 IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE … … 275 332 END IF 276 333 277 !############################################################################################################################## 278 IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 279 !############################################################################################################################## 280 281 !============================================================================================================================== 282 ! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot 334 !============================================================================================================================== 335 ! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names, nqtot and %isAdvected 283 336 !============================================================================================================================== 284 337 ALLOCATE(ttr(nqtot)) 285 jq = nqtrue+1 338 jq = nqtrue+1; tracers(:)%iadv = -1 286 339 DO iq = 1, nqtrue 287 340 t1 => tracers(iq) … … 294 347 IF(iad == -1) CALL abort_physic(modname, msg1, 1) 295 348 296 !--- SET FIELDS longName, is InPhysics349 !--- SET FIELDS longName, isAdvected, isInPhysics 297 350 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 298 t1%isInPhysics= iad >= 0 .AND. (delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz') 351 t1%isAdvected = iad >= 0 352 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O 299 353 ttr(iq) = t1 300 354 … … 309 363 ttr(jq+1:jq+nm)%parent = [ (TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 310 364 ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 365 ttr(jq+1:jq+nm)%isAdvected = [ (.FALSE., im=1, nm) ] 311 366 ttr(jq+1:jq+nm)%isInPhysics = [ (.FALSE., im=1, nm) ] 312 367 jq = jq + nm … … 318 373 IF(indexUpdate(tracers)) CALL abort_physic(modname, 'problem with tracers indices update', 1) 319 374 375 !############################################################################################################################## 376 END IF 377 !############################################################################################################################## 378 379 !############################################################################################################################## 380 IF(.NOT.lInit) THEN 381 !############################################################################################################################## 382 nqtot = SIZE(tracers) 383 !############################################################################################################################## 384 ELSE 385 !############################################################################################################################## 386 320 387 !=== READ PHYSICAL PARAMETERS FOR ISOTOPES 321 388 niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE. … … 323 390 324 391 !############################################################################################################################## 325 ELSE 326 !############################################################################################################################## 327 DO iq = 1, nqtrue 328 t1 => tracers(iq) 329 IF(hadv(iq) == vadv(iq) ) iad = hadv(iq) 330 IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11 331 tracers(iq)%isInPhysics= iad >= 0 .AND. (delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz') 332 END DO 333 !############################################################################################################################## 334 END IF 335 !############################################################################################################################## 336 392 END IF 393 !############################################################################################################################## 337 394 !--- Convection / boundary layer activation for all tracers 338 395 IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 … … 344 401 CALL abort_physic(modname, 'problem with the computation of nqtottr', 1) 345 402 346 !--- Compute indices for water 347 ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g')) 348 iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) 349 isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) 350 ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) 351 icf = strIdx(tracers(:)%name, addPhase('H2O', 'f')) 352 irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c')) 353 ircont = strIdx(tracers(:)%name, addPhase('H2O', 'a')) 354 355 IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN 403 !=== DISPLAY THE RESULTS 404 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 405 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 406 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 407 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 408 CALL msg('niso = '//TRIM(int2str(niso)), modname) 409 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 410 IF (CPPKEY_INCA) THEN 411 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 412 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 413 END IF 414 t => tracers 415 CALL msg('Information stored in '//TRIM(modname)//': ', modname) 416 IF(dispTable('isssssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & 417 'isPh', 'isAd', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & 418 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, & 419 bool2str(t%isInPhysics), bool2str(t%isAdvected)), & 420 cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & 421 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & 422 CALL abort_physic(modname, "problem with the tracers table content", 1) 423 IF(niso > 0) THEN 424 CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname) 425 CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) 426 CALL msg(' isoName = '//strStack(isoName), modname) 427 CALL msg(' isoZone = '//strStack(isoZone), modname) 428 CALL msg(' isoPhas = '//TRIM(isoPhas), modname) 429 ELSE 430 CALL msg('No isotopes identified.', modname) 431 END IF 432 433 #ifdef ISOVERIF 434 CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname) 435 #endif 436 IF (CPPKEY_STRATAER) THEN 437 IF (type_trac == 'coag') THEN 356 438 nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)]) 357 439 nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)]) … … 362 444 id_H2SO4_strat = strIdx(tnames, 'GASH2SO4') 363 445 id_TEST_strat = strIdx(tnames, 'GASTEST' ) 364 END IF365 366 !=== DISPLAY THE RESULTS367 IF(.NOT.is_master) RETURN368 CALL msg('nqo = '//TRIM(int2str(nqo)), modname)369 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)370 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)371 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname)372 CALL msg('niso = '//TRIM(int2str(niso)), modname)373 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname)374 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname, CPPKEY_INCA)375 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname, CPPKEY_INCA)376 t => tracers377 CALL msg('Information stored in '//TRIM(modname)//': ', modname)378 IF(dispTable('issssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', &379 'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], &380 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&381 cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, &382 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) &383 CALL abort_physic(modname, "problem with the tracers table content", 1)384 CALL msg('No isotopes identified.', modname, nbIso == 0)385 IF(nbIso == 0) RETURN386 CALL msg('For isotopes family "H2O":', modname)387 CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname)388 CALL msg(' isoName = '//strStack(isoName), modname)389 CALL msg(' isoZone = '//strStack(isoZone), modname)390 CALL msg(' isoPhas = '//TRIM(isoPhas), modname)391 392 IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN393 446 CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname) 394 447 CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname) … … 399 452 CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname) 400 453 END IF 454 END IF 455 CALL msg('end', modname) 401 456 402 457 END SUBROUTINE init_infotrac_phy -
LMDZ6/branches/contrails/libf/phylmd/iophy.F90
r5489 r5536 13 13 INTEGER, SAVE :: itau_iophy 14 14 LOGICAL :: check_dim = .false. 15 !$OMP THREADPRIVATE(io_lat,io_lon,phys_domain_id,npstn,nptabij,itau_iophy) 15 16 !$OMP THREADPRIVATE(itau_iophy) 16 17 17 18 INTERFACE histwrite_phy … … 971 972 REAL, ALLOCATABLE, DIMENSION(:) :: fieldok 972 973 logical, save :: is_active = .true. 973 !$OMP THREADPRIVATE(is_active)974 974 975 975 IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name) -
LMDZ6/branches/contrails/libf/phylmd/iophys.F90
r5489 r5536 110 110 111 111 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 112 SUBROUTINE iophys_ini(timestep,nlev) 113 USE dimphy, ONLY: klev 112 SUBROUTINE iophys_ini(timestep) 114 113 USE mod_phys_lmdz_para, ONLY: is_mpi_root 115 114 USE vertical_layers_mod, ONLY: presnivs 116 115 USE regular_lonlat_mod, ONLY: lon_reg, lat_reg 116 USE dimphy, ONLY: klev 117 117 USE mod_grid_phy_lmdz, ONLY: klon_glo 118 118 USE time_phylmdz_mod, ONLY : annee_ref, day_ref, day_ini … … 139 139 ! ------------- 140 140 141 integer, intent(in) :: nlev142 real, intent(in) :: timestep143 144 141 real pi 145 142 INTEGER nlat_eff 146 143 INTEGER jour0,mois0,an0 147 REAL t 0144 REAL timestep,t0 148 145 CHARACTER(len=20) :: calendrier 149 integer ilev150 real coord_vert(nlev)151 146 152 147 ! Arguments: … … 183 178 print*,'iophys_ini annee_ref day_ref',annee_ref,day_ref,day_ini,calend,t0 184 179 185 if ( nlev == klev ) then 186 coord_vert=presnivs 187 print*,'ON EST LA ' 188 else 189 do ilev=1,nlev 190 coord_vert(ilev)=ilev 191 enddo 192 endif 193 print*,'nlev=',nlev 194 print*,'coord_vert',coord_vert 180 195 181 call iotd_ini('phys.nc', & 196 size(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 ! ------- 182 size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs,jour0,mois0,an0,t0,timestep,calendrier) 199 183 ENDIF 200 184 !$OMP END MASTER … … 232 216 233 217 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 236 218 USE iotd_mod_h 237 219 … … 248 230 integer i,j,l,ijl 249 231 250 !print*,'iotd_ecrit_seq ,nom,lllm,titre,unite,px',nom,lllm,titre,unite,px251 232 allocate(zx(imax,jmax,lllm)) 252 233 -
LMDZ6/branches/contrails/libf/phylmd/iostart.f90
r5489 r5536 4 4 INTEGER,SAVE :: nid_start 5 5 INTEGER,SAVE :: nid_restart 6 6 7 INTEGER,SAVE :: idim1,idim2,idim3,idim4 7 !$OMP THREADPRIVATE(nid_start,nid_restart,idim1,idim2,idim3,idim4)8 9 8 INTEGER,PARAMETER :: length=100 10 9 -
LMDZ6/branches/contrails/libf/phylmd/iotd_ecrit.f90
r5489 r5536 55 55 ! Ajouts 56 56 integer, save :: ntime=0 57 !$OMP THREADPRIVATE(ntime)58 57 integer :: idim,varid 59 58 character (len =50):: fichnom -
LMDZ6/branches/contrails/libf/phylmd/lmdz_cloudth.f90
r5489 r5536 69 69 REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 70 70 REAL zqs(ngrid), qcloud(ngrid) 71 REAL erf 71 72 72 73 … … 90 91 ! Initialisation des variables r?elles 91 92 !------------------------------------------------------------------------------- 92 sigma1(:, ind2)=0.93 sigma2(:, ind2)=0.94 qlth(:, ind2)=0.95 qlenv(:, ind2)=0.96 qltot(:, ind2)=0.97 rneb(:, ind2)=0.93 sigma1(:,:)=0. 94 sigma2(:,:)=0. 95 qlth(:,:)=0. 96 qlenv(:,:)=0. 97 qltot(:,:)=0. 98 rneb(:,:)=0. 98 99 qcloud(:)=0. 99 cth(:, ind2)=0.100 cenv(:, ind2)=0.101 ctot(:, ind2)=0.100 cth(:,:)=0. 101 cenv(:,:)=0. 102 ctot(:,:)=0. 102 103 qsatmmussig1=0. 103 104 qsatmmussig2=0. … … 316 317 REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 317 318 REAL zqs(ngrid), qcloud(ngrid) 319 REAL erf 318 320 319 321 !------------------------------------------------------------------------------ 320 322 ! Initialisation des variables r?elles 321 323 !------------------------------------------------------------------------------ 322 sigma1(:, ind2)=0.323 sigma2(:, ind2)=0.324 qlth(:, ind2)=0.325 qlenv(:, ind2)=0.326 qltot(:, ind2)=0.327 rneb(:, ind2)=0.324 sigma1(:,:)=0. 325 sigma2(:,:)=0. 326 qlth(:,:)=0. 327 qlenv(:,:)=0. 328 qltot(:,:)=0. 329 rneb(:,:)=0. 328 330 qcloud(:)=0. 329 cth(:, ind2)=0.330 cenv(:, ind2)=0.331 ctot(:, ind2)=0.331 cth(:,:)=0. 332 cenv(:,:)=0. 333 ctot(:,:)=0. 332 334 qsatmmussig1=0. 333 335 qsatmmussig2=0. … … 642 644 REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid) 643 645 REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 646 REAL erf 644 647 645 648 … … 660 663 ! Initialisation des variables r?elles 661 664 !------------------------------------------------------------------------------- 662 sigma1(:, ind2)=0.663 sigma2(:, ind2)=0.664 qlth(:, ind2)=0.665 qlenv(:, ind2)=0.666 qltot(:, ind2)=0.667 rneb(:, ind2)=0.665 sigma1(:,:)=0. 666 sigma2(:,:)=0. 667 qlth(:,:)=0. 668 qlenv(:,:)=0. 669 qltot(:,:)=0. 670 rneb(:,:)=0. 668 671 qcloud(:)=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.672 cth(:,:)=0. 673 cenv(:,:)=0. 674 ctot(:,:)=0. 675 cth_vol(:,:)=0. 676 cenv_vol(:,:)=0. 677 ctot_vol(:,:)=0. 675 678 qsatmmussig1=0. 676 679 qsatmmussig2=0. … … 875 878 REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 876 879 REAL zqs(ngrid), qcloud(ngrid) 880 REAL erf 877 881 878 882 REAL rhodz(ngrid,klev) … … 891 895 !------------------------------------------------------------------------------ 892 896 893 sigma1(:, ind2)=0.894 sigma2(:, ind2)=0.895 qlth(:, ind2)=0.896 qlenv(:, ind2)=0.897 qltot(:, ind2)=0.898 rneb(:, ind2)=0.897 sigma1(:,:)=0. 898 sigma2(:,:)=0. 899 qlth(:,:)=0. 900 qlenv(:,:)=0. 901 qltot(:,:)=0. 902 rneb(:,:)=0. 899 903 qcloud(:)=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.904 cth(:,:)=0. 905 cenv(:,:)=0. 906 ctot(:,:)=0. 907 cth_vol(:,:)=0. 908 cenv_vol(:,:)=0. 909 ctot_vol(:,:)=0. 906 910 qsatmmussig1=0. 907 911 qsatmmussig2=0. … … 1302 1306 REAL qcloud(ngrid) !eau totale dans le nuage 1303 1307 !Some arithmetic variables 1304 REAL 1308 REAL erf,pi,sqrt2,sqrt2pi 1305 1309 !Depth of the layer 1306 1310 REAL dz(ngrid,klev) !epaisseur de la couche en metre … … 1316 1320 ! Initialization 1317 1321 !------------------------------------------------------------------------------ 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.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. 1327 1331 qcloud(:)=0. 1328 1332 rdd=287.04 … … 1575 1579 REAL qlbef 1576 1580 REAL dqsatenv(klon), dqsatth(klon) 1581 REAL erf 1577 1582 REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon) 1578 1583 REAL zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon) -
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_old.f90
r5489 r5536 3 3 ! 4 4 MODULE lmdz_lscp_old 5 PRIVATE6 7 INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation8 LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle9 REAL, PARAMETER :: t_coup=234.010 REAL, PARAMETER :: DDT0=.0111 REAL, PARAMETER :: ztfondue=278.1512 13 LOGICAL, SAVE :: appel1er=.TRUE.14 !$OMP THREADPRIVATE(appel1er)15 16 PUBLIC fisrtilp_first, fisrtilp17 18 5 CONTAINS 19 20 ! firstilp first call part21 SUBROUTINE fisrtilp_first(klon, klev, dtime, pfrac_nucl, pfrac_1nucl, pfrac_impa)22 USE lmdz_lscp_ini, ONLY: prt_level, lunout23 IMPLICIT NONE24 REAL, INTENT(IN) :: dtime ! intervalle du temps (s)25 INTEGER, INTENT(IN) :: klon, klev26 INTEGER :: i, k27 28 !AA29 ! Coeffients de fraction lessivee : pour OFF-LINE30 !31 REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfrac_nucl32 REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfrac_1nucl33 REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfrac_impa34 35 IF (appel1er) THEN36 WRITE(lunout,*) 'fisrtilp, ninter:', ninter37 WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel38 WRITE(lunout,*) 'FISRTILP VERSION LUDO'39 40 IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN41 WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime42 WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes'43 ! CALL abort44 ENDIF45 !46 !cdir collapse47 DO k = 1, klev48 DO i = 1, klon49 pfrac_nucl(i,k)=1.50 pfrac_1nucl(i,k)=1.51 pfrac_impa(i,k)=1.52 ENDDO53 ENDDO54 appel1er = .FALSE.55 ENDIF56 57 END SUBROUTINE fisrtilp_first58 59 6 SUBROUTINE fisrtilp(klon,klev,dtime,paprs,pplay,t,q,ptconv,ratqs,sigma_qtherm, & 60 7 d_t, d_q, d_ql, d_qi, rneb,rneblsvol,radliq, rain, snow, & … … 170 117 REAL :: smallestreal 171 118 172 ! -------------------------------------------------------------------------------- 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 ! -------------------------------------------------------------------------------- 173 125 ! 174 126 ! Variables locales: … … 190 142 191 143 REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta, Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2, qcloud 144 REAL :: erf 192 145 193 146 REAL :: zqev, zqevt, zqev0,zqevi, zqevti, zdelq … … 212 165 REAL, DIMENSION(klon) :: zmqc 213 166 ! 167 LOGICAL, SAVE :: appel1er=.TRUE. 168 !$OMP THREADPRIVATE(appel1er) 214 169 ! 215 170 ! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max … … 241 196 REAL, DIMENSION(klon) :: zlh_solid 242 197 REAL :: zm_solid 243 REAL :: tmp_var1d(klon) ! temporary variable for call site244 198 245 199 … … 264 218 265 219 if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM' 266 267 beta(:,:)=0. !RomP initialisation => ym : could be probably removed but keept by security 268 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 269 243 ! 270 244 !MAf Initialisation a 0 de zoliq … … 980 954 ! -------------------------- 981 955 if (iflag_t_glace.ge.1) then 982 tmp_var1d(:) = pplay(:,k)/paprs(:,1) 983 CALL icefrac_lsc(klon, zt(:), tmp_var1d, zfice(:)) 956 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:)) 984 957 endif 985 958 … … 1150 1123 ELSE 1151 1124 if (iflag_t_glace.ge.1) then 1152 tmp_var1d(:) = pplay(:,k)/paprs(:,1) 1153 CALL icefrac_lsc(klon,zt(:),tmp_var1d,zfice(:)) 1125 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:)) 1154 1126 endif 1155 1127 if (iflag_fisrtilp_qsat.lt.1) then … … 1270 1242 ENDDO 1271 1243 ELSE ! of IF (iflag_t_glace.EQ.0) 1272 tmp_var1d(:) = pplay(:,k)/paprs(:,1) 1273 CALL icefrac_lsc(klon,zt(:), tmp_var1d, zfice(:)) 1244 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:)) 1274 1245 ! DO i = 1, klon 1275 1246 ! IF (rneb(i,k).GT.0.0) THEN -
LMDZ6/branches/contrails/libf/phylmd/lmdz_surf_wind.f90
r5489 r5536 2 2 CONTAINS 3 3 4 SUBROUTINE surf_wind(klon,ns urfwind,zu10m,zv10m,sigmaw,cstar,ustar,wstar,wind10ms,probu)4 SUBROUTINE surf_wind(klon,nsrfwnd,zu10m,zv10m,sigmaw,cstar,ustar,wstar,wind10ms,probu) 5 5 6 6 USE lmdz_surf_wind_ini, ONLY : iflag_surf_wind 7 7 8 8 IMPLICIT NONE 9 INTEGER, INTENT(IN) :: ns urfwind, klon9 INTEGER, INTENT(IN) :: nsrfwnd, klon 10 10 REAL, DIMENSION(klon), INTENT(IN) :: zu10m, zv10m 11 11 REAL, DIMENSION(klon), INTENT(IN) :: cstar 12 12 REAL, DIMENSION(klon), INTENT(IN) :: sigmaw 13 13 REAL, DIMENSION(klon), INTENT(IN) :: ustar, wstar 14 REAL, DIMENSION(klon,ns urfwind), INTENT(OUT) :: wind10ms, probu14 REAL, DIMENSION(klon,nsrfwnd), INTENT(OUT) :: wind10ms, probu 15 15 16 16 17 REAL, DIMENSION(klon,ns urfwind) :: sigma_th, sigma_wk18 REAL, DIMENSION(klon,ns urfwind) :: xp, yp, zz19 REAL, DIMENSION(klon,ns urfwind) :: vwx, vwy, vw20 REAL, DIMENSION(klon,ns urfwind) :: vtx, vty21 REAL, DIMENSION(klon,ns urfwind) :: windx, windy, wind17 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 22 22 REAL, DIMENSION(klon) :: ubwk, vbwk ! ubwk et vbwk sont les vitesses moyennes dans les poches 23 23 REAL, DIMENSION(klon) :: weilambda, U10mMOD … … 30 30 REAL :: ktwk, ktth, kzth 31 31 32 !print*,'LLLLLLLLLLLLLLLLLLLLL nsurfwind=',nsurfwind32 print*,'LLLLLLLLLLLLLLLLLLLLL nsrfwnd=',nsrfwnd 33 33 pi=2.*acos(0.) 34 34 ray=7000. … … 37 37 kzth=1. 38 38 kref=3 39 nwb=ns urfwind39 nwb=nsrfwnd 40 40 41 41 ubwk(klon) = zu10m(klon) … … 53 53 IF (iflag_surf_wind == 0) THEN 54 54 !U10mMOD=sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) 55 IF (ns urfwind /= 1 ) THEN56 STOP 'Si iflag_surf_wind=0, ns urfwind=1'55 IF (nsrfwnd /= 1 ) THEN 56 STOP 'Si iflag_surf_wind=0, nsrfwnd=1' 57 57 ENDIF 58 58 DO i=1,klon … … 66 66 67 67 DO i=1, klon 68 DO nmc=1, ns urfwind68 DO nmc=1, nsrfwnd 69 69 ! Utilisation de la distribution de weibull 70 70 !U10mMOD=sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) … … 90 90 91 91 DO i=1, klon 92 DO nmc=1, ns urfwind92 DO nmc=1, nsrfwnd 93 93 ! Utilisation de la distribution du vent a l interieur et a l exterieur des poches 94 94 call Random_number(zz) ! tirage uniforme entre 0 et 1. … … 122 122 wind(i,nmc) = sqrt(windx(i,nmc)**2 + windy(i,nmc)**2) 123 123 wind10ms(i,nmc) = wind(i,nmc) 124 probu(i,nmc) = wind(i,nmc)/ns urfwind124 probu(i,nmc) = wind(i,nmc)/nsrfwnd 125 125 126 126 ELSE … … 143 143 wind(i,nmc) = sqrt(windx(i,nmc)**2 + windy(i,nmc)**2) 144 144 wind10ms(i,nmc) = wind(i,nmc) 145 probu(i,nmc) = wind(i,nmc)/ns urfwind145 probu(i,nmc) = wind(i,nmc)/nsrfwnd 146 146 ! print*, 'wind10ms', wind10ms(i,nmc) 147 147 ENDIF -
LMDZ6/branches/contrails/libf/phylmd/lmdz_wake.f90
r5489 r5536 358 358 IF (CPPKEY_IOPHYS_WK) THEN 359 359 IF (phys_sub) THEN 360 call iophys_ini(dtimesub ,klev)360 call iophys_ini(dtimesub) 361 361 ELSE 362 call iophys_ini(dtime ,klev)362 call iophys_ini(dtime) 363 363 ENDIF 364 364 END IF -
LMDZ6/branches/contrails/libf/phylmd/modd_csts.f90
r5489 r5536 88 88 REAL,SAVE :: XSURF_EPSILON ! minimum space with 1.0 89 89 ! 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 97 90 END MODULE MODD_CSTS 98 91 -
LMDZ6/branches/contrails/libf/phylmd/oasis.F90
r5489 r5536 139 139 LOGICAL, SAVE :: cpl_current_omp 140 140 INTEGER, DIMENSION(klon_mpi) :: ind_cell_glo_mpi 141 142 !$OMP THREADPRIVATE(cpl_current_omp)143 144 141 145 142 !* 1. Initializations -
LMDZ6/branches/contrails/libf/phylmd/ocean_forced_mod.F90
r5489 r5536 335 335 REAL :: zfra 336 336 REAL, PARAMETER :: t_grnd=271.35 337 REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol , icesub337 REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol 338 338 REAL, DIMENSION(klon) :: alb_neig, tsurf_tmp 339 339 REAL, DIMENSION(klon) :: soilcap, soilflux … … 452 452 CALL fonte_neige( knon, is_sic, knindex, dtime, & 453 453 tsurf_tmp, precip_rain, precip_snow, & 454 snow, qsol, tsurf_new, evap , icesub&454 snow, qsol, tsurf_new, evap & 455 455 #ifdef ISO 456 456 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & -
LMDZ6/branches/contrails/libf/phylmd/output_physiqex_mod.f90
r5489 r5536 58 58 59 59 !$OMP MASTER 60 CALL iophys_ini(pdtphys ,klev)60 CALL iophys_ini(pdtphys) 61 61 !$OMP END MASTER 62 62 !$OMP BARRIER -
LMDZ6/branches/contrails/libf/phylmd/pbl_surface_mod.F90
r5489 r5536 277 277 !>jyg 278 278 alb_dir_m, alb_dif_m, zxsens, zxevap, zxsnowerosion, & 279 icesub_lic,alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &279 alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, & 280 280 zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, & 281 281 d_t, d_q, d_qbs, d_u, d_v, d_t_diss, & … … 522 522 REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards 523 523 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 sheet525 524 REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point 526 525 !!! jyg le ??? … … 746 745 REAL, DIMENSION(klon) :: AcoefQBS, BcoefQBS 747 746 REAL, DIMENSION(klon) :: ypsref 748 REAL, DIMENSION(klon) :: yevap, yevap_pot, ytsurf_new, yalb3_new , yicesub_lic747 REAL, DIMENSION(klon) :: yevap, yevap_pot, ytsurf_new, yalb3_new 749 748 !albedo SB >>> 750 749 REAL, DIMENSION(klon,nsw) :: yalb_dir_new, yalb_dif_new … … 1247 1246 zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.; zxfluxqbs(:,:)=0. 1248 1247 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0. 1249 runoff(:)=0. ; icesub_lic(:)=0.1248 runoff(:)=0. 1250 1249 #ifdef ISO 1251 1250 zxxtevap(:,:)=0. … … 2499 2498 ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, & 2500 2499 ysnow, yqsurf, yqsol,yqbs1, yagesno, & 2501 ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yicesub_lic,yfluxsens,yfluxlat, &2500 ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, & 2502 2501 yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, & 2503 2502 yzmea, yzsig, ycldt, & … … 2522 2521 sissnow(i) = ysissnow(j) 2523 2522 runoff(i) = yrunoff(j) 2524 icesub_lic(i) = yicesub_lic(j)*ypct(j)2525 2523 ENDDO 2526 2524 ! Martin … … 3227 3225 3228 3226 ENDIF ! (iflag_split .eq.0) 3229 3227 !!! 3230 3228 3231 3229 ! tendencies of blowing snow -
LMDZ6/branches/contrails/libf/phylmd/phyetat0_mod.f90
r5489 r5536 538 538 it = 0 539 539 DO iq = 1, nqtot 540 IF(.NOT. tracers(iq)%isInPhysics) CYCLE540 IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 541 541 it = it+1 542 542 tname = tracers(iq)%name -
LMDZ6/branches/contrails/libf/phylmd/phyredem.f90
r5489 r5536 360 360 it = 0 361 361 DO iq = 1, nqtot 362 IF(.NOT. tracers(iq)%isInPhysics) CYCLE362 IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 363 363 it = it+1 364 364 CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it)) -
LMDZ6/branches/contrails/libf/phylmd/phys_local_var_mod.F90
r5489 r5536 385 385 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw, water_budget 386 386 !$OMP THREADPRIVATE(dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw, water_budget) 387 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: icesub_lic388 !$OMP THREADPRIVATE(icesub_lic)389 387 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zustar, zu10m, zv10m, rh2m 390 388 !$OMP THREADPRIVATE(zustar, zu10m, zv10m, rh2m) … … 1035 1033 ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon)) 1036 1034 ALLOCATE(JrNt(klon)) 1037 ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon) , icesub_lic(klon))1035 ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon)) 1038 1036 ALLOCATE(prw(klon), prlw(klon), prsw(klon), prbsw(klon), water_budget(klon), zustar(klon), zu10m(klon), zv10m(klon), rh2m(klon)) 1039 1037 ALLOCATE(s_lcl(klon)) … … 1471 1469 DEALLOCATE(cldm, cldq, cldt, qsat2m) 1472 1470 DEALLOCATE(JrNt) 1473 DEALLOCATE(dthmin, evap, snowerosion, icesub_lic,fder, plcl, plfc)1471 DEALLOCATE(dthmin, evap, snowerosion, fder, plcl, plfc) 1474 1472 DEALLOCATE(prw, prlw, prsw, prbsw, water_budget, zustar, zu10m, zv10m, rh2m, s_lcl) 1475 1473 DEALLOCATE(s_pblh, s_pblt, s_therm) -
LMDZ6/branches/contrails/libf/phylmd/phys_output_ctrlout_mod.F90
r5489 r5536 384 384 TYPE(ctrl_out), SAVE :: o_snowerosion = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 385 385 '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) /))388 386 TYPE(ctrl_out), SAVE :: o_ustart_lic = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 389 387 'ustart_lic', 'threshold velocity', 'm/s', (/ ('', i=1, 10) /)) … … 2003 2001 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_sat(:) 2004 2002 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_uscav(:) 2005 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet_cv(:) 2006 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet(:) 2003 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet_con(:) 2007 2004 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_dry(:) 2008 2005 -
LMDZ6/branches/contrails/libf/phylmd/phys_output_mod.F90
r5489 r5536 7 7 USE phys_output_write_mod, ONLY : phys_output_write 8 8 REAL, DIMENSION(nfiles),SAVE :: ecrit_files 9 !$OMP THREADPRIVATE(ecrit_files)10 11 9 12 10 ! Abderrahmane 12 2007 … … 141 139 REAL, DIMENSION(nfiles), SAVE :: phys_out_latmin = [ -90., -90., -90., -90., -90., -90., -90., -90., -90., -90.] 142 140 REAL, DIMENSION(nfiles), SAVE :: phys_out_latmax = [ 90., 90., 90., 90., 90., 90., 90., 90., 90., 90.] 143 !$OMP THREADPRIVATE(phys_out_regfkey,phys_out_lonmin,phys_out_lonmax,phys_out_latmin,phys_out_latmax)144 145 141 REAL, DIMENSION(klev,2) :: Ahyb_bounds, Bhyb_bounds 146 142 REAL, DIMENSION(klev+1) :: lev_index … … 176 172 ALLOCATE(o_dtr_evapls(nqtot),o_dtr_ls(nqtot),o_dtr_trsp(nqtot)) 177 173 ALLOCATE(o_dtr_sscav(nqtot),o_dtr_sat(nqtot),o_dtr_uscav(nqtot)) 178 ALLOCATE(o_dtr_wet_c v(nqtot), o_dtr_wet(nqtot))174 ALLOCATE(o_dtr_wet_con(nqtot)) 179 175 ALLOCATE(o_dtr_dry(nqtot),o_dtr_vdf(nqtot)) 180 176 IF (CPPKEY_STRATAER) THEN … … 517 513 itr = 0; itrb = 0 518 514 DO iq = 1, nqtot 519 IF(.NOT. tracers(iq)%isInPhysics) CYCLE515 IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 520 516 itr = itr + 1 521 517 dn = 'd'//TRIM(tracers(iq)%name)//'_' … … 546 542 547 543 lnam = 'tracer convective wet deposition'//TRIM(tracers(iq)%longName) 548 tnam = TRIM(dn)//'wet_cv'; o_dtr_wet_cv (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) 549 lnam = 'tracer total wet deposition'//TRIM(tracers(iq)%longName) 550 tnam = TRIM(dn)//'wet'; o_dtr_wet (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) 544 tnam = TRIM(dn)//'wet_con'; o_dtr_wet_con (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) 551 545 lnam = 'tracer tendency dry deposition'//TRIM(tracers(iq)%longName) 552 546 tnam = 'cum'//TRIM(dn)//'dry'; o_dtr_dry (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) … … 642 636 643 637 ! DO iq=1,nqtot 644 ! IF(.NOT. tracers(iq)%isInPhysics) CYCLE638 ! IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 645 639 ! WRITE(*,'(a,i1,a,10i3)')'trac(',iq,')%flag = ',o_trac(iq)%flag 646 640 ! WRITE(*,'(a,i1,a)')'trac(',iq,')%name = '//TRIM(o_trac(iq)%name) -
LMDZ6/branches/contrails/libf/phylmd/phys_output_var_mod.f90
r5489 r5536 104 104 !$OMP THREADPRIVATE(clef_files, clef_stations, lev_files,nid_files,nnid_files) 105 105 INTEGER, DIMENSION(nfiles), SAVE :: nnhorim 106 106 107 INTEGER, DIMENSION(nfiles), SAVE :: nhorim, nvertm 107 108 INTEGER, DIMENSION(nfiles), SAVE :: nvertap, nvertbp, nvertAlt 108 109 REAL, DIMENSION(nfiles), SAVE :: zoutm 109 110 CHARACTER(LEN=20), DIMENSION(nfiles), SAVE :: type_ecri 110 !$OMP THREADPRIVATE(nnhorim, nhorim,nvertm,nvertap,nvertbp,nvertAlt,zoutm,type_ecri)111 !$OMP THREADPRIVATE(nnhorim, nhorim, nvertm, zoutm,type_ecri) 111 112 CHARACTER(LEN=20), DIMENSION(nfiles), SAVE :: type_ecri_files, phys_out_filetypes 112 113 !$OMP THREADPRIVATE(type_ecri_files, phys_out_filetypes) -
LMDZ6/branches/contrails/libf/phylmd/phys_output_write_mod.F90
r5489 r5536 6 6 USE phytrac_mod, ONLY : d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, & 7 7 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, & 9 flux_tr_wet_cv, flux_tr_wet, flux_tr_dry 8 d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, flux_tr_wet, flux_tr_dry 10 9 11 10 ! Author: Abderrahmane IDELKADI (original include file) … … 49 48 o_psol, o_mass, o_qsurf, o_qsol, & 50 49 o_precip, o_rain_fall, o_rain_con, o_ndayrain, o_plul, o_pluc, o_plun, & 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, & 50 o_snow, o_msnow, o_fsnow, o_evap, o_snowerosion, o_ustart_lic, o_qsalt_lic, o_rhosnow_lic, o_bsfall, & 53 51 o_ep,o_epmax_diag, & ! epmax_cape 54 52 o_tops, o_tops0, o_topl, o_topl0, & … … 191 189 o_dtr_insc, o_dtr_bcscav, o_dtr_evapls, & 192 190 o_dtr_ls, o_dtr_trsp, o_dtr_sscav, o_dtr_dry, & 193 o_dtr_sat, o_dtr_uscav, o_dtr_wet_c v, o_dtr_wet, &191 o_dtr_sat, o_dtr_uscav, o_dtr_wet_con, & 194 192 o_trac_cum, o_du_gwd_rando, o_dv_gwd_rando, & 195 193 o_ustr_gwd_hines,o_vstr_gwd_hines,o_ustr_gwd_rando,o_vstr_gwd_rando, & … … 319 317 USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, & 320 318 zn2mout, t2m_min_mon, t2m_max_mon, evap, & 321 snowerosion, icesub_lic,zxustartlic, zxrhoslic, zxqsaltlic, &319 snowerosion, zxustartlic, zxrhoslic, zxqsaltlic, & 322 320 l_mixmin,l_mix, pbl_eps, tke_shear, tke_buoy, tke_trans, & 323 321 zu10m, zv10m, zq2m, zustar, zxqsurf, & … … 918 916 CALL histwrite_phy(o_fsnow, zfra_o) 919 917 CALL histwrite_phy(o_evap, evap) 920 CALL histwrite_phy(o_icesub_lic, icesub_lic)921 918 922 919 IF (ok_bs) THEN … … 2866 2863 CALL histwrite_phy(o_dtr_uscav(itr),d_tr_uscav(:,:,itr)) 2867 2864 !--2D fields 2868 CALL histwrite_phy(o_dtr_wet_cv(itr), flux_tr_wet_cv(:,itr)) 2869 CALL histwrite_phy(o_dtr_wet(itr), flux_tr_wet(:,itr)) 2865 CALL histwrite_phy(o_dtr_wet_con(itr), flux_tr_wet(:,itr)) 2870 2866 CALL histwrite_phy(o_dtr_dry(itr), flux_tr_dry(:,itr)) 2871 2867 zx_tmp_fi2d=0. -
LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90
r5489 r5536 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, addPhase , ivap, iliq, isol, ibs, icf, irvc, ircont41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, addPhase 42 42 USE strings_mod, ONLY: strIdx 43 43 USE iophy … … 78 78 USE lmdz_lscp, ONLY : lscp 79 79 USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop 80 USE lmdz_lscp_old, ONLY : fisrtilp , fisrtilp_first80 USE lmdz_lscp_old, ONLY : fisrtilp 81 81 USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim 82 82 USE lmdz_wake_ini, ONLY : wake_ini … … 248 248 cldh, cldl,cldm, cldq, cldt, & 249 249 JrNt, & 250 dthmin, evap, snowerosion, icesub_lic,fder, plcl, plfc, &250 dthmin, evap, snowerosion,fder, plcl, plfc, & 251 251 prw, prlw, prsw, prbsw, water_budget, & 252 252 s_lcl, s_pblh, s_pblt, s_therm, & … … 376 376 USE phys_output_write_spl_mod, ONLY: phys_output_write_spl 377 377 USE phytracr_spl_mod, ONLY: phytracr_spl_out_init, phytracr_spl 378 USE s2s, ONLY : s2s_initialize379 378 IMPLICIT NONE 380 379 !>====================================================================== … … 513 512 !====================================================================== 514 513 ! 514 ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional) 515 INTEGER,SAVE :: ivap, iliq, isol, ibs, icf, irvc, ircont 516 !$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc, ircont) 517 ! 515 518 ! 516 519 ! Variables argument: … … 1018 1021 1019 1022 REAL picefra(klon,klev) 1020 REAL nm_oro(klon)1023 REAL zrel_oro(klon) 1021 1024 !IM cf. AM 081204 END 1022 1025 ! … … 1093 1096 CHARACTER*80 abort_message 1094 1097 LOGICAL, SAVE :: ok_sync, ok_sync_omp 1095 !$OMP THREADPRIVATE(ok_sync ,ok_sync_omp)1098 !$OMP THREADPRIVATE(ok_sync) 1096 1099 REAL date0 1097 1100 … … 1103 1106 REAL ztsol(klon) 1104 1107 REAL q2m(klon,nbsrf) ! humidite a 2m 1108 REAL fsnowerosion(klon,nbsrf) ! blowing snow flux at surface 1105 1109 REAL qbsfra ! blowing snow fraction 1106 1110 !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels … … 1266 1270 ! Subgrid scale wind : 1267 1271 ! Need to be allocatable/save because the number of bin is not known (provided by surf_wind_ini) 1268 integer, save :: ns urfwind=11272 integer, save :: nsrfwnd=1 1269 1273 real, dimension(:,:), allocatable, save :: surf_wind_value, surf_wind_proba ! module and probability of sugrdi wind wind sample 1270 !$OMP THREADPRIVATE(ns urfwind,surf_wind_value, surf_wind_proba)1274 !$OMP THREADPRIVATE(nsrfwnd,surf_wind_value, surf_wind_proba) 1271 1275 1272 1276 … … 1348 1352 1349 1353 IF (first) THEN 1350 1351 CALL s2s_initialize ! initialization of source to source tools 1352 1354 ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g')) 1355 iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) 1356 isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) 1357 ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) 1358 icf = strIdx(tracers(:)%name, addPhase('H2O', 'f')) 1359 irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c')) 1360 ircont = strIdx(tracers(:)%name, addPhase('H2O', 'a')) 1353 1361 ! CALL init_etat0_limit_unstruct 1354 1362 ! IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) … … 1833 1841 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1834 1842 CALL surf_wind_ini(klon,lunout) 1835 CALL getin_p('ns urfwind',nsurfwind)1836 allocate(surf_wind_value(klon,ns urfwind),surf_wind_proba(klon,nsurfwind))1843 CALL getin_p('nsrfwnd',nsrfwnd) 1844 allocate(surf_wind_value(klon,nsrfwnd),surf_wind_proba(klon,nsrfwnd)) 1837 1845 1838 1846 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1839 CALL iophys_ini(pdtphys,nsurfwind) ! replay automatic include ! replay automatic include1840 1847 CALL wake_ini(rg,rd,rv,prt_level) 1841 1848 CALL yamada_ini(klon,lunout,prt_level) … … 2910 2917 cdragh, cdragm, u1, v1, & 2911 2918 beta_aridity, & 2912 albsol_dir, albsol_dif, sens, evap, snowerosion, icesub_lic, & 2919 !albedo SB >>> 2920 ! albsol1, albsol2, sens, evap, & 2921 albsol_dir, albsol_dif, sens, evap, snowerosion, & 2922 !albedo SB <<< 2913 2923 albsol3_lic,runoff, snowhgt, qsnow, to_ice, sissnow, & 2914 2924 zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, & … … 3726 3736 ! poches, la tendance moyenne associ\'ee doit etre 3727 3737 ! multipliee par la fraction surfacique qu'ils couvrent. 3728 IF (mod(iflag_pbl_split/10,10) == 1) THEN3729 ! On tient compte du splitting pour modifier les profils deltatq/T des poches3730 DO k=1,klev3731 DO i=1,klon3732 d_deltat_the(i,k) = - d_t_ajs(i,k)3733 d_deltaq_the(i,k) = - d_q_ajs(i,k)3734 ENDDO3735 ENDDO3736 ELSE3737 d_deltat_the(:,:) = 0.3738 d_deltaq_the(:,:) = 0.3739 ENDIF3740 3741 3738 DO k=1,klev 3742 3739 DO i=1,klon 3740 ! 3741 d_deltat_the(i,k) = - d_t_ajs(i,k) 3742 d_deltaq_the(i,k) = - d_q_ajs(i,k) 3743 ! 3743 3744 d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i)) 3744 3745 d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i)) 3745 3746 d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i)) 3746 3747 d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i)) 3748 ! 3747 3749 ENDDO 3748 3750 ENDDO … … 3835 3837 !=================================================================== 3836 3838 ! Computation of subrgid scale near-surface wind distribution 3837 call surf_wind(klon,ns urfwind,u10m,v10m,wake_s,wake_Cstar,ustar,wstar,surf_wind_value,surf_wind_proba)3839 call surf_wind(klon,nsrfwnd,u10m,v10m,wake_s,wake_Cstar,ustar,wstar,surf_wind_value,surf_wind_proba) 3838 3840 3839 3841 !=================================================================== … … 3922 3924 3923 3925 ELSE 3924 3925 CALL fisrtilp_first(klon, klev, phys_tstep, pfrac_impa, pfrac_nucl, pfrac_1nucl) 3926 3926 3927 CALL fisrtilp(klon,klev,phys_tstep,paprs,pplay, & 3927 3928 t_seri, q_seri,ptconv,ratqs,sigma_qtherm, & … … 4858 4859 ! a l'echelle sous-maille: 4859 4860 ! 4860 4861 ! calculation of nm_oro4862 DO i=1,klon4863 ! nm_oro is a proxy for the number of subgrid scale mountains4864 ! -> condition on nm_oro can deactivate the lifting on tilted planar terrains4865 ! such as ice sheets (work by V. Wiener)4866 ! in such a case, the SSO scheme should activate only where nm_oro>0 i.e. by setting4867 ! nm_oro_t=0.4868 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.4869 ENDDO4870 4871 4861 IF (prt_level .GE.10) THEN 4872 4862 print *,' call orography ? ', ok_orodr … … 4879 4869 DO i=1,klon 4880 4870 itest(i)=0 4871 zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) 4872 !zrel_oro: relative mountain height wrt relief explained by mean slope 4873 ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains 4874 ! such as ice sheets (work by V. Wiener) 4881 4875 ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 4882 4876 ! earn computation time but they are not physical. 4883 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.( nm_oro(i).GT.nm_oro_t)) THEN4877 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 4884 4878 itest(i)=1 4885 4879 igwd=igwd+1 … … 4930 4924 DO i=1,klon 4931 4925 itest(i)=0 4932 IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN 4926 !zrel_oro: relative mountain height wrt relief explained by mean slope 4927 ! -> condition on zrel_oro can deactivate the lifting on tilted planar terrains 4928 ! such as ice sheets (work by V. Wiener) 4929 zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) 4930 IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN 4933 4931 itest(i)=1 4934 4932 igwd=igwd+1 … … 5171 5169 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE 5172 5170 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 5173 IF ((zstd(i).GT.1.0) .AND.( nm_oro(i).GT.nm_oro_t)) THEN5171 IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN 5174 5172 itest(i)=1 5175 5173 igwd=igwd+1 … … 5183 5181 DO i=1,klon 5184 5182 itest(i)=0 5185 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.( nm_oro(i).GT.nm_oro_t)) THEN5183 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 5186 5184 itest(i)=1 5187 5185 igwd=igwd+1 -
LMDZ6/branches/contrails/libf/phylmd/phystokenc_mod.f90
r5489 r5536 142 142 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: upwd 143 143 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: dnwd 144 !$OMP THREADPRIVATE(sh,da,phi,mp,upwd,dnwd) 145 144 146 145 REAL, SAVE :: dtcum 147 146 INTEGER, SAVE:: iadvtr=0 -
LMDZ6/branches/contrails/libf/phylmd/phytrac_mod.f90
r5489 r5536 35 35 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat 36 36 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav 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 37 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: flux_tr_wet ! tracer wet deposit (surface) jyg 39 38 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra dans pluie,air descente insaturee 40 39 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel … … 49 48 50 49 !$OMP THREADPRIVATE(qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa,d_tr_lessi_nucl) 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) 50 !$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet,qPr,qDi) 53 51 !$OMP THREADPRIVATE(d_tr_insc,d_tr_bcscav,d_tr_evapls,d_tr_ls,qPrls) 54 52 !$OMP THREADPRIVATE(d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv) … … 71 69 ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr)) 72 70 ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr)) 73 ALLOCATE(flux_tr_wet(klon,nbtr) ,flux_tr_wet_cv(klon,nbtr))71 ALLOCATE(flux_tr_wet(klon,nbtr)) 74 72 ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr)) 75 73 ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr)) … … 413 411 flux_tr_dry(i,it)=0. 414 412 flux_tr_wet(i,it)=0. 415 flux_tr_wet_cv(i,it)=0.416 413 ENDDO 417 414 ENDDO … … 703 700 !--with the full array tr_seri even if only item it is processed 704 701 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, 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, & 713 710 zmfd1a,zmfphi2,zmfdam) 714 711 … … 926 923 beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc,d_tr_bcscav,d_tr_evapls,qPrls) 927 924 928 !total wet deposit = large scale wet deposit + convective wet deposit929 DO i = 1, klon930 flux_tr_wet(i, it) = flux_tr_wet_cv(i, it) + &931 qPrls(i, it)*(prfl(i, 1)+psfl(i, 1))*pdtphys932 ENDDO ! i = 1, klon933 934 925 !large scale scavenging tendency 935 926 DO k = 1, klev -
LMDZ6/branches/contrails/libf/phylmd/readaerosol_mod.f90
r5489 r5536 4 4 5 5 REAL, SAVE :: not_valid=-333. 6 !$OMP THREADPRIVATE(not_valid)6 7 7 INTEGER, SAVE :: nbp_lon_src 8 8 !$OMP THREADPRIVATE(nbp_lon_src) … … 10 10 !$OMP THREADPRIVATE(nbp_lat_src) 11 11 REAL, ALLOCATABLE, SAVE :: psurf_interp(:,:) 12 !$OMP THREADPRIVATE(psurf_interp)13 12 14 13 CONTAINS -
LMDZ6/branches/contrails/libf/phylmd/surf_land_bucket_mod.F90
r5489 r5536 102 102 REAL, DIMENSION(klon) :: soilcap, soilflux 103 103 REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol 104 REAL, DIMENSION(klon) :: alb_neig, alb_lim , icesub104 REAL, DIMENSION(klon) :: alb_neig, alb_lim 105 105 REAL, DIMENSION(klon) :: zfra 106 106 REAL, DIMENSION(klon) :: radsol ! total net radiance at surface … … 239 239 CALL fonte_neige( knon, is_ter, knindex, dtime, & 240 240 tsurf, precip_rain, precip_snow, & 241 snow, qsol, tsurf_new, evap , icesub&241 snow, qsol, tsurf_new, evap & 242 242 #ifdef ISO 243 243 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & -
LMDZ6/branches/contrails/libf/phylmd/surf_landice_mod.F90
r5489 r5536 18 18 ps, u1, v1, gustiness, rugoro, pctsrf, & 19 19 snow, qsurf, qsol, qbs1, agesno, & 20 tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, icesub_lic,fluxsens, fluxlat, fluxbs, &20 tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, fluxbs, & 21 21 tsurf_new, dflux_s, dflux_l, & 22 22 alt, slope, cloudf, & … … 48 48 #endif 49 49 50 !FC 50 51 USE clesphys_mod_h 51 52 USE yomcst_mod_h 52 53 USE ioipsl_getin_p_mod, ONLY : getin_p 53 54 USE lmdz_blowing_snow_ini, ONLY : c_esalt_bs, zeta_bs, pbst_bs, prt_bs, rhoice_bs, rhohard_bs 54 55 USE lmdz_blowing_snow_ini, ONLY : rhofresh_bs, tau_eqsalt_bs, tau_dens0_bs, tau_densmin_bs … … 59 60 USE dimsoil_mod_h, ONLY: nsoilmx 60 61 62 ! INCLUDE "indicesol.h" 61 63 62 64 … … 119 121 REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir,alb_dif 120 122 !albedo SB <<< 121 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat , icesub_lic123 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 122 124 REAL, DIMENSION(klon), INTENT(OUT) :: fluxbs 123 125 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new … … 133 135 #ifdef ISO 134 136 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 135 139 #endif 136 140 … … 159 163 REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec 160 164 REAL, DIMENSION(klon) :: snow_prec,qsol_prec 165 ! real, DIMENSION(klon) :: run_off_lic_0_diag 161 166 #endif 162 167 … … 252 257 ! landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ... 253 258 ! landice_opt = 1 : prepare and call INterace Lmdz SISvat (INLANDSIS) 254 ! landice_opt = 2 : skip surf_landice and use orchidee over all land surfaces255 259 !**************************************************************************************** 256 260 … … 371 375 ! 372 376 !**************************************************************************************** 377 ! beta(:) = 1.0 378 ! dif_grnd(:) = 0.0 373 379 374 380 ! Suppose zero surface speed … … 387 393 #ifdef ISO 388 394 #ifdef ISOVERIF 395 !write(*,*) 'surf_land_ice 1499' 389 396 DO i=1,knon 390 397 IF (iso_eau > 0) THEN … … 420 427 ! 421 428 !**************************************************************************************** 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 422 437 423 438 ! Attantion: alb1 and alb2 are not the same! … … 607 622 CALL fonte_neige(knon, is_lic, knindex, dtime, & 608 623 tsurf, precip_rain, precip_totsnow, & 609 snow, qsol, tsurf_new, evap_totsnow , icesub_lic&624 snow, qsol, tsurf_new, evap_totsnow & 610 625 #ifdef ISO 611 626 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & -
LMDZ6/branches/contrails/libf/phylmd/traclmdz_mod.f90
r5489 r5536 261 261 it = 0 262 262 DO iq = 1, nqtot 263 IF(.NOT. tracers(iq)%isInPhysics) CYCLE263 IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 264 264 it = it+1 265 265 ! Test if tracer is zero everywhere. … … 310 310 311 311 USE yomcst_mod_h 312 312 USE dimphy 313 313 USE infotrac_phy, ONLY: nbtr, pbl_flg 314 314 USE strings_mod, ONLY: int2str -
LMDZ6/branches/contrails/libf/phylmd/yamada_c.F90
r5489 r5536 138 138 CALL getin_p('iflag_tke_diff',iflag_tke_diff) 139 139 allocate(l0(klon)) 140 #define IOPHYS 141 #ifdef IOPHYS 142 ! call iophys_ini(timestep) 143 #endif 140 144 firstcall=.false. 141 145 endif 142 146 143 147 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 144 155 145 156 nlay=klev -
LMDZ6/branches/contrails/libf/phylmdiso/phyetat0_mod.F90
r5489 r5536 549 549 it = 0 550 550 DO iq = 1, nqtot 551 IF(.NOT. tracers(iq)%isInPhysics) CYCLE551 IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 552 552 it = it+1 553 553 tname = tracers(iq)%name -
LMDZ6/branches/contrails/libf/phylmdiso/phyredem.F90
r5489 r5536 370 370 it = 0 371 371 DO iq = 1, nqtot 372 IF(.NOT. tracers(iq)%isInPhysics) CYCLE372 IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE 373 373 it = it+1 374 374 CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it)) -
LMDZ6/branches/contrails/libf/phylmdiso/physiq_mod.F90
r5489 r5536 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,addPhase, ivap, iliq, isol , ibs, icf, irvc41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,addPhase, ivap, iliq, isol 42 42 USE strings_mod, ONLY: strIdx 43 43 USE iophy … … 579 579 !====================================================================== 580 580 ! 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 ! 581 591 ! 582 592 ! Variables argument: … … 1111 1121 1112 1122 REAL picefra(klon,klev) 1113 REAL nm_oro(klon)1123 REAL zrel_oro(klon) 1114 1124 !IM cf. AM 081204 END 1115 1125 ! … … 1449 1459 1450 1460 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')) 1451 1467 ! CALL init_etat0_limit_unstruct 1452 1468 IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) … … 6267 6283 ! a l'echelle sous-maille: 6268 6284 ! 6269 6270 ! calculation of nm_oro6271 DO i=1,klon6272 ! nm_oro is a proxy for the number of subgrid scale mountains6273 ! -> condition on nm_oro can deactivate the lifting on tilted planar terrains6274 ! such as ice sheets (work by V. Wiener)6275 ! in such a case, the SSO scheme should activate only where nm_oro>0 i.e. by setting6276 ! nm_oro_t=0.6277 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.6278 END DO6279 6280 6285 IF (prt_level .GE.10) THEN 6281 6286 print *,' call orography ? ', ok_orodr 6282 6287 ENDIF 6283 6288 ! 6284 6289 IF (ok_orodr) THEN 6285 6290 ! … … 6288 6293 DO i=1,klon 6289 6294 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) 6290 6299 ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 6291 6300 ! earn computation time but they are not physical. 6292 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.( nm_oro(i).GT.nm_oro_t)) THEN6301 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 6293 6302 itest(i)=1 6294 6303 igwd=igwd+1 … … 6343 6352 DO i=1,klon 6344 6353 itest(i)=0 6345 IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN 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 6346 6359 itest(i)=1 6347 6360 igwd=igwd+1 … … 6617 6630 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE 6618 6631 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 6619 IF ((zstd(i).GT.1.0) .AND.( nm_oro(i).GT.nm_oro_t)) THEN6632 IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN 6620 6633 itest(i)=1 6621 6634 igwd=igwd+1 … … 6629 6642 DO i=1,klon 6630 6643 itest(i)=0 6631 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.( nm_oro(i).GT.nm_oro_t)) THEN6644 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 6632 6645 itest(i)=1 6633 6646 igwd=igwd+1
Note: See TracChangeset
for help on using the changeset viewer.
