Changeset 5489 for LMDZ6/branches/contrails
- Timestamp:
- Jan 17, 2025, 6:16:25 PM (12 days ago)
- Location:
- LMDZ6/branches/contrails
- Files:
-
- 56 edited
- 1 copied
-
. (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 (copied) (copied from LMDZ6/trunk/libf/phylmd/s2s.F90)
-
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 merged: 5451,5458,5460,5463,5468-5487
- Property svn:mergeinfo changed
-
LMDZ6/branches/contrails/DefLists/field_def_lmdz.xml
r5383 r5489 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)" /> 115 116 <field id="snowerosion" long_name="blowing snow erosion" unit="kg/(s*m2)" /> 116 117 <field id="bsfall" long_name="blowing snow precipitation" unit="kg/(s*m2)" /> -
LMDZ6/branches/contrails/libf/dyn3d/replay3d.f90
r5285 r5489 18 18 grossismx, grossismy, dzoomx, dzoomy,taux,tauy 19 19 USE mod_const_mpi, ONLY: comm_lmdz 20 USE ioipsl, only: getin 21 20 22 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 21 23 ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique … … 26 28 USE dimensions_mod, ONLY: iim, jjm, llm, ndm 27 29 USE paramet_mod_h 30 28 31 IMPLICIT NONE 29 32 … … 71 74 72 75 integer :: ntime=10000,it,klon,klev 76 77 character*20 :: lmax_replay 73 78 74 79 … … 162 167 163 168 164 CALL iophys_ini(900.)165 169 print*,'Rlatu=',rlatu 166 170 klon=2+iim*(jjm-1) 171 172 print*,'AVANT getin' 167 173 klev=llm 174 CALL getin('lmax_replay',lmax_replay) 175 print*,'APRES getin',lmax_replay 176 CALL getin(lmax_replay,klev) 177 print*,'replay3d lmax_replay klev',lmax_replay,klev 178 179 CALL iophys_ini(900.,klev) 168 180 169 181 !--------------------------------------------------------------------- -
LMDZ6/branches/contrails/libf/dyn3d_common/infotrac.f90
r5282 r5489 3 3 MODULE infotrac 4 4 5 USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse6 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, isoCheck9 USE readTracFiles_mod, ONLY:new2oldH2O, newHNO3, oldHNO35 USE strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx 6 USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, addPhase, addKey, iH2O, & 7 isoSelect, indexUpdate, isot_type, testTracersFiles, isotope, delPhase, getKey, tran0, & 8 isoKeys, isoName, isoZone, isoPhas, processIsotopes, isoCheck, itZonIso, nbIso, & 9 niso, ntiso, nzone, nphas, maxTableWidth, iqIsoPha, iqWIsoPha, ixIso, new2oldH2O, newHNO3, oldHNO3 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 |82 80 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 83 81 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | … … 103 101 104 102 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 105 INTEGER, SAVE :: nqtot, &!--- Tracers nb in dynamics (incl. higher moments + H2O)106 nbtr, &!--- Tracers nb in physics (excl. higher moments + H2O)107 nqo, &!--- Number of water phases108 nqtottr, &!--- Number of tracers passed to phytrac (TO BE DELETED ?)109 nqCO2!--- Number of tracers of CO2 (ThL)103 INTEGER, SAVE :: nqtot !--- Tracers nb in dynamics (incl. higher moments + H2O) 104 INTEGER, SAVE :: nbtr !--- Tracers nb in physics (excl. higher moments + H2O) 105 INTEGER, SAVE :: nqo !--- Number of water phases 106 INTEGER, SAVE :: nqtottr !--- Number of tracers passed to phytrac (TO BE DELETED ?) 107 INTEGER, SAVE :: nqCO2 !--- Number of tracers of CO2 (ThL) 110 108 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) 111 109 112 110 !=== VARIABLES FOR INCA 113 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: & 114 conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr) 111 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:) !--- Convection / boundary layer activation (nbtr) 115 112 116 113 CONTAINS … … 147 144 ! Local variables 148 145 INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number 149 INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA150 vad (:), vadv_inca(:), pbl_flg_inca(:)151 CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA152 146 INTEGER :: nqINCA 153 147 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 154 148 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 155 CHARACTER(LEN=maxlen) :: msg1, texp, ttp 149 CHARACTER(LEN=maxlen) :: msg1, texp, ttp, nam, val !--- Strings for messages and expanded tracers type 156 150 INTEGER :: fType !--- Tracers description file type ; 0: none 157 151 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 158 152 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 159 153 INTEGER :: iad !--- Advection scheme number 160 INTEGER :: iq, jq, nt, im, nm 161 LOGICAL :: lerr , ll154 INTEGER :: iq, jq, nt, im, nm, ig !--- Indexes and temporary variables 155 LOGICAL :: lerr 162 156 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 163 157 TYPE(trac_type), POINTER :: t1, t(:) … … 173 167 descrq(30) = 'PRA' 174 168 175 lerr=strParse(type_trac, '|', types_trac, n=nt)176 IF (nt .GT. 1) THEN177 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 ENDIF180 181 169 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 182 183 170 IF(strCount(type_trac, '|', nt)) CALL abort_gcm(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1) 171 IF(nt >= 3) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) 172 IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_gcm(modname, "couldn't parse "//'"type_trac"', 1) 173 IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON 174 175 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 176 177 !############################################################################################################################## 178 IF(.TRUE.) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 179 !############################################################################################################################## 184 180 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 185 181 msg1 = 'For type_trac = "'//TRIM(type_trac)//'":' … … 197 193 SELECT CASE(type_trac) 198 194 CASE('inca', 'inco') 199 IF (.NOT. CPPKEY_INCA) THEN 200 CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) 201 END IF 195 IF(.NOT.CPPKEY_INCA) CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) 202 196 CASE('repr') 203 IF (.NOT. CPPKEY_REPROBUS) THEN 204 CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 205 END IF 197 IF(.NOT.CPPKEY_REPROBUS) CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 206 198 CASE('coag') 207 IF (.NOT. CPPKEY_STRATAER) THEN 208 CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 209 END IF 199 IF(.NOT.CPPKEY_STRATAER) CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 210 200 END SELECT 211 212 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 201 !############################################################################################################################## 202 END IF 203 !############################################################################################################################## 213 204 214 205 !============================================================================================================================== 215 206 ! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT 216 207 !============================================================================================================================== 217 texp = type_trac 208 texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" 218 209 IF(texp == 'inco') texp = 'co2i|inca' 219 210 IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) 220 211 IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 221 212 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 !==============================================================================================================================227 213 !--------------------------------------------------------------------------------------------------------------------------- 228 214 IF(fType == 0) CALL abort_gcm(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1) 229 215 !--------------------------------------------------------------------------------------------------------------------------- 230 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def" 216 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) & !=== FOUND OLD STYLE INCA "traceur.def" 217 CALL abort_gcm(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1) 231 218 !--------------------------------------------------------------------------------------------------------------------------- 232 IF (CPPKEY_INCA) THEN 233 nqo = SIZE(tracers) - nqCO2 234 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 235 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac 236 nqtrue = nbtr + nqo !--- Total number of "true" tracers 237 IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) 238 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 239 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 240 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) 241 ALLOCATE(ttr(nqtrue)) 242 ttr(1:nqo+nqCO2) = tracers 243 ttr(1 : nqo )%component = 'lmdz' 244 ttr(1+nqo:nqCO2+nqo )%component = 'co2i' 245 ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' 246 ttr(1+nqo :nqtrue)%name = [('CO2 ', iq=1, nqCO2), solsym_inca] 247 ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 248 ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' 249 lerr = getKey('hadv', had, ky=tracers(:)%keys) 250 lerr = getKey('vadv', vad, ky=tracers(:)%keys) 251 hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca 252 vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca 253 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 254 DO iq = 1, nqtrue 255 t1 => tracers(iq) 256 CALL addKey('name', t1%name, t1%keys) 257 CALL addKey('component', t1%component, t1%keys) 258 CALL addKey('parent', t1%parent, t1%keys) 259 CALL addKey('phase', t1%phase, t1%keys) 260 END DO 261 IF(setGeneration(tracers)) CALL abort_gcm(modname,'See above',1) !- SET FIELDS %iGeneration, %gen0Name 262 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 263 END IF 264 !--------------------------------------------------------------------------------------------------------------------------- 265 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 266 !--------------------------------------------------------------------------------------------------------------------------- 219 220 !############################################################################################################################## 221 IF(readTracersFiles(ttp, lRepr=type_trac == 'repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 222 !############################################################################################################################## 223 224 !============================================================================================================================== 225 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. 226 !============================================================================================================================== 267 227 nqtrue = SIZE(tracers) !--- "true" tracers 268 228 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases 269 229 nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac 270 230 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 271 IF (CPPKEY_INCA) THEN 231 IF(CPPKEY_INCA) & 272 232 nqINCA = COUNT(tracers(:)%component == 'inca') 273 END IF 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 !============================================================================================================================== 274 238 IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "hadv"', 1) 275 239 IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "vadv"', 1) 276 !---------------------------------------------------------------------------------------------------------------------------277 END IF278 !---------------------------------------------------------------------------------------------------------------------------279 280 IF (CPPKEY_REPROBUS) THEN281 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)282 END IF283 284 !==============================================================================================================================285 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).286 !==============================================================================================================================287 240 DO iq = 1, nqtrue 288 241 IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE … … 302 255 303 256 !============================================================================================================================== 304 ! 3) Determine the advection scheme choice for water and tracers "iadv" and the field s long name, isAdvected.257 ! 3) Determine the advection scheme choice for water and tracers "iadv" and the field "long name". 305 258 ! iadv = 1 "LMDZ-specific humidity transport" (for H2O vapour) LMV 306 259 ! iadv = 2 backward (for H2O liquid) BAK … … 320 273 !============================================================================================================================== 321 274 ALLOCATE(ttr(nqtot)) 322 jq = nqtrue+1 ; tracers(:)%iadv = -1275 jq = nqtrue+1 323 276 DO iq = 1, nqtrue 324 277 t1 => tracers(iq) … … 331 284 IF(iad == -1) CALL abort_gcm(modname, msg1, 1) 332 285 333 !--- SET FIELDS longName , iadv, isAdvected, isInPhysics286 !--- SET FIELDS longName and iadv 334 287 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 335 288 t1%iadv = iad 336 t1%isAdvected = iad >= 0337 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O338 289 ttr(iq) = t1 339 290 … … 349 300 ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 350 301 ttr(jq+1:jq+nm)%iadv = [ (-iad, im=1, nm) ] 351 ttr(jq+1:jq+nm)%isAdvected = [ (.FALSE., im=1, nm) ]352 302 jq = jq + nm 353 303 END DO … … 359 309 360 310 !=== TEST ADVECTION SCHEME 361 DO iq = 1, nqtot ; t1 => tracers(iq); iad = t1%iadv 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)) 362 316 363 317 !--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers) 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 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) 379 329 END DO 380 330 … … 384 334 385 335 !--- Convection / boundary layer activation for all tracers 386 ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1387 ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1336 IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 337 IF(.NOT.ALLOCATED( pbl_flg)) ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 388 338 389 339 !--- Note: nqtottr can differ from nbtr when nmom/=0 … … 393 343 394 344 !=== DISPLAY THE RESULTS 345 IF(.NOT..TRUE.) RETURN 395 346 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 396 347 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) … … 399 350 CALL msg('niso = '//TRIM(int2str(niso)), modname) 400 351 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 401 IF (CPPKEY_INCA) THEN 402 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 403 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 404 END IF 352 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname, CPPKEY_INCA) 353 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname, CPPKEY_INCA) 405 354 t => tracers 406 355 CALL msg('Information stored in '//TRIM(modname)//': ', modname) … … 411 360 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & 412 361 CALL abort_gcm(modname, "problem with the tracers table content", 1) 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) 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) 423 369 424 370 END SUBROUTINE init_infotrac -
LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis.f90
r5285 r5489 279 279 itr=0 280 280 DO iq=1,nqtot 281 IF( .NOT.tracers(iq)%isAdvected) CYCLE281 IF(tracers(iq)%iadv < 0) CYCLE 282 282 itr = itr + 1 283 283 DO l=1,llm … … 597 597 itr = 0 598 598 DO iq=1,nqtot 599 IF( .NOT.tracers(iq)%isAdvected) CYCLE599 IF(tracers(iq)%iadv < 0) CYCLE 600 600 itr = itr + 1 601 601 DO l=1,llm -
LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis_loc.F90
r5367 r5489 356 356 itr = 0 357 357 DO iq=1,nqtot 358 IF( .NOT.tracers(iq)%isAdvected) CYCLE358 IF(tracers(iq)%iadv < 0) 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( .NOT.tracers(iq)%isAdvected) CYCLE1061 IF(tracers(iq)%iadv < 0) CYCLE 1062 1062 itr = itr + 1 1063 1063 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) -
LMDZ6/branches/contrails/libf/misc/readTracFiles_mod.f90
r5452 r5489 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 )=nqtrue64 63 LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr 65 64 INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:) … … 185 184 ! * The "keys" component (of type keys_type) is in principle enough to store everything we could need. 186 185 ! But some variables are stored as direct-access keys to make the code more readable and because they are used often. 187 ! * Most of the direct-access keys are set in this module, but some are not (longName, iadv , isAdvectedfor now).186 ! * Most of the direct-access keys are set in this module, but some are not (longName, iadv and isInPhysicsfor now). 188 187 ! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)" 189 188 ! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen). -
LMDZ6/branches/contrails/libf/misc/wxios_mod.F90
r5310 r5489 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)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE190 IF(.NOT.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)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE243 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 244 244 245 245 unt = "kg m-2" -
LMDZ6/branches/contrails/libf/phy_common/abort_physic.f90
r5268 r5489 49 49 endif 50 50 endif 51 END 51 END SUBROUTINE abort_physic -
LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_mpi_transfert.f90
r5268 r5489 65 65 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 66 66 67 !! -- Les chaine de charact ère -- !!67 !! -- Les chaine de charactere -- !! 68 68 69 69 SUBROUTINE bcast_mpi_c(var1) -
LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_omp_transfert.f90
r5268 r5489 116 116 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 117 117 118 !! -- Les chaine de charact ère -- !!118 !! -- Les chaine de charactere -- !! 119 119 120 120 SUBROUTINE bcast_omp_c(var) -
LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_transfert_para.f90
r5268 r5489 57 57 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 58 58 59 !! -- Les chaine de charact ère -- !!59 !! -- Les chaine de charactere -- !! 60 60 61 61 SUBROUTINE bcast_c(var) -
LMDZ6/branches/contrails/libf/phydev/infotrac_phy.f90
r5268 r5489 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 )=nqtrue35 34 LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr 36 35 INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:) -
LMDZ6/branches/contrails/libf/phylmd/Dust/read_dust.f90
r5337 r5489 21 21 save ncid1, varid1, ncid2, varid2 22 22 !$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2) 23 integer :: start (4),count(4), status23 integer :: start_(4),count_(4) 24 24 integer :: i, j, ig 25 25 ! … … 28 28 if (debutphy) then 29 29 ! 30 ncid1=nf90_open('dust.nc',nf90_nowrite,rcode) 31 varid1=nf90_inq_varid(ncid1,'EMISSION',rcode) 30 rcode=nf90_open('dust.nc',nf90_nowrite,ncid1) 31 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open dust.nc dans read_vent',1) ; endif 32 33 rcode=nf90_inq_varid(ncid1,'EMISSION',varid1) 34 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','inq varid EMISSION dans read_vent',1) ; endif 32 35 ! 33 36 endif 34 37 ! 35 start(1)=1 36 start(2)=1 37 start(4)=0 38 start_(1)=1 39 start_(2)=1 40 start_(3)=step 41 start_(4)=0 38 42 39 ! count (1)=iip140 count (1)=nbp_lon+141 ! count (2)=jjp142 count (2)=nbp_lat43 count (3)=144 count (4)=043 ! count_(1)=iip1 44 count_(1)=nbp_lon+1 45 ! count_(2)=jjp1 46 count_(2)=nbp_lat 47 count_(3)=1 48 count_(4)=0 45 49 ! 46 start(3)=step47 50 ! 48 status = nf90_get_var(ncid1, varid1, dust_nc_glo, start, count) 51 rcode = nf90_get_var(ncid1, varid1, dust_nc_glo, start_, count_) 52 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get EMISSION dans read_vent',1) ; endif 49 53 50 54 ! -
LMDZ6/branches/contrails/libf/phylmd/Dust/read_surface.f90
r5337 r5489 31 31 real surfa_glo(klon_glo,5) 32 32 ! 33 integer ncid, varid, rcode 34 integer start (2),count(2),status33 integer ncid, varid, rcode, varlatid,tmpid 34 integer start_(2),count_(2) 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) :: start_j,endj 44 44 !JE20140526>> 45 45 !$OMP MASTER … … 47 47 48 48 print*,'Lecture du fichier donnees_lisa.nc' 49 ncid=nf90_open('donnees_lisa.nc',nf90_nowrite,rcode) 49 rcode=nf90_open('donnees_lisa.nc',nf90_nowrite,ncid) 50 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open donnees_lisa.nc dans read_vent',1) ; endif 51 50 52 51 53 !JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa … … 54 56 isinversed=.false. 55 57 do i=1,5 56 if (i==1) aux4s='latu' 57 if (i==2) aux4s='LATU' 58 if (i==3) aux4s='LatU' 59 if (i==4) aux4s='Latu' 60 if (i==5) aux4s='latU' 61 status = nf90_inq_varid(ncid, aux4s, rcode) 62 ! print *,'stat,i',status,i,outcycle,aux4s 63 ! print *,'ifclause',status.NE. nf90_noerr ,outcycle == .false. 64 IF ((.not.(status.NE. nf90_noerr) ).and.( .not. outcycle )) THEN 65 outcycle=.true. 66 latstr=aux4s 67 ENDIF 58 if (i==1) aux4s='latu' 59 if (i==2) aux4s='LATU' 60 if (i==3) aux4s='LatU' 61 if (i==4) aux4s='Latu' 62 if (i==5) aux4s='latU' 63 rcode = nf90_inq_varid(ncid, aux4s, tmpid) 64 IF ((rcode==0).and.( .not. outcycle )) THEN 65 outcycle=.true. 66 varlatid=tmpid 67 ENDIF 68 68 enddo ! check if it inversed lat 69 startj(1)=1 70 ! endj(1)=jjp1 69 start_j(1)=1 71 70 endj(1)=nbp_lat 72 varid=nf90_inq_varid(ncid,latstr,rcode) 71 rcode = nf90_get_var(ncid, varlatid, lats_glo, start_j, endj) 72 if ( .not. outcycle ) then ; call abort_physic('LMDZ','get lat dans read_surface',1) ; endif 73 73 74 status = nf90_get_var(ncid, varid, lats_glo, startj, endj) 75 ! print *,latstr,varid,status,jjp1,rcode 76 ! IF (status .NE. nf90_noerr) print*,'NOOOOOOO' 77 ! print *,lats 78 !stop 74 79 75 80 76 ! check if netcdf is latitude inversed or not. … … 86 82 write(str1,'(i1)') i 87 83 varname=trim(name)//str1 88 print*,'lecture variable:',varname89 varid=nf90_inq_varid(ncid,trim(varname),rcode)84 rcode=nf90_inq_varid(ncid,trim(varname),varid) 85 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//' dans read_vent',1) ; endif 90 86 ! varid=nf90_inq_varid(ncid,varname,rcode) 91 87 … … 93 89 ! ----------------------------------------------------- 94 90 95 start (1)=196 start (2)=197 count (1)=nbp_lon+198 ! count (1)=iip199 count (2)=nbp_lat100 ! count (2)=jjp191 start_(1)=1 92 start_(2)=1 93 count_(1)=nbp_lon+1 94 ! count_(1)=iip1 95 count_(2)=nbp_lat 96 ! count_(2)=jjp1 101 97 102 98 ! mise a zero des tableaux … … 106 102 ! Lecture 107 103 ! ----------------------- 108 status = nf90_get_var(ncid, varid, tmp_dyn_glo, start, count) 104 rcode = nf90_get_var(ncid, varid, tmp_dyn_glo, start_, count_) 105 if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//' dans read_vent',1) ; endif 109 106 110 107 ! call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn ') -
LMDZ6/branches/contrails/libf/phylmd/Dust/read_vent.f90
r5337 r5489 23 23 save ncidu1, varidu1, ncidv1, varidv1 24 24 !$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1) 25 integer :: start(4),count (4), status25 integer :: start(4),count_(4) 26 26 integer :: i, j, ig 27 27 … … 32 32 if (debutphy) then 33 33 ! 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) 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 38 42 ! 39 43 endif … … 41 45 start(1)=1 42 46 start(2)=1 47 start(3)=step 43 48 start(4)=0 44 49 45 ! count (1)=iip146 count (1)=nbp_lon+147 ! count (2)=jjp148 count (2)=nbp_lat49 count (3)=150 count (4)=050 ! count_(1)=iip1 51 count_(1)=nbp_lon+1 52 ! count_(2)=jjp1 53 count_(2)=nbp_lat 54 count_(3)=1 55 count_(4)=0 51 56 ! 52 start(3)=step53 57 ! 54 status = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count) 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 55 62 56 ! print *,status 57 ! 58 status = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count) 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 ----------------------------------------------------- 59 73 60 74 ! … … 63 77 ! print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1) 64 78 65 ! print *, status79 ! print *,rcode 66 80 ! call correctbid(iim,jjp1,u10m_nc) 67 81 ! call correctbid(iim,jjp1,v10m_nc) -
LMDZ6/branches/contrails/libf/phylmd/calcul_fluxs_mod.f90
r5285 r5489 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)183 179 ENDDO 184 180 -
LMDZ6/branches/contrails/libf/phylmd/carbon_cycle_mod.f90
r5338 r5489 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 352 356 353 357 !----------------------------------------------------------------------- -
LMDZ6/branches/contrails/libf/phylmd/clesphys_mod_h.f90
r5364 r5489 22 22 , co2_ppm0 & 23 23 , tau_thermals & 24 , Cd_frein, zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t &24 , Cd_frein, nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t & 25 25 , ecrit_LES & 26 26 , ecrit_ins, ecrit_hf, ecrit_day & … … 55 55 56 56 ! threshold on to activate SSO schemes 57 ! threshold on to activate SSO schemes 58 REAL zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t 57 REAL nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t 59 58 INTEGER iflag_cycle_diurne 60 59 LOGICAL soil_model, new_oliq, ok_orodr, ok_orolf … … 179 178 !$OMP , co2_ppm0 & 180 179 !$OMP , tau_thermals & 181 !$OMP , Cd_frein, zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t &180 !$OMP , Cd_frein, nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t & 182 181 !$OMP , ecrit_LES & 183 182 !$OMP , ecrit_ins, ecrit_hf, ecrit_day & -
LMDZ6/branches/contrails/libf/phylmd/conf_phys_m.f90
r5364 r5489 213 213 LOGICAL, SAVE :: ok_lic_cond_omp 214 214 ! 215 REAL, SAVE :: zrel_oro_t_omp, zstd_orodr_t_omp215 REAL, SAVE :: nm_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 = zrel_oro_t896 !Config Desc = zrel_oro_t897 !Config Def = 9999.895 !Config Key = nm_oro_t 896 !Config Desc = nm_oro_t 897 !Config Def = -1 898 898 !Config Help = Connais pas ! 899 zrel_oro_t_omp = 9999.900 CALL getin(' zrel_oro_t', zrel_oro_t_omp)899 nm_oro_t_omp = -1. 900 CALL getin('nm_oro_t', nm_oro_t_omp) 901 901 902 902 !Config Key = zstd_orodr_t … … 2313 2313 ok_orodr = ok_orodr_omp 2314 2314 ok_orolf = ok_orolf_omp 2315 zrel_oro_t=zrel_oro_t_omp2315 nm_oro_t=nm_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,*) ' zrel_oro_t=',zrel_oro_t2734 WRITE(lunout,*) ' nm_oro_t=',nm_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
r5346 r5489 4938 4938 USE lmdz_cv_ini, ONLY : nl 4939 4939 USE cvflag_mod_h 4940 USE ioipsl_getin_p_mod, ONLY : getin_p 4940 4941 IMPLICIT NONE 4941 4942 4942 4943 4943 4944 !inputs: 4945 !------ 4944 4946 INTEGER, INTENT (IN) :: ncum, nd, na, nloc, len 4945 4947 INTEGER, DIMENSION (len), INTENT (IN) :: icb, inb … … 4949 4951 REAL, DIMENSION (len, nd+1), INTENT (IN) :: Vprecip 4950 4952 !ouputs: 4953 !------ 4951 4954 REAL, DIMENSION (len, na, na), INTENT (OUT) :: phi, phi2, epmlmMm 4952 4955 REAL, DIMENSION (len, na), INTENT (OUT) :: da, d1a, dam, eplaMm 4953 4956 ! 4957 !local variables: 4958 !--------------- 4954 4959 ! variables pour tracer dans precip de l'AA et des mel 4955 !local variables:4956 4960 INTEGER i, j, k 4957 4961 REAL epm(nloc, na, na) 4962 ! 4963 LOGICAL,SAVE :: first=.TRUE. 4964 LOGICAL,SAVE :: keep_bug_indices_cv3_tracer 4965 !$OMP THREADPRIVATE(first, keep_bug_indices_cv3_tracer) 4958 4966 4959 4967 ! variables d'Emanuel : du second indice au troisieme … … 4962 4970 ! variables personnelles : du troisieme au second indice 4963 4971 ! ---> tab(i,j,k) -> de k a j 4964 ! phi, phi2 4965 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) 4966 4979 ! initialisations 4967 4980 … … 5022 5035 d1a(i, j) = d1a(i, j) + ment(i, k, j)*ep(i, k)*(1.-sigij(i,k,j)) 5023 5036 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))5025 5037 phi2(i, j, k) = phi(i, j, k)*epm(i, j, k) 5026 5038 END IF … … 5028 5040 END DO 5029 5041 END DO 5042 5043 IF (keep_bug_indices_cv3_tracer) THEN 5044 DO j = 1, nl 5045 DO k = 1, nl 5046 DO i = 1, ncum 5047 IF (k<=j) THEN 5048 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 DO 5051 END DO 5052 END DO 5053 ELSE ! (keep_bug_indices_cv3_tracer) 5054 DO j = 1, nl 5055 DO k = 1, nl 5056 DO i = 1, ncum 5057 IF (k<=j) THEN 5058 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 DO 5061 END DO 5062 END DO 5063 ENDIF ! (keep_bug_indices_cv3_tracer) 5030 5064 5031 5065 RETURN -
LMDZ6/branches/contrails/libf/phylmd/dimphy.f90
r5268 r5489 13 13 INTEGER,SAVE :: kflev 14 14 15 !$OMP THREADPRIVATE(klon,k fdia,kidia,kdlon)15 !$OMP THREADPRIVATE(klon,kdlon,kfdia,kidia,klev,klevp1,klevm1,kflev) 16 16 REAL,save,allocatable,dimension(:) :: zmasq 17 17 !$OMP THREADPRIVATE(zmasq) -
LMDZ6/branches/contrails/libf/phylmd/dyn1d/replay1d.f90
r5390 r5489 24 24 CHARACTER (len=10) :: calend 25 25 CHARACTER(len=20) :: calendrier 26 26 CHARACTER(len=20) :: lmax_replay 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=llm 61 CALL getin('lmax_replay',lmax_replay) 62 print*,'APRES getin',lmax_replay 63 CALL getin(lmax_replay,klev) 64 print*,'replay1d lmax_replay klev',lmax_replay,klev 65 58 66 calendrier=calend 59 67 if ( calendrier == "earth_360d" ) calendrier="360_day" … … 69 77 70 78 klon=1 71 klev=llm72 79 call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,86400./day_step,calendrier) 73 80 ! Consistent with ... CALL iophys_ini(600.) -
LMDZ6/branches/contrails/libf/phylmd/fonte_neige_mod.F90
r5285 r5489 231 231 SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, & 232 232 tsurf, precip_rain, precip_snow, & 233 snow, qsol, tsurf_new, evap &233 snow, qsol, tsurf_new, evap, ice_sub & 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_sub 290 292 #ifdef ISO 291 293 ! sortie de quelques diagnostiques … … 297 299 REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag 298 300 REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag 299 REAL, INTENT(OUT) :: coeff_rel_diag 300 #endif 301 REAL, INTENT(OUT) :: coeff_rel_diag 302 #endif 303 301 304 302 305 ! Local variables … … 345 348 346 349 snow_evap = 0. 350 ice_sub(:) = 0. 347 351 348 352 IF (.NOT. ok_lic_cond) THEN … … 363 367 364 368 bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime 369 370 IF (nisurf==is_lic) THEN 371 DO i=1,knon 372 ice_sub(i)=evap(i)-snow_evap(i) 373 ENDDO 374 ENDIF 375 365 376 #ifdef ISO 366 377 snow_evap_diag(:) = snow_evap(:) -
LMDZ6/branches/contrails/libf/phylmd/infotrac_phy.F90
r5394 r5489 3 3 MODULE infotrac_phy 4 4 5 USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx6 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, isoCheck9 USE readTracFiles_mod, ONLY:new2oldH2O5 USE strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx 6 USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, addPhase, addKey, iH2O, & 7 isoSelect, indexUpdate, isot_type, testTracersFiles, isotope, delPhase, getKey, tran0, & 8 isoKeys, isoName, isoZone, isoPhas, processIsotopes, isoCheck, itZonIso, nbIso, & 9 niso, ntiso, nzone, nphas, maxTableWidth, iqIsoPha, iqWIsoPha, ixIso, new2oldH2O 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 29 PUBLIC :: ivap, iliq, isol, ibs, icf, irvc, ircont 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 ! | isAdvected | Advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | 83 ! | isInPhysics | Tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | 82 ! | isInPhysics | Advected tracers from the main table kept in physics | / | nqtottr .TRUE. values | 84 83 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 85 84 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | … … 104 103 105 104 !=== INDICES FOR WATER 106 INTEGER, SAVE :: ivap, iliq, isol 107 !$OMP THREADPRIVATE(ivap, iliq, isol )105 INTEGER, SAVE :: ivap, iliq, isol, ibs, icf, irvc, ircont 106 !$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc, ircont) 108 107 109 108 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 110 INTEGER, SAVE :: nqtot!--- Tracers nb in dynamics (incl. higher moments + H2O)111 INTEGER, SAVE :: nbtr!--- Tracers nb in physics (excl. higher moments + H2O)112 INTEGER, SAVE :: nqo!--- Number of water phases113 INTEGER, SAVE :: nqtottr!--- Number of tracers passed to phytrac (TO BE DELETED ?)114 INTEGER, SAVE :: nqCO2!--- Number of tracers of CO2 (ThL)109 INTEGER, SAVE :: nqtot !--- Tracers nb in dynamics (incl. higher moments + H2O) 110 INTEGER, SAVE :: nbtr !--- Tracers nb in physics (excl. higher moments + H2O) 111 INTEGER, SAVE :: nqo !--- Number of water phases 112 INTEGER, SAVE :: nqtottr !--- Number of tracers passed to phytrac (TO BE DELETED ?) 113 INTEGER, SAVE :: nqCO2 !--- Number of tracers of CO2 (ThL) 115 114 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) 116 115 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac) 117 116 118 117 !=== VARIABLES FOR INCA 119 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: conv_flg, pbl_flg!--- Convection / boundary layer activation (nbtr)118 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:) !--- Convection / boundary layer activation (nbtr) 120 119 !$OMP THREADPRIVATE(conv_flg, pbl_flg) 121 120 … … 133 132 USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_trac 134 133 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS, CPPKEY_STRATAER 135 IMPLICIT NONE 134 USE mod_phys_lmdz_para, ONLY: is_master, is_omp_master 135 IMPLICIT NONE 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 INCA161 vad (:), vadv_inca(:), pbl_flg_inca(:)162 CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA163 160 INTEGER :: nqINCA 164 161 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:) … … 187 184 CALL getin_p('type_trac',type_trac) 188 185 189 lerr=strParse(type_trac, '|', types_trac, n=nt)190 IF (nt .GT. 1) THEN191 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 ENDIF186 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname, is_master) 187 IF(strCount(type_trac, '|', nt)) CALL abort_physic(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1) 188 IF(nt >= 3) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) 189 IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_physic(modname, "couldn't parse "//'"type_trac"', 1) 190 IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON 194 191 195 192 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) … … 197 194 198 195 !############################################################################################################################## 199 IF(lInit ) THEN!=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####196 IF(lInit .AND. is_master) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 200 197 !############################################################################################################################## 201 198 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION … … 214 211 SELECT CASE(type_trac) 215 212 CASE('inca', 'inco') 216 IF (.NOT. CPPKEY_INCA) THEN 217 CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1) 218 END IF 213 IF(.NOT.CPPKEY_INCA) CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1) 219 214 CASE('repr') 220 IF (.NOT. CPPKEY_REPROBUS) THEN 221 CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 222 END IF 215 IF(.NOT.CPPKEY_REPROBUS) CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 223 216 CASE('coag') 224 IF (.NOT. CPPKEY_STRATAER) THEN 225 CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 226 END IF 217 IF(.NOT.CPPKEY_STRATAER) CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 227 218 END SELECT 228 219 !############################################################################################################################## … … 230 221 !############################################################################################################################## 231 222 232 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )233 234 223 !============================================================================================================================== 235 224 ! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT 236 225 !============================================================================================================================== 237 texp = type_trac 226 texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" 238 227 IF(texp == 'inco') texp = 'co2i|inca' 239 228 IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) 240 IF(testTracersFiles(modname, texp, fType, lInit )) CALL abort_physic(modname, 'problem with tracers file(s)',1)229 IF(testTracersFiles(modname, texp, fType, lInit.AND.is_master)) CALL abort_physic(modname, 'problem with tracers file(s)',1) 241 230 ttp = type_trac; IF(fType /= 1) ttp = texp 242 243 !##############################################################################################################################244 IF(lInit) THEN245 IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)246 ELSE247 CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname)248 END IF249 !##############################################################################################################################250 251 !==============================================================================================================================252 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.253 !==============================================================================================================================254 231 !--------------------------------------------------------------------------------------------------------------------------- 255 232 IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1) 256 233 !--------------------------------------------------------------------------------------------------------------------------- 257 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac) .AND. lInit) THEN !=== FOUND OLD STYLE INCA "traceur.def" 234 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) & !=== FOUND OLD STYLE INCA "traceur.def" 235 CALL abort_physic(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1) 258 236 !--------------------------------------------------------------------------------------------------------------------------- 259 IF (CPPKEY_INCA) THEN 260 nqo = SIZE(tracers) - nqCO2 261 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 262 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac 263 nqtrue = nbtr + nqo !--- Total number of "true" tracers 264 IF(ALL([2,3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) 265 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 266 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 267 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) 268 ALLOCATE(ttr(nqtrue)) 269 ttr(1:nqo+nqCO2) = tracers 270 ttr(1 : nqo )%component = 'lmdz' 271 ttr(1+nqo:nqCO2+nqo )%component = 'co2i' 272 ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' 273 ttr(1+nqo :nqtrue)%name = [('CO2 ', iq=1, nqCO2), solsym_inca] 274 ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 275 ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' 276 lerr = getKey('hadv', had, ky=tracers(:)%keys) 277 lerr = getKey('vadv', vad, ky=tracers(:)%keys) 278 hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca 279 vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca 280 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 281 DO iq = 1, nqtrue 282 t1 => tracers(iq) 283 CALL addKey('name', t1%name, t1%keys) 284 CALL addKey('component', t1%component, t1%keys) 285 CALL addKey('parent', t1%parent, t1%keys) 286 CALL addKey('phase', t1%phase, t1%keys) 287 END DO 288 IF(setGeneration(tracers)) CALL abort_physic(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name 289 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 290 END IF 291 !--------------------------------------------------------------------------------------------------------------------------- 292 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 293 !--------------------------------------------------------------------------------------------------------------------------- 237 238 !############################################################################################################################## 239 IF(lInit) THEN 240 IF(readTracersFiles(ttp, lRepr=type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1) 241 END IF 242 CALL msg('No tracers description file(s) reading needed: already done', modname, .NOT.lInit.AND.is_master) 243 !############################################################################################################################## 244 245 !============================================================================================================================== 246 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. 247 !============================================================================================================================== 294 248 nqtrue = SIZE(tracers) !--- "true" tracers 295 249 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases 296 250 nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac 297 251 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 298 IF (CPPKEY_INCA) THEN 252 IF(CPPKEY_INCA) & 299 253 nqINCA = COUNT(tracers(:)%component == 'inca') 300 END IF 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 !============================================================================================================================== 301 259 IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1) 302 260 IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1) 303 !---------------------------------------------------------------------------------------------------------------------------304 END IF305 !---------------------------------------------------------------------------------------------------------------------------306 307 IF (CPPKEY_REPROBUS) THEN308 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus309 END IF310 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 !==============================================================================================================================318 261 DO iq = 1, nqtrue 319 262 IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE … … 332 275 END IF 333 276 334 !============================================================================================================================== 335 ! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names, nqtot and %isAdvected 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 336 283 !============================================================================================================================== 337 284 ALLOCATE(ttr(nqtot)) 338 jq = nqtrue+1 ; tracers(:)%iadv = -1285 jq = nqtrue+1 339 286 DO iq = 1, nqtrue 340 287 t1 => tracers(iq) … … 347 294 IF(iad == -1) CALL abort_physic(modname, msg1, 1) 348 295 349 !--- SET FIELDS longName, is Advected, isInPhysics296 !--- SET FIELDS longName, isInPhysics 350 297 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 351 t1%isAdvected = iad >= 0 352 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O 298 t1%isInPhysics= iad >= 0 .AND. (delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz') 353 299 ttr(iq) = t1 354 300 … … 363 309 ttr(jq+1:jq+nm)%parent = [ (TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 364 310 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) ]366 311 ttr(jq+1:jq+nm)%isInPhysics = [ (.FALSE., im=1, nm) ] 367 312 jq = jq + nm … … 373 318 IF(indexUpdate(tracers)) CALL abort_physic(modname, 'problem with tracers indices update', 1) 374 319 375 !##############################################################################################################################376 END IF377 !##############################################################################################################################378 379 !##############################################################################################################################380 IF(.NOT.lInit) THEN381 !##############################################################################################################################382 nqtot = SIZE(tracers)383 !##############################################################################################################################384 ELSE385 !##############################################################################################################################386 387 320 !=== READ PHYSICAL PARAMETERS FOR ISOTOPES 388 321 niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE. … … 390 323 391 324 !############################################################################################################################## 392 END IF 393 !############################################################################################################################## 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 394 337 !--- Convection / boundary layer activation for all tracers 395 338 IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 … … 401 344 CALL abort_physic(modname, 'problem with the computation of nqtottr', 1) 402 345 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 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 438 356 nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)]) 439 357 nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)]) … … 444 362 id_H2SO4_strat = strIdx(tnames, 'GASH2SO4') 445 363 id_TEST_strat = strIdx(tnames, 'GASTEST' ) 364 END IF 365 366 !=== DISPLAY THE RESULTS 367 IF(.NOT.is_master) RETURN 368 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 => tracers 377 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) RETURN 386 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') THEN 446 393 CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname) 447 394 CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname) … … 452 399 CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname) 453 400 END IF 454 END IF455 CALL msg('end', modname)456 401 457 402 END SUBROUTINE init_infotrac_phy -
LMDZ6/branches/contrails/libf/phylmd/iophy.F90
r5310 r5489 13 13 INTEGER, SAVE :: itau_iophy 14 14 LOGICAL :: check_dim = .false. 15 16 !$OMP THREADPRIVATE(itau_iophy) 15 !$OMP THREADPRIVATE(io_lat,io_lon,phys_domain_id,npstn,nptabij,itau_iophy) 17 16 18 17 INTERFACE histwrite_phy … … 972 971 REAL, ALLOCATABLE, DIMENSION(:) :: fieldok 973 972 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
r5390 r5489 110 110 111 111 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 112 SUBROUTINE iophys_ini(timestep) 112 SUBROUTINE iophys_ini(timestep,nlev) 113 USE dimphy, ONLY: klev 113 114 USE mod_phys_lmdz_para, ONLY: is_mpi_root 114 115 USE vertical_layers_mod, ONLY: presnivs 115 116 USE regular_lonlat_mod, ONLY: lon_reg, lat_reg 116 USE dimphy, ONLY: klev117 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) :: nlev 142 real, intent(in) :: timestep 143 141 144 real pi 142 145 INTEGER nlat_eff 143 146 INTEGER jour0,mois0,an0 144 REAL t imestep,t0147 REAL t0 145 148 CHARACTER(len=20) :: calendrier 149 integer ilev 150 real coord_vert(nlev) 146 151 147 152 ! Arguments: … … 178 183 print*,'iophys_ini annee_ref day_ref',annee_ref,day_ref,day_ini,calend,t0 179 184 180 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 181 195 call iotd_ini('phys.nc', & 182 size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs,jour0,mois0,an0,t0,timestep,calendrier) 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 ! ------- 183 199 ENDIF 184 200 !$OMP END MASTER … … 216 232 217 233 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 218 236 USE iotd_mod_h 219 237 … … 230 248 integer i,j,l,ijl 231 249 250 !print*,'iotd_ecrit_seq ,nom,lllm,titre,unite,px',nom,lllm,titre,unite,px 232 251 allocate(zx(imax,jmax,lllm)) 233 252 -
LMDZ6/branches/contrails/libf/phylmd/iostart.f90
r5268 r5489 4 4 INTEGER,SAVE :: nid_start 5 5 INTEGER,SAVE :: nid_restart 6 7 6 INTEGER,SAVE :: idim1,idim2,idim3,idim4 7 !$OMP THREADPRIVATE(nid_start,nid_restart,idim1,idim2,idim3,idim4) 8 8 9 INTEGER,PARAMETER :: length=100 9 10 -
LMDZ6/branches/contrails/libf/phylmd/iotd_ecrit.f90
r5450 r5489 55 55 ! Ajouts 56 56 integer, save :: ntime=0 57 !$OMP THREADPRIVATE(ntime) 57 58 integer :: idim,varid 58 59 character (len =50):: fichnom -
LMDZ6/branches/contrails/libf/phylmd/lmdz_cloudth.f90
r5285 r5489 69 69 REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 70 70 REAL zqs(ngrid), qcloud(ngrid) 71 REAL erf72 71 73 72 … … 91 90 ! Initialisation des variables r?elles 92 91 !------------------------------------------------------------------------------- 93 sigma1(:, :)=0.94 sigma2(:, :)=0.95 qlth(:, :)=0.96 qlenv(:, :)=0.97 qltot(:, :)=0.98 rneb(:, :)=0.92 sigma1(:,ind2)=0. 93 sigma2(:,ind2)=0. 94 qlth(:,ind2)=0. 95 qlenv(:,ind2)=0. 96 qltot(:,ind2)=0. 97 rneb(:,ind2)=0. 99 98 qcloud(:)=0. 100 cth(:, :)=0.101 cenv(:, :)=0.102 ctot(:, :)=0.99 cth(:,ind2)=0. 100 cenv(:,ind2)=0. 101 ctot(:,ind2)=0. 103 102 qsatmmussig1=0. 104 103 qsatmmussig2=0. … … 317 316 REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 318 317 REAL zqs(ngrid), qcloud(ngrid) 319 REAL erf320 318 321 319 !------------------------------------------------------------------------------ 322 320 ! Initialisation des variables r?elles 323 321 !------------------------------------------------------------------------------ 324 sigma1(:, :)=0.325 sigma2(:, :)=0.326 qlth(:, :)=0.327 qlenv(:, :)=0.328 qltot(:, :)=0.329 rneb(:, :)=0.322 sigma1(:,ind2)=0. 323 sigma2(:,ind2)=0. 324 qlth(:,ind2)=0. 325 qlenv(:,ind2)=0. 326 qltot(:,ind2)=0. 327 rneb(:,ind2)=0. 330 328 qcloud(:)=0. 331 cth(:, :)=0.332 cenv(:, :)=0.333 ctot(:, :)=0.329 cth(:,ind2)=0. 330 cenv(:,ind2)=0. 331 ctot(:,ind2)=0. 334 332 qsatmmussig1=0. 335 333 qsatmmussig2=0. … … 644 642 REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid) 645 643 REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 646 REAL erf647 644 648 645 … … 663 660 ! Initialisation des variables r?elles 664 661 !------------------------------------------------------------------------------- 665 sigma1(:, :)=0.666 sigma2(:, :)=0.667 qlth(:, :)=0.668 qlenv(:, :)=0.669 qltot(:, :)=0.670 rneb(:, :)=0.662 sigma1(:,ind2)=0. 663 sigma2(:,ind2)=0. 664 qlth(:,ind2)=0. 665 qlenv(:,ind2)=0. 666 qltot(:,ind2)=0. 667 rneb(:,ind2)=0. 671 668 qcloud(:)=0. 672 cth(:, :)=0.673 cenv(:, :)=0.674 ctot(:, :)=0.675 cth_vol(:, :)=0.676 cenv_vol(:, :)=0.677 ctot_vol(:, :)=0.669 cth(:,ind2)=0. 670 cenv(:,ind2)=0. 671 ctot(:,ind2)=0. 672 cth_vol(:,ind2)=0. 673 cenv_vol(:,ind2)=0. 674 ctot_vol(:,ind2)=0. 678 675 qsatmmussig1=0. 679 676 qsatmmussig2=0. … … 878 875 REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 879 876 REAL zqs(ngrid), qcloud(ngrid) 880 REAL erf881 877 882 878 REAL rhodz(ngrid,klev) … … 895 891 !------------------------------------------------------------------------------ 896 892 897 sigma1(:, :)=0.898 sigma2(:, :)=0.899 qlth(:, :)=0.900 qlenv(:, :)=0.901 qltot(:, :)=0.902 rneb(:, :)=0.893 sigma1(:,ind2)=0. 894 sigma2(:,ind2)=0. 895 qlth(:,ind2)=0. 896 qlenv(:,ind2)=0. 897 qltot(:,ind2)=0. 898 rneb(:,ind2)=0. 903 899 qcloud(:)=0. 904 cth(:, :)=0.905 cenv(:, :)=0.906 ctot(:, :)=0.907 cth_vol(:, :)=0.908 cenv_vol(:, :)=0.909 ctot_vol(:, :)=0.900 cth(:,ind2)=0. 901 cenv(:,ind2)=0. 902 ctot(:,ind2)=0. 903 cth_vol(:,ind2)=0. 904 cenv_vol(:,ind2)=0. 905 ctot_vol(:,ind2)=0. 910 906 qsatmmussig1=0. 911 907 qsatmmussig2=0. … … 1306 1302 REAL qcloud(ngrid) !eau totale dans le nuage 1307 1303 !Some arithmetic variables 1308 REAL erf,pi,sqrt2,sqrt2pi1304 REAL pi,sqrt2,sqrt2pi 1309 1305 !Depth of the layer 1310 1306 REAL dz(ngrid,klev) !epaisseur de la couche en metre … … 1320 1316 ! Initialization 1321 1317 !------------------------------------------------------------------------------ 1322 qlth(:, :)=0.1323 qlenv(:, :)=0.1324 qltot(:, :)=0.1325 cth_vol(:, :)=0.1326 cenv_vol(:, :)=0.1327 ctot_vol(:, :)=0.1328 cth_surf(:, :)=0.1329 cenv_surf(:, :)=0.1330 ctot_surf(:, :)=0.1318 qlth(:,ind2)=0. 1319 qlenv(:,ind2)=0. 1320 qltot(:,ind2)=0. 1321 cth_vol(:,ind2)=0. 1322 cenv_vol(:,ind2)=0. 1323 ctot_vol(:,ind2)=0. 1324 cth_surf(:,ind2)=0. 1325 cenv_surf(:,ind2)=0. 1326 ctot_surf(:,ind2)=0. 1331 1327 qcloud(:)=0. 1332 1328 rdd=287.04 … … 1579 1575 REAL qlbef 1580 1576 REAL dqsatenv(klon), dqsatth(klon) 1581 REAL erf1582 1577 REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon) 1583 1578 REAL zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon) -
LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_old.f90
r5285 r5489 3 3 ! 4 4 MODULE lmdz_lscp_old 5 PRIVATE 6 7 INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation 8 LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle 9 REAL, PARAMETER :: t_coup=234.0 10 REAL, PARAMETER :: DDT0=.01 11 REAL, PARAMETER :: ztfondue=278.15 12 13 LOGICAL, SAVE :: appel1er=.TRUE. 14 !$OMP THREADPRIVATE(appel1er) 15 16 PUBLIC fisrtilp_first, fisrtilp 17 5 18 CONTAINS 19 20 ! firstilp first call part 21 SUBROUTINE fisrtilp_first(klon, klev, dtime, pfrac_nucl, pfrac_1nucl, pfrac_impa) 22 USE lmdz_lscp_ini, ONLY: prt_level, lunout 23 IMPLICIT NONE 24 REAL, INTENT(IN) :: dtime ! intervalle du temps (s) 25 INTEGER, INTENT(IN) :: klon, klev 26 INTEGER :: i, k 27 28 !AA 29 ! Coeffients de fraction lessivee : pour OFF-LINE 30 ! 31 REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfrac_nucl 32 REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfrac_1nucl 33 REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfrac_impa 34 35 IF (appel1er) THEN 36 WRITE(lunout,*) 'fisrtilp, ninter:', ninter 37 WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel 38 WRITE(lunout,*) 'FISRTILP VERSION LUDO' 39 40 IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN 41 WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime 42 WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes' 43 ! CALL abort 44 ENDIF 45 ! 46 !cdir collapse 47 DO k = 1, klev 48 DO i = 1, klon 49 pfrac_nucl(i,k)=1. 50 pfrac_1nucl(i,k)=1. 51 pfrac_impa(i,k)=1. 52 ENDDO 53 ENDDO 54 appel1er = .FALSE. 55 ENDIF 56 57 END SUBROUTINE fisrtilp_first 58 6 59 SUBROUTINE fisrtilp(klon,klev,dtime,paprs,pplay,t,q,ptconv,ratqs,sigma_qtherm, & 7 60 d_t, d_q, d_ql, d_qi, rneb,rneblsvol,radliq, rain, snow, & … … 117 170 REAL :: smallestreal 118 171 119 INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation 120 LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle 121 REAL, PARAMETER :: t_coup=234.0 122 REAL, PARAMETER :: DDT0=.01 123 REAL, PARAMETER :: ztfondue=278.15 124 ! -------------------------------------------------------------------------------- 172 ! -------------------------------------------------------------------------------- 125 173 ! 126 174 ! Variables locales: … … 142 190 143 191 REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta, Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2, qcloud 144 REAL :: erf145 192 146 193 REAL :: zqev, zqevt, zqev0,zqevi, zqevti, zdelq … … 165 212 REAL, DIMENSION(klon) :: zmqc 166 213 ! 167 LOGICAL, SAVE :: appel1er=.TRUE.168 !$OMP THREADPRIVATE(appel1er)169 214 ! 170 215 ! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max … … 196 241 REAL, DIMENSION(klon) :: zlh_solid 197 242 REAL :: zm_solid 243 REAL :: tmp_var1d(klon) ! temporary variable for call site 198 244 199 245 … … 218 264 219 265 if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM' 220 IF (appel1er) THEN 221 WRITE(lunout,*) 'fisrtilp, ninter:', ninter 222 WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel 223 WRITE(lunout,*) 'FISRTILP VERSION LUDO' 224 225 IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN 226 WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime 227 WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes' 228 ! CALL abort 229 ENDIF 230 appel1er = .FALSE. 231 ! 232 !cdir collapse 233 DO k = 1, klev 234 DO i = 1, klon 235 pfrac_nucl(i,k)=1. 236 pfrac_1nucl(i,k)=1. 237 pfrac_impa(i,k)=1. 238 beta(i,k)=0. !RomP initialisation 239 ENDDO 240 ENDDO 241 242 ENDIF ! test sur appel1er 266 267 beta(:,:)=0. !RomP initialisation => ym : could be probably removed but keept by security 268 243 269 ! 244 270 !MAf Initialisation a 0 de zoliq … … 954 980 ! -------------------------- 955 981 if (iflag_t_glace.ge.1) then 956 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:)) 982 tmp_var1d(:) = pplay(:,k)/paprs(:,1) 983 CALL icefrac_lsc(klon, zt(:), tmp_var1d, zfice(:)) 957 984 endif 958 985 … … 1123 1150 ELSE 1124 1151 if (iflag_t_glace.ge.1) then 1125 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:)) 1152 tmp_var1d(:) = pplay(:,k)/paprs(:,1) 1153 CALL icefrac_lsc(klon,zt(:),tmp_var1d,zfice(:)) 1126 1154 endif 1127 1155 if (iflag_fisrtilp_qsat.lt.1) then … … 1242 1270 ENDDO 1243 1271 ELSE ! of IF (iflag_t_glace.EQ.0) 1244 CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:)) 1272 tmp_var1d(:) = pplay(:,k)/paprs(:,1) 1273 CALL icefrac_lsc(klon,zt(:), tmp_var1d, zfice(:)) 1245 1274 ! DO i = 1, klon 1246 1275 ! IF (rneb(i,k).GT.0.0) THEN -
LMDZ6/branches/contrails/libf/phylmd/lmdz_surf_wind.f90
r5450 r5489 2 2 CONTAINS 3 3 4 SUBROUTINE surf_wind(klon,ns rfwnd,zu10m,zv10m,sigmaw,cstar,ustar,wstar,wind10ms,probu)4 SUBROUTINE surf_wind(klon,nsurfwind,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 rfwnd, klon9 INTEGER, INTENT(IN) :: nsurfwind, 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 rfwnd), INTENT(OUT) :: wind10ms, probu14 REAL, DIMENSION(klon,nsurfwind), INTENT(OUT) :: wind10ms, probu 15 15 16 16 17 REAL, DIMENSION(klon,ns rfwnd) :: sigma_th, sigma_wk18 REAL, DIMENSION(klon,ns rfwnd) :: xp, yp, zz19 REAL, DIMENSION(klon,ns rfwnd) :: vwx, vwy, vw20 REAL, DIMENSION(klon,ns rfwnd) :: vtx, vty21 REAL, DIMENSION(klon,ns rfwnd) :: windx, windy, wind17 REAL, DIMENSION(klon,nsurfwind) :: sigma_th, sigma_wk 18 REAL, DIMENSION(klon,nsurfwind) :: xp, yp, zz 19 REAL, DIMENSION(klon,nsurfwind) :: vwx, vwy, vw 20 REAL, DIMENSION(klon,nsurfwind) :: vtx, vty 21 REAL, DIMENSION(klon,nsurfwind) :: 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 nsrfwnd=',nsrfwnd32 !print*,'LLLLLLLLLLLLLLLLLLLLL nsurfwind=',nsurfwind 33 33 pi=2.*acos(0.) 34 34 ray=7000. … … 37 37 kzth=1. 38 38 kref=3 39 nwb=ns rfwnd39 nwb=nsurfwind 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 rfwnd /= 1 ) THEN56 STOP 'Si iflag_surf_wind=0, ns rfwnd=1'55 IF (nsurfwind /= 1 ) THEN 56 STOP 'Si iflag_surf_wind=0, nsurfwind=1' 57 57 ENDIF 58 58 DO i=1,klon … … 66 66 67 67 DO i=1, klon 68 DO nmc=1, ns rfwnd68 DO nmc=1, nsurfwind 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 rfwnd92 DO nmc=1, nsurfwind 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 rfwnd124 probu(i,nmc) = wind(i,nmc)/nsurfwind 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 rfwnd145 probu(i,nmc) = wind(i,nmc)/nsurfwind 146 146 ! print*, 'wind10ms', wind10ms(i,nmc) 147 147 ENDIF -
LMDZ6/branches/contrails/libf/phylmd/lmdz_wake.f90
r5400 r5489 358 358 IF (CPPKEY_IOPHYS_WK) THEN 359 359 IF (phys_sub) THEN 360 call iophys_ini(dtimesub )360 call iophys_ini(dtimesub,klev) 361 361 ELSE 362 call iophys_ini(dtime )362 call iophys_ini(dtime,klev) 363 363 ENDIF 364 364 END IF -
LMDZ6/branches/contrails/libf/phylmd/modd_csts.f90
r5268 r5489 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 90 97 END MODULE MODD_CSTS 91 98 -
LMDZ6/branches/contrails/libf/phylmd/oasis.F90
r5310 r5489 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 141 144 142 145 !* 1. Initializations -
LMDZ6/branches/contrails/libf/phylmd/ocean_forced_mod.F90
r5301 r5489 335 335 REAL :: zfra 336 336 REAL, PARAMETER :: t_grnd=271.35 337 REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol 337 REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol, icesub 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 &454 snow, qsol, tsurf_new, evap, icesub & 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
r5268 r5489 58 58 59 59 !$OMP MASTER 60 CALL iophys_ini(pdtphys )60 CALL iophys_ini(pdtphys,klev) 61 61 !$OMP END MASTER 62 62 !$OMP BARRIER -
LMDZ6/branches/contrails/libf/phylmd/pbl_surface_mod.F90
r5310 r5489 277 277 !>jyg 278 278 alb_dir_m, alb_dif_m, zxsens, zxevap, zxsnowerosion, & 279 alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, &279 icesub_lic, alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, & 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 sheet 524 525 REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point 525 526 !!! jyg le ??? … … 745 746 REAL, DIMENSION(klon) :: AcoefQBS, BcoefQBS 746 747 REAL, DIMENSION(klon) :: ypsref 747 REAL, DIMENSION(klon) :: yevap, yevap_pot, ytsurf_new, yalb3_new 748 REAL, DIMENSION(klon) :: yevap, yevap_pot, ytsurf_new, yalb3_new, yicesub_lic 748 749 !albedo SB >>> 749 750 REAL, DIMENSION(klon,nsw) :: yalb_dir_new, yalb_dif_new … … 1246 1247 zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.; zxfluxqbs(:,:)=0. 1247 1248 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0. 1248 runoff(:)=0. 1249 runoff(:)=0. ; icesub_lic(:)=0. 1249 1250 #ifdef ISO 1250 1251 zxxtevap(:,:)=0. … … 2498 2499 ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, & 2499 2500 ysnow, yqsurf, yqsol,yqbs1, yagesno, & 2500 ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yfluxsens,yfluxlat, &2501 ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yicesub_lic, yfluxsens,yfluxlat, & 2501 2502 yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, & 2502 2503 yzmea, yzsig, ycldt, & … … 2521 2522 sissnow(i) = ysissnow(j) 2522 2523 runoff(i) = yrunoff(j) 2524 icesub_lic(i) = yicesub_lic(j)*ypct(j) 2523 2525 ENDDO 2524 2526 ! Martin … … 3225 3227 3226 3228 ENDIF ! (iflag_split .eq.0) 3227 !!! 3229 3228 3230 3229 3231 ! tendencies of blowing snow -
LMDZ6/branches/contrails/libf/phylmd/phyetat0_mod.f90
r5452 r5489 538 538 it = 0 539 539 DO iq = 1, nqtot 540 IF(.NOT. (tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE540 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 541 541 it = it+1 542 542 tname = tracers(iq)%name -
LMDZ6/branches/contrails/libf/phylmd/phyredem.f90
r5452 r5489 360 360 it = 0 361 361 DO iq = 1, nqtot 362 IF(.NOT. (tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE362 IF(.NOT.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
r5456 r5489 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_lic 388 !$OMP THREADPRIVATE(icesub_lic) 387 389 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zustar, zu10m, zv10m, rh2m 388 390 !$OMP THREADPRIVATE(zustar, zu10m, zv10m, rh2m) … … 1033 1035 ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon)) 1034 1036 ALLOCATE(JrNt(klon)) 1035 ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon) )1037 ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon), icesub_lic(klon)) 1036 1038 ALLOCATE(prw(klon), prlw(klon), prsw(klon), prbsw(klon), water_budget(klon), zustar(klon), zu10m(klon), zv10m(klon), rh2m(klon)) 1037 1039 ALLOCATE(s_lcl(klon)) … … 1469 1471 DEALLOCATE(cldm, cldq, cldt, qsat2m) 1470 1472 DEALLOCATE(JrNt) 1471 DEALLOCATE(dthmin, evap, snowerosion, fder, plcl, plfc)1473 DEALLOCATE(dthmin, evap, snowerosion, icesub_lic, fder, plcl, plfc) 1472 1474 DEALLOCATE(prw, prlw, prsw, prbsw, water_budget, zustar, zu10m, zv10m, rh2m, s_lcl) 1473 1475 DEALLOCATE(s_pblh, s_pblt, s_therm) -
LMDZ6/branches/contrails/libf/phylmd/phys_output_ctrlout_mod.F90
r5456 r5489 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) /)) 386 388 TYPE(ctrl_out), SAVE :: o_ustart_lic = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 387 389 'ustart_lic', 'threshold velocity', 'm/s', (/ ('', i=1, 10) /)) … … 2001 2003 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_sat(:) 2002 2004 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_uscav(:) 2003 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet_con(:) 2005 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet_cv(:) 2006 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet(:) 2004 2007 TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_dry(:) 2005 2008 -
LMDZ6/branches/contrails/libf/phylmd/phys_output_mod.F90
r5450 r5489 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 9 11 10 12 ! Abderrahmane 12 2007 … … 139 141 REAL, DIMENSION(nfiles), SAVE :: phys_out_latmin = [ -90., -90., -90., -90., -90., -90., -90., -90., -90., -90.] 140 142 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 141 145 REAL, DIMENSION(klev,2) :: Ahyb_bounds, Bhyb_bounds 142 146 REAL, DIMENSION(klev+1) :: lev_index … … 172 176 ALLOCATE(o_dtr_evapls(nqtot),o_dtr_ls(nqtot),o_dtr_trsp(nqtot)) 173 177 ALLOCATE(o_dtr_sscav(nqtot),o_dtr_sat(nqtot),o_dtr_uscav(nqtot)) 174 ALLOCATE(o_dtr_wet_c on(nqtot))178 ALLOCATE(o_dtr_wet_cv(nqtot), o_dtr_wet(nqtot)) 175 179 ALLOCATE(o_dtr_dry(nqtot),o_dtr_vdf(nqtot)) 176 180 IF (CPPKEY_STRATAER) THEN … … 513 517 itr = 0; itrb = 0 514 518 DO iq = 1, nqtot 515 IF(.NOT. (tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE519 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 516 520 itr = itr + 1 517 521 dn = 'd'//TRIM(tracers(iq)%name)//'_' … … 542 546 543 547 lnam = 'tracer convective wet deposition'//TRIM(tracers(iq)%longName) 544 tnam = TRIM(dn)//'wet_con'; o_dtr_wet_con (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) 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)]) 545 551 lnam = 'tracer tendency dry deposition'//TRIM(tracers(iq)%longName) 546 552 tnam = 'cum'//TRIM(dn)//'dry'; o_dtr_dry (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) … … 636 642 637 643 ! DO iq=1,nqtot 638 ! IF(.NOT. (tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE644 ! IF(.NOT.tracers(iq)%isInPhysics) CYCLE 639 645 ! WRITE(*,'(a,i1,a,10i3)')'trac(',iq,')%flag = ',o_trac(iq)%flag 640 646 ! WRITE(*,'(a,i1,a)')'trac(',iq,')%name = '//TRIM(o_trac(iq)%name) -
LMDZ6/branches/contrails/libf/phylmd/phys_output_var_mod.f90
r5400 r5489 104 104 !$OMP THREADPRIVATE(clef_files, clef_stations, lev_files,nid_files,nnid_files) 105 105 INTEGER, DIMENSION(nfiles), SAVE :: nnhorim 106 107 106 INTEGER, DIMENSION(nfiles), SAVE :: nhorim, nvertm 108 107 INTEGER, DIMENSION(nfiles), SAVE :: nvertap, nvertbp, nvertAlt 109 108 REAL, DIMENSION(nfiles), SAVE :: zoutm 110 109 CHARACTER(LEN=20), DIMENSION(nfiles), SAVE :: type_ecri 111 !$OMP THREADPRIVATE(nnhorim, nhorim, nvertm,zoutm,type_ecri)110 !$OMP THREADPRIVATE(nnhorim,nhorim,nvertm,nvertap,nvertbp,nvertAlt,zoutm,type_ecri) 112 111 CHARACTER(LEN=20), DIMENSION(nfiles), SAVE :: type_ecri_files, phys_out_filetypes 113 112 !$OMP THREADPRIVATE(type_ecri_files, phys_out_filetypes) -
LMDZ6/branches/contrails/libf/phylmd/phys_output_write_mod.F90
r5456 r5489 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, flux_tr_wet, flux_tr_dry 8 d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, & 9 flux_tr_wet_cv, flux_tr_wet, flux_tr_dry 9 10 10 11 ! Author: Abderrahmane IDELKADI (original include file) … … 48 49 o_psol, o_mass, o_qsurf, o_qsol, & 49 50 o_precip, o_rain_fall, o_rain_con, o_ndayrain, o_plul, o_pluc, o_plun, & 50 o_snow, o_msnow, o_fsnow, o_evap, o_snowerosion, o_ustart_lic, o_qsalt_lic, o_rhosnow_lic, o_bsfall, & 51 o_snow, o_msnow, o_fsnow, o_evap, o_snowerosion, o_ustart_lic, o_qsalt_lic, o_rhosnow_lic, o_bsfall, & 52 o_icesub_lic, & 51 53 o_ep,o_epmax_diag, & ! epmax_cape 52 54 o_tops, o_tops0, o_topl, o_topl0, & … … 189 191 o_dtr_insc, o_dtr_bcscav, o_dtr_evapls, & 190 192 o_dtr_ls, o_dtr_trsp, o_dtr_sscav, o_dtr_dry, & 191 o_dtr_sat, o_dtr_uscav, o_dtr_wet_c on, &193 o_dtr_sat, o_dtr_uscav, o_dtr_wet_cv, o_dtr_wet, & 192 194 o_trac_cum, o_du_gwd_rando, o_dv_gwd_rando, & 193 195 o_ustr_gwd_hines,o_vstr_gwd_hines,o_ustr_gwd_rando,o_vstr_gwd_rando, & … … 317 319 USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, & 318 320 zn2mout, t2m_min_mon, t2m_max_mon, evap, & 319 snowerosion, zxustartlic, zxrhoslic, zxqsaltlic, &321 snowerosion, icesub_lic, zxustartlic, zxrhoslic, zxqsaltlic, & 320 322 l_mixmin,l_mix, pbl_eps, tke_shear, tke_buoy, tke_trans, & 321 323 zu10m, zv10m, zq2m, zustar, zxqsurf, & … … 916 918 CALL histwrite_phy(o_fsnow, zfra_o) 917 919 CALL histwrite_phy(o_evap, evap) 920 CALL histwrite_phy(o_icesub_lic, icesub_lic) 918 921 919 922 IF (ok_bs) THEN … … 2863 2866 CALL histwrite_phy(o_dtr_uscav(itr),d_tr_uscav(:,:,itr)) 2864 2867 !--2D fields 2865 CALL histwrite_phy(o_dtr_wet_con(itr), flux_tr_wet(:,itr)) 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)) 2866 2870 CALL histwrite_phy(o_dtr_dry(itr), flux_tr_dry(:,itr)) 2867 2871 zx_tmp_fi2d=0. -
LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90
r5488 r5489 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 41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, addPhase, ivap, iliq, isol, ibs, icf, irvc, ircont 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 80 USE lmdz_lscp_old, ONLY : fisrtilp, fisrtilp_first 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, fder, plcl, plfc, &250 dthmin, evap, snowerosion, icesub_lic, 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_initialize 378 379 IMPLICIT NONE 379 380 !>====================================================================== … … 512 513 !====================================================================== 513 514 ! 514 ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional)515 INTEGER,SAVE :: ivap, iliq, isol, ibs, icf, irvc, ircont516 !$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc, ircont)517 !518 515 ! 519 516 ! Variables argument: … … 1021 1018 1022 1019 REAL picefra(klon,klev) 1023 REAL zrel_oro(klon)1020 REAL nm_oro(klon) 1024 1021 !IM cf. AM 081204 END 1025 1022 ! … … 1096 1093 CHARACTER*80 abort_message 1097 1094 LOGICAL, SAVE :: ok_sync, ok_sync_omp 1098 !$OMP THREADPRIVATE(ok_sync )1095 !$OMP THREADPRIVATE(ok_sync,ok_sync_omp) 1099 1096 REAL date0 1100 1097 … … 1106 1103 REAL ztsol(klon) 1107 1104 REAL q2m(klon,nbsrf) ! humidite a 2m 1108 REAL fsnowerosion(klon,nbsrf) ! blowing snow flux at surface1109 1105 REAL qbsfra ! blowing snow fraction 1110 1106 !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels … … 1270 1266 ! Subgrid scale wind : 1271 1267 ! Need to be allocatable/save because the number of bin is not known (provided by surf_wind_ini) 1272 integer, save :: ns rfwnd=11268 integer, save :: nsurfwind=1 1273 1269 real, dimension(:,:), allocatable, save :: surf_wind_value, surf_wind_proba ! module and probability of sugrdi wind wind sample 1274 !$OMP THREADPRIVATE(ns rfwnd,surf_wind_value, surf_wind_proba)1270 !$OMP THREADPRIVATE(nsurfwind,surf_wind_value, surf_wind_proba) 1275 1271 1276 1272 … … 1352 1348 1353 1349 IF (first) THEN 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')) 1350 1351 CALL s2s_initialize ! initialization of source to source tools 1352 1361 1353 ! CALL init_etat0_limit_unstruct 1362 1354 ! IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) … … 1841 1833 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1842 1834 CALL surf_wind_ini(klon,lunout) 1843 CALL getin_p('ns rfwnd',nsrfwnd)1844 allocate(surf_wind_value(klon,ns rfwnd),surf_wind_proba(klon,nsrfwnd))1835 CALL getin_p('nsurfwind',nsurfwind) 1836 allocate(surf_wind_value(klon,nsurfwind),surf_wind_proba(klon,nsurfwind)) 1845 1837 1846 1838 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1839 CALL iophys_ini(pdtphys,nsurfwind) ! replay automatic include ! replay automatic include 1847 1840 CALL wake_ini(rg,rd,rv,prt_level) 1848 1841 CALL yamada_ini(klon,lunout,prt_level) … … 2917 2910 cdragh, cdragm, u1, v1, & 2918 2911 beta_aridity, & 2919 !albedo SB >>> 2920 ! albsol1, albsol2, sens, evap, & 2921 albsol_dir, albsol_dif, sens, evap, snowerosion, & 2922 !albedo SB <<< 2912 albsol_dir, albsol_dif, sens, evap, snowerosion, icesub_lic, & 2923 2913 albsol3_lic,runoff, snowhgt, qsnow, to_ice, sissnow, & 2924 2914 zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, & … … 3736 3726 ! poches, la tendance moyenne associ\'ee doit etre 3737 3727 ! multipliee par la fraction surfacique qu'ils couvrent. 3728 IF (mod(iflag_pbl_split/10,10) == 1) THEN 3729 ! On tient compte du splitting pour modifier les profils deltatq/T des poches 3730 DO k=1,klev 3731 DO i=1,klon 3732 d_deltat_the(i,k) = - d_t_ajs(i,k) 3733 d_deltaq_the(i,k) = - d_q_ajs(i,k) 3734 ENDDO 3735 ENDDO 3736 ELSE 3737 d_deltat_the(:,:) = 0. 3738 d_deltaq_the(:,:) = 0. 3739 ENDIF 3740 3738 3741 DO k=1,klev 3739 3742 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 !3744 3743 d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i)) 3745 3744 d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i)) 3746 3745 d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i)) 3747 3746 d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i)) 3748 !3749 3747 ENDDO 3750 3748 ENDDO … … 3837 3835 !=================================================================== 3838 3836 ! Computation of subrgid scale near-surface wind distribution 3839 call surf_wind(klon,ns rfwnd,u10m,v10m,wake_s,wake_Cstar,ustar,wstar,surf_wind_value,surf_wind_proba)3837 call surf_wind(klon,nsurfwind,u10m,v10m,wake_s,wake_Cstar,ustar,wstar,surf_wind_value,surf_wind_proba) 3840 3838 3841 3839 !=================================================================== … … 3924 3922 3925 3923 ELSE 3926 3924 3925 CALL fisrtilp_first(klon, klev, phys_tstep, pfrac_impa, pfrac_nucl, pfrac_1nucl) 3927 3926 CALL fisrtilp(klon,klev,phys_tstep,paprs,pplay, & 3928 3927 t_seri, q_seri,ptconv,ratqs,sigma_qtherm, & … … 4859 4858 ! a l'echelle sous-maille: 4860 4859 ! 4860 4861 ! calculation of nm_oro 4862 DO i=1,klon 4863 ! nm_oro is a proxy for the number of subgrid scale mountains 4864 ! -> condition on nm_oro can deactivate the lifting on tilted planar terrains 4865 ! 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 setting 4867 ! 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 ENDDO 4870 4861 4871 IF (prt_level .GE.10) THEN 4862 4872 print *,' call orography ? ', ok_orodr … … 4869 4879 DO i=1,klon 4870 4880 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 slope4873 ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains4874 ! such as ice sheets (work by V. Wiener)4875 4881 ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 4876 4882 ! earn computation time but they are not physical. 4877 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.( zrel_oro(i).LE.zrel_oro_t)) THEN4883 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN 4878 4884 itest(i)=1 4879 4885 igwd=igwd+1 … … 4924 4930 DO i=1,klon 4925 4931 itest(i)=0 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 4932 IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN 4931 4933 itest(i)=1 4932 4934 igwd=igwd+1 … … 5169 5171 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE 5170 5172 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 5171 IF ((zstd(i).GT.1.0) .AND.( zrel_oro(i).LE.zrel_oro_t)) THEN5173 IF ((zstd(i).GT.1.0) .AND.(nm_oro(i).GT.nm_oro_t)) THEN 5172 5174 itest(i)=1 5173 5175 igwd=igwd+1 … … 5181 5183 DO i=1,klon 5182 5184 itest(i)=0 5183 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.( zrel_oro(i).LE.zrel_oro_t)) THEN5185 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN 5184 5186 itest(i)=1 5185 5187 igwd=igwd+1 -
LMDZ6/branches/contrails/libf/phylmd/phystokenc_mod.f90
r5268 r5489 142 142 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: upwd 143 143 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: dnwd 144 144 !$OMP THREADPRIVATE(sh,da,phi,mp,upwd,dnwd) 145 145 146 REAL, SAVE :: dtcum 146 147 INTEGER, SAVE:: iadvtr=0 -
LMDZ6/branches/contrails/libf/phylmd/phytrac_mod.f90
r5450 r5489 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 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 38 39 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra dans pluie,air descente insaturee 39 40 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel … … 48 49 49 50 !$OMP THREADPRIVATE(qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa,d_tr_lessi_nucl) 50 !$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet,qPr,qDi) 51 !$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav) 52 !$OMP THREADPRIVATE(flux_tr_wet,flux_tr_wet_cv,qPr,qDi) 51 53 !$OMP THREADPRIVATE(d_tr_insc,d_tr_bcscav,d_tr_evapls,d_tr_ls,qPrls) 52 54 !$OMP THREADPRIVATE(d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv) … … 69 71 ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr)) 70 72 ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr)) 71 ALLOCATE(flux_tr_wet(klon,nbtr) )73 ALLOCATE(flux_tr_wet(klon,nbtr),flux_tr_wet_cv(klon,nbtr)) 72 74 ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr)) 73 75 ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr)) … … 411 413 flux_tr_dry(i,it)=0. 412 414 flux_tr_wet(i,it)=0. 415 flux_tr_wet_cv(i,it)=0. 413 416 ENDDO 414 417 ENDDO … … 700 703 !--with the full array tr_seri even if only item it is processed 701 704 702 CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep, &703 sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, &704 pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, &705 paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, &706 ccntrAA_3d,ccntrENV_3d,coefcoli_3d, &707 d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet ,&708 qDi,qPr, &709 qPa,qMel,qTrdi,dtrcvMA,Mint, &705 CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep, & 706 sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, & 707 pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, & 708 paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, & 709 ccntrAA_3d,ccntrENV_3d,coefcoli_3d, & 710 d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet_cv, & 711 qDi,qPr, & 712 qPa,qMel,qTrdi,dtrcvMA,Mint, & 710 713 zmfd1a,zmfphi2,zmfdam) 711 714 … … 923 926 beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc,d_tr_bcscav,d_tr_evapls,qPrls) 924 927 928 !total wet deposit = large scale wet deposit + convective wet deposit 929 DO i = 1, klon 930 flux_tr_wet(i, it) = flux_tr_wet_cv(i, it) + & 931 qPrls(i, it)*(prfl(i, 1)+psfl(i, 1))*pdtphys 932 ENDDO ! i = 1, klon 933 925 934 !large scale scavenging tendency 926 935 DO k = 1, klev -
LMDZ6/branches/contrails/libf/phylmd/readaerosol_mod.f90
r5268 r5489 4 4 5 5 REAL, SAVE :: not_valid=-333. 6 6 !$OMP THREADPRIVATE(not_valid) 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) 12 13 13 14 CONTAINS -
LMDZ6/branches/contrails/libf/phylmd/surf_land_bucket_mod.F90
r5285 r5489 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 104 REAL, DIMENSION(klon) :: alb_neig, alb_lim, icesub 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 &241 snow, qsol, tsurf_new, evap, icesub & 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
r5364 r5489 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, fluxsens, fluxlat, fluxbs, &20 tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, icesub_lic, fluxsens, fluxlat, fluxbs, & 21 21 tsurf_new, dflux_s, dflux_l, & 22 22 alt, slope, cloudf, & … … 48 48 #endif 49 49 50 !FC51 50 USE clesphys_mod_h 52 51 USE yomcst_mod_h 53 USE ioipsl_getin_p_mod, ONLY : getin_p52 USE ioipsl_getin_p_mod, ONLY : getin_p 54 53 USE lmdz_blowing_snow_ini, ONLY : c_esalt_bs, zeta_bs, pbst_bs, prt_bs, rhoice_bs, rhohard_bs 55 54 USE lmdz_blowing_snow_ini, ONLY : rhofresh_bs, tau_eqsalt_bs, tau_dens0_bs, tau_densmin_bs … … 60 59 USE dimsoil_mod_h, ONLY: nsoilmx 61 60 62 ! INCLUDE "indicesol.h"63 61 64 62 … … 121 119 REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir,alb_dif 122 120 !albedo SB <<< 123 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat 121 REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat, icesub_lic 124 122 REAL, DIMENSION(klon), INTENT(OUT) :: fluxbs 125 123 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new … … 135 133 #ifdef ISO 136 134 REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap 137 ! real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de138 ! fonte_neige139 135 #endif 140 136 … … 163 159 REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec 164 160 REAL, DIMENSION(klon) :: snow_prec,qsol_prec 165 ! real, DIMENSION(klon) :: run_off_lic_0_diag166 161 #endif 167 162 … … 257 252 ! landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ... 258 253 ! landice_opt = 1 : prepare and call INterace Lmdz SISvat (INLANDSIS) 254 ! landice_opt = 2 : skip surf_landice and use orchidee over all land surfaces 259 255 !**************************************************************************************** 260 256 … … 375 371 ! 376 372 !**************************************************************************************** 377 ! beta(:) = 1.0378 ! dif_grnd(:) = 0.0379 373 380 374 ! Suppose zero surface speed … … 393 387 #ifdef ISO 394 388 #ifdef ISOVERIF 395 !write(*,*) 'surf_land_ice 1499'396 389 DO i=1,knon 397 390 IF (iso_eau > 0) THEN … … 427 420 ! 428 421 !**************************************************************************************** 429 430 !431 !IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"432 ! alb1(1 : knon) = 0.6 !IM cf FH/GK433 ! alb1(1 : knon) = 0.82434 ! alb1(1 : knon) = 0.77 !211003 Ksta0.77435 ! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5436 !IM: KstaTER0.77 & LMD_ARMIP6437 422 438 423 ! Attantion: alb1 and alb2 are not the same! … … 622 607 CALL fonte_neige(knon, is_lic, knindex, dtime, & 623 608 tsurf, precip_rain, precip_totsnow, & 624 snow, qsol, tsurf_new, evap_totsnow &609 snow, qsol, tsurf_new, evap_totsnow, icesub_lic & 625 610 #ifdef ISO 626 611 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & -
LMDZ6/branches/contrails/libf/phylmd/traclmdz_mod.f90
r5285 r5489 261 261 it = 0 262 262 DO iq = 1, nqtot 263 IF(.NOT. (tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE263 IF(.NOT.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 USE dimphy312 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
r5390 r5489 138 138 CALL getin_p('iflag_tke_diff',iflag_tke_diff) 139 139 allocate(l0(klon)) 140 #define IOPHYS141 #ifdef IOPHYS142 ! call iophys_ini(timestep)143 #endif144 140 firstcall=.false. 145 141 endif 146 142 147 143 IF (ngrid<=0) RETURN ! Bizarre : on n a pas ce probeleme pour coef_diff_turb 148 149 #ifdef IOPHYS150 if (okiophys) then151 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 endif154 #endif155 144 156 145 nlay=klev -
LMDZ6/branches/contrails/libf/phylmdiso/phyetat0_mod.F90
r5310 r5489 549 549 it = 0 550 550 DO iq = 1, nqtot 551 IF(.NOT. (tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE551 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 552 552 it = it+1 553 553 tname = tracers(iq)%name -
LMDZ6/branches/contrails/libf/phylmdiso/phyredem.F90
r5296 r5489 370 370 it = 0 371 371 DO iq = 1, nqtot 372 IF(.NOT. (tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE372 IF(.NOT.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
r5402 r5489 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 41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,addPhase, ivap, iliq, isol, ibs, icf, irvc 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, ibs583 !!$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 definition587 ! plutot dans infotrac_phy588 INTEGER,SAVE :: irneb, ibs, icf,irvc589 !$OMP THREADPRIVATE(irneb, ibs, icf,irvc)590 !591 581 ! 592 582 ! Variables argument: … … 1121 1111 1122 1112 REAL picefra(klon,klev) 1123 REAL zrel_oro(klon)1113 REAL nm_oro(klon) 1124 1114 !IM cf. AM 081204 END 1125 1115 ! … … 1459 1449 1460 1450 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'))1467 1451 ! CALL init_etat0_limit_unstruct 1468 1452 IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) … … 6283 6267 ! a l'echelle sous-maille: 6284 6268 ! 6269 6270 ! calculation of nm_oro 6271 DO i=1,klon 6272 ! nm_oro is a proxy for the number of subgrid scale mountains 6273 ! -> condition on nm_oro can deactivate the lifting on tilted planar terrains 6274 ! 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 setting 6276 ! 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 DO 6279 6285 6280 IF (prt_level .GE.10) THEN 6286 6281 print *,' call orography ? ', ok_orodr 6287 6282 ENDIF 6288 ! 6283 6289 6284 IF (ok_orodr) THEN 6290 6285 ! … … 6293 6288 DO i=1,klon 6294 6289 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 slope6297 ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains6298 ! such as ice sheets (work by V. Wiener)6299 6290 ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 6300 6291 ! earn computation time but they are not physical. 6301 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.( zrel_oro(i).LE.zrel_oro_t)) THEN6292 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN 6302 6293 itest(i)=1 6303 6294 igwd=igwd+1 … … 6352 6343 DO i=1,klon 6353 6344 itest(i)=0 6354 !zrel_oro: relative mountain height wrt relief explained by mean slope 6355 ! -> condition on zrel_oro can deactivate the lifting on tilted planar terrains 6356 ! such as ice sheets (work by V. Wiener) 6357 zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) 6358 IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN 6345 IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN 6359 6346 itest(i)=1 6360 6347 igwd=igwd+1 … … 6630 6617 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE 6631 6618 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 6632 IF ((zstd(i).GT.1.0) .AND.( zrel_oro(i).LE.zrel_oro_t)) THEN6619 IF ((zstd(i).GT.1.0) .AND.(nm_oro(i).GT.nm_oro_t)) THEN 6633 6620 itest(i)=1 6634 6621 igwd=igwd+1 … … 6642 6629 DO i=1,klon 6643 6630 itest(i)=0 6644 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.( zrel_oro(i).LE.zrel_oro_t)) THEN6631 IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN 6645 6632 itest(i)=1 6646 6633 igwd=igwd+1
Note: See TracChangeset
for help on using the changeset viewer.
