Index: LMDZ6/branches/contrails/libf/dyn3d/replay3d.f90 =================================================================== --- LMDZ6/branches/contrails/libf/dyn3d/replay3d.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/dyn3d/replay3d.f90 (revision 5489) @@ -18,4 +18,6 @@ grossismx, grossismy, dzoomx, dzoomy,taux,tauy USE mod_const_mpi, ONLY: comm_lmdz + USE ioipsl, only: getin + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique @@ -26,4 +28,5 @@ USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h + IMPLICIT NONE @@ -71,4 +74,6 @@ integer :: ntime=10000,it,klon,klev + + character*20 :: lmax_replay @@ -162,8 +167,15 @@ - CALL iophys_ini(900.) print*,'Rlatu=',rlatu klon=2+iim*(jjm-1) + +print*,'AVANT getin' klev=llm +CALL getin('lmax_replay',lmax_replay) +print*,'APRES getin',lmax_replay +CALL getin(lmax_replay,klev) +print*,'replay3d lmax_replay klev',lmax_replay,klev + + CALL iophys_ini(900.,klev) !--------------------------------------------------------------------- Index: LMDZ6/branches/contrails/libf/dyn3d_common/infotrac.f90 =================================================================== --- LMDZ6/branches/contrails/libf/dyn3d_common/infotrac.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/dyn3d_common/infotrac.f90 (revision 5489) @@ -3,9 +3,9 @@ MODULE infotrac - USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse - USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, & - delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, & - addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck - USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3 + USE strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx + USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, addPhase, addKey, iH2O, & + isoSelect, indexUpdate, isot_type, testTracersFiles, isotope, delPhase, getKey, tran0, & + isoKeys, isoName, isoZone, isoPhas, processIsotopes, isoCheck, itZonIso, nbIso, & + niso, ntiso, nzone, nphas, maxTableWidth, iqIsoPha, iqWIsoPha, ixIso, new2oldH2O, newHNO3, oldHNO3 IMPLICIT NONE @@ -30,6 +30,6 @@ PUBLIC :: isoKeys, isoName, isoZone, isoPhas !--- Isotopes keys & names, tagging zones names, phases PUBLIC :: niso, ntiso, nzone, nphas !--- Number of " " - PUBLIC :: itZonIso !--- index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx) - PUBLIC :: iqIsoPha !--- index "iq" in "qx" = f(isotope idx, phase idx) + PUBLIC :: itZonIso !--- Index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx) + PUBLIC :: iqIsoPha !--- Index "iq" in "qx" = f(isotope idx, phase idx) PUBLIC :: isoCheck !--- Run isotopes checking routines !=== FOR BOTH TRACERS AND ISOTOPES @@ -78,6 +78,4 @@ ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | ! | iadv | Advection scheme number | iadv | 1,2,10-20(exc.15,19),30| -! | isAdvected | Advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | -! | isInPhysics | Tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | @@ -103,14 +101,13 @@ !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES - INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) - nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) - nqo, & !--- Number of water phases - nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) - nqCO2 !--- Number of tracers of CO2 (ThL) + INTEGER, SAVE :: nqtot !--- Tracers nb in dynamics (incl. higher moments + H2O) + INTEGER, SAVE :: nbtr !--- Tracers nb in physics (excl. higher moments + H2O) + INTEGER, SAVE :: nqo !--- Number of water phases + INTEGER, SAVE :: nqtottr !--- Number of tracers passed to phytrac (TO BE DELETED ?) + INTEGER, SAVE :: nqCO2 !--- Number of tracers of CO2 (ThL) CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) !=== VARIABLES FOR INCA - INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: & - conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr) + INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:) !--- Convection / boundary layer activation (nbtr) CONTAINS @@ -147,17 +144,14 @@ ! Local variables INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number - INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA - vad (:), vadv_inca(:), pbl_flg_inca(:) - CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA INTEGER :: nqINCA CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags - CHARACTER(LEN=maxlen) :: msg1, texp, ttp !--- Strings for messages and expanded tracers type + CHARACTER(LEN=maxlen) :: msg1, texp, ttp, nam, val !--- Strings for messages and expanded tracers type INTEGER :: fType !--- Tracers description file type ; 0: none !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) INTEGER :: iad !--- Advection scheme number - INTEGER :: iq, jq, nt, im, nm !--- Indexes and temporary variables - LOGICAL :: lerr, ll + INTEGER :: iq, jq, nt, im, nm, ig !--- Indexes and temporary variables + LOGICAL :: lerr TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) TYPE(trac_type), POINTER :: t1, t(:) @@ -173,13 +167,15 @@ descrq(30) = 'PRA' - lerr=strParse(type_trac, '|', types_trac, n=nt) - IF (nt .GT. 1) THEN - IF (nt .GT. 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) - IF (nt .EQ. 2) type_trac=types_trac(2) - ENDIF - CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) - - + IF(strCount(type_trac, '|', nt)) CALL abort_gcm(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1) + IF(nt >= 3) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) + IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_gcm(modname, "couldn't parse "//'"type_trac"', 1) + IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON + + CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) + +!############################################################################################################################## + IF(.TRUE.) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### +!############################################################################################################################## !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION msg1 = 'For type_trac = "'//TRIM(type_trac)//'":' @@ -197,92 +193,49 @@ SELECT CASE(type_trac) CASE('inca', 'inco') -IF (.NOT. CPPKEY_INCA) THEN - CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) -END IF + IF(.NOT.CPPKEY_INCA) CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) CASE('repr') -IF (.NOT. CPPKEY_REPROBUS) THEN - CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) -END IF + IF(.NOT.CPPKEY_REPROBUS) CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) CASE('coag') -IF (.NOT. CPPKEY_STRATAER) THEN - CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) -END IF + IF(.NOT.CPPKEY_STRATAER) CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) END SELECT - - nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) +!############################################################################################################################## + END IF +!############################################################################################################################## !============================================================================================================================== ! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT !============================================================================================================================== - texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" + texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" IF(texp == 'inco') texp = 'co2i|inca' IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) ttp = type_trac; IF(fType /= 1) ttp = texp - IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1) - -!============================================================================================================================== -! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. -!============================================================================================================================== !--------------------------------------------------------------------------------------------------------------------------- IF(fType == 0) CALL abort_gcm(modname, 'Missing "traceur.def", "tracer.def" or "tracer_.def tracers file.',1) !--------------------------------------------------------------------------------------------------------------------------- - IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def" + IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) & !=== FOUND OLD STYLE INCA "traceur.def" + CALL abort_gcm(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1) !--------------------------------------------------------------------------------------------------------------------------- -IF (CPPKEY_INCA) THEN - nqo = SIZE(tracers) - nqCO2 - CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA - nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac - nqtrue = nbtr + nqo !--- Total number of "true" tracers - IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) - ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) - ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) - CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) - ALLOCATE(ttr(nqtrue)) - ttr(1:nqo+nqCO2) = tracers - ttr(1 : nqo )%component = 'lmdz' - ttr(1+nqo:nqCO2+nqo )%component = 'co2i' - ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' - ttr(1+nqo :nqtrue)%name = [('CO2 ', iq=1, nqCO2), solsym_inca] - ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 - ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' - lerr = getKey('hadv', had, ky=tracers(:)%keys) - lerr = getKey('vadv', vad, ky=tracers(:)%keys) - hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca - vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca - CALL MOVE_ALLOC(FROM=ttr, TO=tracers) - DO iq = 1, nqtrue - t1 => tracers(iq) - CALL addKey('name', t1%name, t1%keys) - CALL addKey('component', t1%component, t1%keys) - CALL addKey('parent', t1%parent, t1%keys) - CALL addKey('phase', t1%phase, t1%keys) - END DO - IF(setGeneration(tracers)) CALL abort_gcm(modname,'See above',1) !- SET FIELDS %iGeneration, %gen0Name - DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) -END IF - !--------------------------------------------------------------------------------------------------------------------------- - ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) - !--------------------------------------------------------------------------------------------------------------------------- + +!############################################################################################################################## + IF(readTracersFiles(ttp, lRepr=type_trac == 'repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1) +!############################################################################################################################## + +!============================================================================================================================== +! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. +!============================================================================================================================== nqtrue = SIZE(tracers) !--- "true" tracers nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) -IF (CPPKEY_INCA) THEN + IF(CPPKEY_INCA) & nqINCA = COUNT(tracers(:)%component == 'inca') -END IF + IF(CPPKEY_REPROBUS) CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) + +!============================================================================================================================== +! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). +!============================================================================================================================== IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "hadv"', 1) IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "vadv"', 1) - !--------------------------------------------------------------------------------------------------------------------------- - END IF - !--------------------------------------------------------------------------------------------------------------------------- - -IF (CPPKEY_REPROBUS) THEN - CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) -END IF - -!============================================================================================================================== -! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). -!============================================================================================================================== DO iq = 1, nqtrue IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE @@ -302,5 +255,5 @@ !============================================================================================================================== -! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected. +! 3) Determine the advection scheme choice for water and tracers "iadv" and the field "long name". ! iadv = 1 "LMDZ-specific humidity transport" (for H2O vapour) LMV ! iadv = 2 backward (for H2O liquid) BAK @@ -320,5 +273,5 @@ !============================================================================================================================== ALLOCATE(ttr(nqtot)) - jq = nqtrue+1; tracers(:)%iadv = -1 + jq = nqtrue+1 DO iq = 1, nqtrue t1 => tracers(iq) @@ -331,9 +284,7 @@ IF(iad == -1) CALL abort_gcm(modname, msg1, 1) - !--- SET FIELDS longName, iadv, isAdvected, isInPhysics + !--- SET FIELDS longName and iadv t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) t1%iadv = iad - t1%isAdvected = iad >= 0 - t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O ttr(iq) = t1 @@ -349,5 +300,4 @@ ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] ttr(jq+1:jq+nm)%iadv = [ (-iad, im=1, nm) ] - ttr(jq+1:jq+nm)%isAdvected = [ (.FALSE., im=1, nm) ] jq = jq + nm END DO @@ -359,22 +309,22 @@ !=== TEST ADVECTION SCHEME - DO iq = 1, nqtot ; t1 => tracers(iq); iad = t1%iadv + DO iq = 1, nqtot ; t1 => tracers(iq) + iad = t1%iadv + ig = t1%iGeneration + nam = t1%name + val = 'iadv='//TRIM(int2str(iad)) !--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers) - IF(ALL([10,14,0] /= iad)) & - CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1) - - !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1) - IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) & - CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1) - - !--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1) - IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',& - modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10 - - !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR: iadv = 14 - ll = t1%name /= addPhase('H2O','g') - IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', & - modname, iad == 14 .AND. ll)) t1%iadv = 10 + IF(ALL([10,14,0] /= iad)) CALL abort_gcm(modname, TRIM(val)//' has not been tested yet ; 10 or 14 only are allowed !', 1) + + !--- ONLY TESTED VALUES SO FAR FOR PARENTS HAVING CHILDREN: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 0) + IF(ALL([10,14] /= iad) .AND. ig == 0 .AND. ANY(tracers(:)%parent==nam)) & + CALL abort_gcm(modname, TRIM(val)//' is not implemented for parents ; 10 or 14 only are allowed !', 1) + + !--- ONLY TESTED VALUES SO FAR FOR DESCENDANTS (TRACERS OF GENERATION > 0): iadv = 10 ; WATER VAPOUR: iadv = 14 + lerr = iad /= 10 .AND. ig > 0; IF(lerr) tracers(iq)%iadv = 10 + CALL msg('WARNING! '//TRIM(val)// ' not implemented for children. Setting iadv=10 for "'//TRIM(nam)//'"', modname, lerr) + lerr = iad == 14 .AND. nam /= addPhase('H2O','g'); IF(lerr) tracers(iq)%iadv = 10 + CALL msg('WARNING! '//TRIM(val)//' is valid for water vapour only. Setting iadv=10 for "'//TRIM(nam)//'"', modname, lerr) END DO @@ -384,6 +334,6 @@ !--- Convection / boundary layer activation for all tracers - ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 - ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 + IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 + IF(.NOT.ALLOCATED( pbl_flg)) ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 !--- Note: nqtottr can differ from nbtr when nmom/=0 @@ -393,4 +343,5 @@ !=== DISPLAY THE RESULTS + IF(.NOT..TRUE.) RETURN CALL msg('nqo = '//TRIM(int2str(nqo)), modname) CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) @@ -399,8 +350,6 @@ CALL msg('niso = '//TRIM(int2str(niso)), modname) CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) -IF (CPPKEY_INCA) THEN - CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) - CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) -END IF + CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname, CPPKEY_INCA) + CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname, CPPKEY_INCA) t => tracers CALL msg('Information stored in '//TRIM(modname)//': ', modname) @@ -411,14 +360,11 @@ t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & CALL abort_gcm(modname, "problem with the tracers table content", 1) - IF(niso > 0) THEN - CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname) - CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) - CALL msg(' isoName = '//strStack(isoName), modname) - CALL msg(' isoZone = '//strStack(isoZone), modname) - CALL msg(' isoPhas = '//TRIM(isoPhas), modname) - ELSE - CALL msg('No isotopes identified.', modname) - END IF - CALL msg('end', modname) + CALL msg('No isotopes identified.', modname, nbIso == 0) + IF(nbIso == 0) RETURN + CALL msg('For isotopes family "H2O":', modname) + CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) + CALL msg(' isoName = '//strStack(isoName), modname) + CALL msg(' isoZone = '//strStack(isoZone), modname) + CALL msg(' isoPhas = '//TRIM(isoPhas), modname) END SUBROUTINE init_infotrac Index: LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis.f90 =================================================================== --- LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis.f90 (revision 5489) @@ -279,5 +279,5 @@ itr=0 DO iq=1,nqtot - IF(.NOT.tracers(iq)%isAdvected) CYCLE + IF(tracers(iq)%iadv < 0) CYCLE itr = itr + 1 DO l=1,llm @@ -597,5 +597,5 @@ itr = 0 DO iq=1,nqtot - IF(.NOT.tracers(iq)%isAdvected) CYCLE + IF(tracers(iq)%iadv < 0) CYCLE itr = itr + 1 DO l=1,llm Index: LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis_loc.F90 =================================================================== --- LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis_loc.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/dynphy_lonlat/calfis_loc.F90 (revision 5489) @@ -356,5 +356,5 @@ itr = 0 DO iq=1,nqtot - IF(.NOT.tracers(iq)%isAdvected) CYCLE + IF(tracers(iq)%iadv < 0) CYCLE itr = itr + 1 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) @@ -1059,5 +1059,5 @@ itr = 0 DO iq=1,nqtot - IF(.NOT.tracers(iq)%isAdvected) CYCLE + IF(tracers(iq)%iadv < 0) CYCLE itr = itr + 1 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) Index: LMDZ6/branches/contrails/libf/misc/readTracFiles_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/misc/readTracFiles_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/misc/readTracFiles_mod.f90 (revision 5489) @@ -61,5 +61,4 @@ INTEGER :: nqChildren = 0 !--- Number of children (first generation) INTEGER :: iadv = 10 !--- Advection scheme used - LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0. COUNT(isAdvected )=nqtrue LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:) @@ -185,5 +184,5 @@ ! * The "keys" component (of type keys_type) is in principle enough to store everything we could need. ! But some variables are stored as direct-access keys to make the code more readable and because they are used often. -! * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now). +! * Most of the direct-access keys are set in this module, but some are not (longName, iadv and isInPhysicsfor now). ! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)" ! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen). Index: LMDZ6/branches/contrails/libf/misc/wxios_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/misc/wxios_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/misc/wxios_mod.F90 (revision 5489) @@ -188,5 +188,5 @@ ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs DO iq = 1, nqtot - IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE + IF(.NOT.tracers(iq)%isInPhysics) CYCLE dn = 'd'//TRIM(tracers(iq)%name)//'_' @@ -241,5 +241,5 @@ ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs DO iq = 1, nqtot - IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE + IF(.NOT.tracers(iq)%isInPhysics) CYCLE unt = "kg m-2" Index: LMDZ6/branches/contrails/libf/phy_common/abort_physic.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phy_common/abort_physic.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phy_common/abort_physic.f90 (revision 5489) @@ -49,3 +49,3 @@ endif endif - END + END SUBROUTINE abort_physic Index: LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_mpi_transfert.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_mpi_transfert.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_mpi_transfert.f90 (revision 5489) @@ -65,5 +65,5 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! -- Les chaine de charactère -- !! +!! -- Les chaine de charactere -- !! SUBROUTINE bcast_mpi_c(var1) Index: LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_omp_transfert.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_omp_transfert.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_omp_transfert.f90 (revision 5489) @@ -116,5 +116,5 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! -- Les chaine de charactère -- !! +!! -- Les chaine de charactere -- !! SUBROUTINE bcast_omp_c(var) Index: LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_transfert_para.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_transfert_para.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phy_common/mod_phys_lmdz_transfert_para.f90 (revision 5489) @@ -57,5 +57,5 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! -- Les chaine de charactère -- !! +!! -- Les chaine de charactere -- !! SUBROUTINE bcast_c(var) Index: LMDZ6/branches/contrails/libf/phydev/infotrac_phy.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phydev/infotrac_phy.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phydev/infotrac_phy.f90 (revision 5489) @@ -32,5 +32,4 @@ TYPE(keys_type) :: keys !--- = pairs vector INTEGER :: iadv = 10 !--- Advection scheme used - LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0. COUNT(isAdvected )=nqtrue LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:) Index: LMDZ6/branches/contrails/libf/phylmd/Dust/read_dust.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/Dust/read_dust.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/Dust/read_dust.f90 (revision 5489) @@ -21,5 +21,5 @@ save ncid1, varid1, ncid2, varid2 !$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2) - integer :: start(4),count(4), status + integer :: start_(4),count_(4) integer :: i, j, ig ! @@ -28,23 +28,27 @@ if (debutphy) then ! - ncid1=nf90_open('dust.nc',nf90_nowrite,rcode) - varid1=nf90_inq_varid(ncid1,'EMISSION',rcode) + rcode=nf90_open('dust.nc',nf90_nowrite,ncid1) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open dust.nc dans read_vent',1) ; endif + + rcode=nf90_inq_varid(ncid1,'EMISSION',varid1) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','inq varid EMISSION dans read_vent',1) ; endif ! endif ! - start(1)=1 - start(2)=1 - start(4)=0 + start_(1)=1 + start_(2)=1 + start_(3)=step + start_(4)=0 - ! count(1)=iip1 - count(1)=nbp_lon+1 - ! count(2)=jjp1 - count(2)=nbp_lat - count(3)=1 - count(4)=0 + ! count_(1)=iip1 + count_(1)=nbp_lon+1 + ! count_(2)=jjp1 + count_(2)=nbp_lat + count_(3)=1 + count_(4)=0 ! - start(3)=step ! - status = nf90_get_var(ncid1, varid1, dust_nc_glo, start, count) + rcode = nf90_get_var(ncid1, varid1, dust_nc_glo, start_, count_) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get EMISSION dans read_vent',1) ; endif ! Index: LMDZ6/branches/contrails/libf/phylmd/Dust/read_surface.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/Dust/read_surface.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/Dust/read_surface.f90 (revision 5489) @@ -31,6 +31,6 @@ real surfa_glo(klon_glo,5) ! - integer ncid, varid, rcode - integer start(2),count(2),status + integer ncid, varid, rcode, varlatid,tmpid + integer start_(2),count_(2) integer i,j,l,ig character*1 str1 @@ -41,5 +41,5 @@ real, dimension(nbp_lat) :: lats real, dimension(nbp_lat) :: lats_glo - integer, dimension(1) :: startj,endj + integer, dimension(1) :: start_j,endj !JE20140526>> !$OMP MASTER @@ -47,5 +47,7 @@ print*,'Lecture du fichier donnees_lisa.nc' - ncid=nf90_open('donnees_lisa.nc',nf90_nowrite,rcode) + rcode=nf90_open('donnees_lisa.nc',nf90_nowrite,ncid) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open donnees_lisa.nc dans read_vent',1) ; endif + !JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa @@ -54,27 +56,21 @@ isinversed=.false. do i=1,5 - if (i==1) aux4s='latu' - if (i==2) aux4s='LATU' - if (i==3) aux4s='LatU' - if (i==4) aux4s='Latu' - if (i==5) aux4s='latU' - status = nf90_inq_varid(ncid, aux4s, rcode) -! print *,'stat,i',status,i,outcycle,aux4s -! print *,'ifclause',status.NE. nf90_noerr ,outcycle == .false. - IF ((.not.(status.NE. nf90_noerr) ).and.( .not. outcycle )) THEN - outcycle=.true. - latstr=aux4s - ENDIF + if (i==1) aux4s='latu' + if (i==2) aux4s='LATU' + if (i==3) aux4s='LatU' + if (i==4) aux4s='Latu' + if (i==5) aux4s='latU' + rcode = nf90_inq_varid(ncid, aux4s, tmpid) + IF ((rcode==0).and.( .not. outcycle )) THEN + outcycle=.true. + varlatid=tmpid + ENDIF enddo ! check if it inversed lat - startj(1)=1 -! endj(1)=jjp1 + start_j(1)=1 endj(1)=nbp_lat - varid=nf90_inq_varid(ncid,latstr,rcode) + rcode = nf90_get_var(ncid, varlatid, lats_glo, start_j, endj) + if ( .not. outcycle ) then ; call abort_physic('LMDZ','get lat dans read_surface',1) ; endif - status = nf90_get_var(ncid, varid, lats_glo, startj, endj) -! print *,latstr,varid,status,jjp1,rcode -! IF (status .NE. nf90_noerr) print*,'NOOOOOOO' -! print *,lats -!stop + ! check if netcdf is latitude inversed or not. @@ -86,6 +82,6 @@ write(str1,'(i1)') i varname=trim(name)//str1 - print*,'lecture variable:',varname - varid=nf90_inq_varid(ncid,trim(varname),rcode) + rcode=nf90_inq_varid(ncid,trim(varname),varid) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//' dans read_vent',1) ; endif ! varid=nf90_inq_varid(ncid,varname,rcode) @@ -93,10 +89,10 @@ ! ----------------------------------------------------- - start(1)=1 - start(2)=1 - count(1)=nbp_lon+1 -! count(1)=iip1 - count(2)=nbp_lat -! count(2)=jjp1 + start_(1)=1 + start_(2)=1 + count_(1)=nbp_lon+1 +! count_(1)=iip1 + count_(2)=nbp_lat +! count_(2)=jjp1 ! mise a zero des tableaux @@ -106,5 +102,6 @@ ! Lecture ! ----------------------- - status = nf90_get_var(ncid, varid, tmp_dyn_glo, start, count) + rcode = nf90_get_var(ncid, varid, tmp_dyn_glo, start_, count_) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//' dans read_vent',1) ; endif ! call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn ') Index: LMDZ6/branches/contrails/libf/phylmd/Dust/read_vent.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/Dust/read_vent.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/Dust/read_vent.f90 (revision 5489) @@ -23,5 +23,5 @@ save ncidu1, varidu1, ncidv1, varidv1 !$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1) - integer :: start(4),count(4), status + integer :: start(4),count_(4) integer :: i, j, ig @@ -32,8 +32,12 @@ if (debutphy) then ! - ncidu1=nf90_open('u10m.nc',nf90_nowrite,rcode) - varidu1=nf90_inq_varid(ncidu1,'U10M',rcode) - ncidv1=nf90_open('v10m.nc',nf90_nowrite,rcode) - varidv1=nf90_inq_varid(ncidv1,'V10M',rcode) + rcode=nf90_open('u10m.nc',nf90_nowrite,ncidu1) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open u10m.nc dans read_vent',1) ; endif + rcode=nf90_inq_varid(ncidu1,'U10M',varidu1) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get id u10m dans read_vent',1) ; endif + rcode=nf90_open('v10m.nc',nf90_nowrite,ncidv1) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open v10m.nc dans read_vent',1) ; endif + rcode=nf90_inq_varid(ncidv1,'V10M',varidv1) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get id v10m dans read_vent',1) ; endif ! endif @@ -41,20 +45,30 @@ start(1)=1 start(2)=1 + start(3)=step start(4)=0 - ! count(1)=iip1 - count(1)=nbp_lon+1 - ! count(2)=jjp1 - count(2)=nbp_lat - count(3)=1 - count(4)=0 + ! count_(1)=iip1 + count_(1)=nbp_lon+1 + ! count_(2)=jjp1 + count_(2)=nbp_lat + count_(3)=1 + count_(4)=0 ! - start(3)=step ! - status = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count) + rcode = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count_) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','lecture u10m dans read_vent',1) ; endif + rcode = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count_) + if ( rcode /= 0 ) then ; call abort_physic('LMDZ','lecture v10m dans read_vent',1) ; endif - ! print *,status - ! - status = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count) + +! ------- Tests 2024/12/31-FH---------------------------------------- +! print*,'nbp_lon,npb_lat ',nbp_lon,nbp_lat +! print*,'start ',start +! print*,'count_ ',count_ +! print*,'satus lecture u10m ',rcode +! call dump2d(nbp_lon+1,nbp_lat,u10m_nc_glo,'U10M global read_vent') +! call dump2d(nbp_lon+1,nbp_lat,v10m_nc_glo,'V10M global read_vent') +! stop +! ------- Tests ----------------------------------------------------- ! @@ -63,5 +77,5 @@ ! print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1) - ! print *,status + ! print *,rcode ! call correctbid(iim,jjp1,u10m_nc) ! call correctbid(iim,jjp1,v10m_nc) Index: LMDZ6/branches/contrails/libf/phylmd/calcul_fluxs_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/calcul_fluxs_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/calcul_fluxs_mod.f90 (revision 5489) @@ -177,8 +177,4 @@ zx_coefh(i) = cdragh(i) * zx_wind(i) * p1lay(i)/(RD*t1lay(i)) zx_coefq(i) = cdragq(i) * zx_wind(i) * p1lay(i)/(RD*t1lay(i)) -! zx_wind(i)=min_wind_speed+SQRT(gustiness(i)+u1lay(i)**2+v1lay(i)**2) & -! * p1lay(i)/(RD*t1lay(i)) -! zx_coefh(i) = cdragh(i) * zx_wind(i) -! zx_coefq(i) = cdragq(i) * zx_wind(i) ENDDO Index: LMDZ6/branches/contrails/libf/phylmd/carbon_cycle_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/carbon_cycle_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/carbon_cycle_mod.f90 (revision 5489) @@ -350,4 +350,8 @@ CHARACTER(len=10),SAVE :: planet_type="earth" + + !$OMP THREADPRIVATE(cfname_root,cftext_root,cfunits_root) + !$OMP THREADPRIVATE(mask_in_root,mask_out_root) + !----------------------------------------------------------------------- Index: LMDZ6/branches/contrails/libf/phylmd/clesphys_mod_h.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/clesphys_mod_h.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/clesphys_mod_h.f90 (revision 5489) @@ -22,5 +22,5 @@ , co2_ppm0 & , tau_thermals & - , Cd_frein, zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t & + , Cd_frein, nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t & , ecrit_LES & , ecrit_ins, ecrit_hf, ecrit_day & @@ -55,6 +55,5 @@ ! threshold on to activate SSO schemes - ! threshold on to activate SSO schemes - REAL zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t + REAL nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t INTEGER iflag_cycle_diurne LOGICAL soil_model, new_oliq, ok_orodr, ok_orolf @@ -179,5 +178,5 @@ !$OMP , co2_ppm0 & !$OMP , tau_thermals & - !$OMP , Cd_frein, zrel_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t & + !$OMP , Cd_frein, nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t & !$OMP , ecrit_LES & !$OMP , ecrit_ins, ecrit_hf, ecrit_day & Index: LMDZ6/branches/contrails/libf/phylmd/conf_phys_m.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/conf_phys_m.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/conf_phys_m.f90 (revision 5489) @@ -213,5 +213,5 @@ LOGICAL, SAVE :: ok_lic_cond_omp ! - REAL, SAVE :: zrel_oro_t_omp, zstd_orodr_t_omp + REAL, SAVE :: nm_oro_t_omp, zstd_orodr_t_omp REAL, SAVE :: zpmm_orodr_t_omp, zpmm_orolf_t_omp INTEGER, SAVE :: iflag_cycle_diurne_omp @@ -893,10 +893,10 @@ - !Config Key = zrel_oro_t - !Config Desc = zrel_oro_t - !Config Def = 9999. + !Config Key = nm_oro_t + !Config Desc = nm_oro_t + !Config Def = -1 !Config Help = Connais pas ! - zrel_oro_t_omp = 9999. - CALL getin('zrel_oro_t', zrel_oro_t_omp) + nm_oro_t_omp = -1. + CALL getin('nm_oro_t', nm_oro_t_omp) !Config Key = zstd_orodr_t @@ -2313,5 +2313,5 @@ ok_orodr = ok_orodr_omp ok_orolf = ok_orolf_omp - zrel_oro_t=zrel_oro_t_omp + nm_oro_t=nm_oro_t_omp zstd_orodr_t=zstd_orodr_t_omp zpmm_orodr_t=zpmm_orodr_t_omp @@ -2732,5 +2732,5 @@ WRITE(lunout,*) ' ok_orodr=',ok_orodr WRITE(lunout,*) ' ok_orolf=',ok_orolf - WRITE(lunout,*) ' zrel_oro_t=',zrel_oro_t + WRITE(lunout,*) ' nm_oro_t=',nm_oro_t WRITE(lunout,*) ' zstd_orodr_t=',zstd_orodr_t WRITE(lunout,*) ' zpmm_orodr_t=',zpmm_orodr_t Index: LMDZ6/branches/contrails/libf/phylmd/cv3_routines.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/cv3_routines.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/cv3_routines.f90 (revision 5489) @@ -4938,8 +4938,10 @@ USE lmdz_cv_ini, ONLY : nl USE cvflag_mod_h + USE ioipsl_getin_p_mod, ONLY : getin_p IMPLICIT NONE !inputs: +!------ INTEGER, INTENT (IN) :: ncum, nd, na, nloc, len INTEGER, DIMENSION (len), INTENT (IN) :: icb, inb @@ -4949,11 +4951,17 @@ REAL, DIMENSION (len, nd+1), INTENT (IN) :: Vprecip !ouputs: +!------ REAL, DIMENSION (len, na, na), INTENT (OUT) :: phi, phi2, epmlmMm REAL, DIMENSION (len, na), INTENT (OUT) :: da, d1a, dam, eplaMm ! +!local variables: +!--------------- ! variables pour tracer dans precip de l'AA et des mel -!local variables: INTEGER i, j, k REAL epm(nloc, na, na) +! + LOGICAL,SAVE :: first=.TRUE. + LOGICAL,SAVE :: keep_bug_indices_cv3_tracer +!$OMP THREADPRIVATE(first, keep_bug_indices_cv3_tracer) ! variables d'Emanuel : du second indice au troisieme @@ -4962,6 +4970,11 @@ ! variables personnelles : du troisieme au second indice ! ---> tab(i,j,k) -> de k a j -! phi, phi2 - +! phi, phi2, epm, epmlmMm + + IF (first) THEN + keep_bug_indices_cv3_tracer = .FALSE. + CALL getin_p('keep_bug_indices_cv3_tracer', keep_bug_indices_cv3_tracer) + first = .FALSE. + ENDIF ! (first) ! initialisations @@ -5022,5 +5035,4 @@ d1a(i, j) = d1a(i, j) + ment(i, k, j)*ep(i, k)*(1.-sigij(i,k,j)) IF (k<=j) THEN - dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, k, j)*(1.-ep(i,k))*(1.-sigij(i,k,j)) phi2(i, j, k) = phi(i, j, k)*epm(i, j, k) END IF @@ -5028,4 +5040,26 @@ END DO END DO + + IF (keep_bug_indices_cv3_tracer) THEN + DO j = 1, nl + DO k = 1, nl + DO i = 1, ncum + IF (k<=j) THEN + dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, k, j)*(1.-ep(i,k))*(1.-sigij(i,k,j)) + END IF ! (k<=j) + END DO + END DO + END DO + ELSE ! (keep_bug_indices_cv3_tracer) + DO j = 1, nl + DO k = 1, nl + DO i = 1, ncum + IF (k<=j) THEN + dam(i, j) = dam(i, j) + ment(i, k, j)*epm(i, j, k)*(1.-ep(i,k))*(1.-sigij(i,k,j)) + END IF ! (k<=j) + END DO + END DO + END DO + ENDIF ! (keep_bug_indices_cv3_tracer) RETURN Index: LMDZ6/branches/contrails/libf/phylmd/dimphy.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/dimphy.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/dimphy.f90 (revision 5489) @@ -13,5 +13,5 @@ INTEGER,SAVE :: kflev -!$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon) +!$OMP THREADPRIVATE(klon,kdlon,kfdia,kidia,klev,klevp1,klevm1,kflev) REAL,save,allocatable,dimension(:) :: zmasq !$OMP THREADPRIVATE(zmasq) Index: LMDZ6/branches/contrails/libf/phylmd/dyn1d/replay1d.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/dyn1d/replay1d.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/dyn1d/replay1d.f90 (revision 5489) @@ -24,5 +24,5 @@ CHARACTER (len=10) :: calend CHARACTER(len=20) :: calendrier - +CHARACTER(len=20) :: lmax_replay !--------------------------------------------------------------------- @@ -56,4 +56,12 @@ call getin('calend',calend) call getin('day_step',day_step) + +print*,'AVANT getin' +klev=llm +CALL getin('lmax_replay',lmax_replay) +print*,'APRES getin',lmax_replay +CALL getin(lmax_replay,klev) +print*,'replay1d lmax_replay klev',lmax_replay,klev + calendrier=calend if ( calendrier == "earth_360d" ) calendrier="360_day" @@ -69,5 +77,4 @@ klon=1 -klev=llm call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,86400./day_step,calendrier) ! Consistent with ... CALL iophys_ini(600.) Index: LMDZ6/branches/contrails/libf/phylmd/fonte_neige_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/fonte_neige_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/fonte_neige_mod.F90 (revision 5489) @@ -231,5 +231,5 @@ SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, & tsurf, precip_rain, precip_snow, & - snow, qsol, tsurf_new, evap & + snow, qsol, tsurf_new, evap, ice_sub & #ifdef ISO & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & @@ -288,4 +288,6 @@ REAL, DIMENSION(klon), INTENT(INOUT) :: evap + + REAL, DIMENSION(klon), INTENT(OUT) :: ice_sub #ifdef ISO ! sortie de quelques diagnostiques @@ -297,6 +299,7 @@ REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag - REAL, INTENT(OUT) :: coeff_rel_diag -#endif + REAL, INTENT(OUT) :: coeff_rel_diag +#endif + ! Local variables @@ -345,4 +348,5 @@ snow_evap = 0. + ice_sub(:) = 0. IF (.NOT. ok_lic_cond) THEN @@ -363,4 +367,11 @@ bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime + + IF (nisurf==is_lic) THEN + DO i=1,knon + ice_sub(i)=evap(i)-snow_evap(i) + ENDDO + ENDIF + #ifdef ISO snow_evap_diag(:) = snow_evap(:) Index: LMDZ6/branches/contrails/libf/phylmd/infotrac_phy.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/infotrac_phy.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/infotrac_phy.F90 (revision 5489) @@ -3,9 +3,9 @@ MODULE infotrac_phy - USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx - USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, & - delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, & - addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck - USE readTracFiles_mod, ONLY: new2oldH2O + USE strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx + USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, addPhase, addKey, iH2O, & + isoSelect, indexUpdate, isot_type, testTracersFiles, isotope, delPhase, getKey, tran0, & + isoKeys, isoName, isoZone, isoPhas, processIsotopes, isoCheck, itZonIso, nbIso, & + niso, ntiso, nzone, nphas, maxTableWidth, iqIsoPha, iqWIsoPha, ixIso, new2oldH2O IMPLICIT NONE @@ -27,5 +27,5 @@ !=== FOR ISOTOPES: Specific to water PUBLIC :: iH2O !--- Value of "ixIso" for "H2O" isotopes class - PUBLIC :: ivap, iliq, isol + PUBLIC :: ivap, iliq, isol, ibs, icf, irvc, ircont !=== FOR ISOTOPES: Depending on the selected isotopes family PUBLIC :: isotope !--- Selected isotopes database (argument of getKey) @@ -80,6 +80,5 @@ ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | -! | isAdvected | Advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | -! | isInPhysics | Tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | +! | isInPhysics | Advected tracers from the main table kept in physics | / | nqtottr .TRUE. values | ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | @@ -104,18 +103,18 @@ !=== INDICES FOR WATER - INTEGER, SAVE :: ivap, iliq, isol -!$OMP THREADPRIVATE(ivap, iliq, isol) + INTEGER, SAVE :: ivap, iliq, isol, ibs, icf, irvc, ircont +!$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc, ircont) !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES - INTEGER, SAVE :: nqtot !--- Tracers nb in dynamics (incl. higher moments + H2O) - INTEGER, SAVE :: nbtr !--- Tracers nb in physics (excl. higher moments + H2O) - INTEGER, SAVE :: nqo !--- Number of water phases - INTEGER, SAVE :: nqtottr !--- Number of tracers passed to phytrac (TO BE DELETED ?) - INTEGER, SAVE :: nqCO2 !--- Number of tracers of CO2 (ThL) + INTEGER, SAVE :: nqtot !--- Tracers nb in dynamics (incl. higher moments + H2O) + INTEGER, SAVE :: nbtr !--- Tracers nb in physics (excl. higher moments + H2O) + INTEGER, SAVE :: nqo !--- Number of water phases + INTEGER, SAVE :: nqtottr !--- Number of tracers passed to phytrac (TO BE DELETED ?) + INTEGER, SAVE :: nqCO2 !--- Number of tracers of CO2 (ThL) CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac) !=== VARIABLES FOR INCA - INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr) + INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:) !--- Convection / boundary layer activation (nbtr) !$OMP THREADPRIVATE(conv_flg, pbl_flg) @@ -133,5 +132,6 @@ USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_trac USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS, CPPKEY_STRATAER -IMPLICIT NONE + USE mod_phys_lmdz_para, ONLY: is_master, is_omp_master + IMPLICIT NONE !============================================================================================================================== ! @@ -158,7 +158,4 @@ ! Local variables INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number - INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA - vad (:), vadv_inca(:), pbl_flg_inca(:) - CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA INTEGER :: nqINCA CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:) @@ -187,9 +184,9 @@ CALL getin_p('type_trac',type_trac) - lerr=strParse(type_trac, '|', types_trac, n=nt) - IF (nt .GT. 1) THEN - IF (nt .GT. 2) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) - IF (nt .EQ. 2) type_trac=types_trac(2) - ENDIF + CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname, is_master) + IF(strCount(type_trac, '|', nt)) CALL abort_physic(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1) + IF(nt >= 3) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) + IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_physic(modname, "couldn't parse "//'"type_trac"', 1) + IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) @@ -197,5 +194,5 @@ !############################################################################################################################## - IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### + IF(lInit .AND. is_master) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### !############################################################################################################################## !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION @@ -214,15 +211,9 @@ SELECT CASE(type_trac) CASE('inca', 'inco') -IF (.NOT. CPPKEY_INCA) THEN - CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1) -END IF + IF(.NOT.CPPKEY_INCA) CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1) CASE('repr') -IF (.NOT. CPPKEY_REPROBUS) THEN - CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) -END IF + IF(.NOT.CPPKEY_REPROBUS) CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) CASE('coag') -IF (.NOT. CPPKEY_STRATAER) THEN - CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) -END IF + IF(.NOT.CPPKEY_STRATAER) CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) END SELECT !############################################################################################################################## @@ -230,90 +221,42 @@ !############################################################################################################################## - nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) - !============================================================================================================================== ! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT !============================================================================================================================== - texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" + texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" IF(texp == 'inco') texp = 'co2i|inca' IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) - IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_physic(modname, 'problem with tracers file(s)',1) + IF(testTracersFiles(modname, texp, fType, lInit.AND.is_master)) CALL abort_physic(modname, 'problem with tracers file(s)',1) ttp = type_trac; IF(fType /= 1) ttp = texp - -!############################################################################################################################## - IF(lInit) THEN - IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1) - ELSE - CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname) - END IF -!############################################################################################################################## - -!============================================================================================================================== -! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. -!============================================================================================================================== !--------------------------------------------------------------------------------------------------------------------------- IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_.def tracers file.',1) !--------------------------------------------------------------------------------------------------------------------------- - IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac) .AND. lInit) THEN !=== FOUND OLD STYLE INCA "traceur.def" + IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) & !=== FOUND OLD STYLE INCA "traceur.def" + CALL abort_physic(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1) !--------------------------------------------------------------------------------------------------------------------------- -IF (CPPKEY_INCA) THEN - nqo = SIZE(tracers) - nqCO2 - CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA - nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac - nqtrue = nbtr + nqo !--- Total number of "true" tracers - IF(ALL([2,3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) - ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) - ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) - CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) - ALLOCATE(ttr(nqtrue)) - ttr(1:nqo+nqCO2) = tracers - ttr(1 : nqo )%component = 'lmdz' - ttr(1+nqo:nqCO2+nqo )%component = 'co2i' - ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' - ttr(1+nqo :nqtrue)%name = [('CO2 ', iq=1, nqCO2), solsym_inca] - ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 - ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' - lerr = getKey('hadv', had, ky=tracers(:)%keys) - lerr = getKey('vadv', vad, ky=tracers(:)%keys) - hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca - vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca - CALL MOVE_ALLOC(FROM=ttr, TO=tracers) - DO iq = 1, nqtrue - t1 => tracers(iq) - CALL addKey('name', t1%name, t1%keys) - CALL addKey('component', t1%component, t1%keys) - CALL addKey('parent', t1%parent, t1%keys) - CALL addKey('phase', t1%phase, t1%keys) - END DO - IF(setGeneration(tracers)) CALL abort_physic(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name - DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) -END IF - !--------------------------------------------------------------------------------------------------------------------------- - ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) - !--------------------------------------------------------------------------------------------------------------------------- + +!############################################################################################################################## + IF(lInit) THEN + IF(readTracersFiles(ttp, lRepr=type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1) + END IF + CALL msg('No tracers description file(s) reading needed: already done', modname, .NOT.lInit.AND.is_master) +!############################################################################################################################## + +!============================================================================================================================== +! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. +!============================================================================================================================== nqtrue = SIZE(tracers) !--- "true" tracers nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) -IF (CPPKEY_INCA) THEN + IF(CPPKEY_INCA) & nqINCA = COUNT(tracers(:)%component == 'inca') -END IF + IF(CPPKEY_REPROBUS) CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus + +!============================================================================================================================== +! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). +!============================================================================================================================== IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1) IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1) - !--------------------------------------------------------------------------------------------------------------------------- - END IF - !--------------------------------------------------------------------------------------------------------------------------- - -IF (CPPKEY_REPROBUS) THEN - CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus -END IF - -!############################################################################################################################## - IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### -!############################################################################################################################## - -!============================================================================================================================== -! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). -!============================================================================================================================== DO iq = 1, nqtrue IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE @@ -332,9 +275,13 @@ END IF -!============================================================================================================================== -! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names, nqtot and %isAdvected +!############################################################################################################################## + IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### +!############################################################################################################################## + +!============================================================================================================================== +! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot !============================================================================================================================== ALLOCATE(ttr(nqtot)) - jq = nqtrue+1; tracers(:)%iadv = -1 + jq = nqtrue+1 DO iq = 1, nqtrue t1 => tracers(iq) @@ -347,8 +294,7 @@ IF(iad == -1) CALL abort_physic(modname, msg1, 1) - !--- SET FIELDS longName, isAdvected, isInPhysics + !--- SET FIELDS longName, isInPhysics t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) - t1%isAdvected = iad >= 0 - t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O + t1%isInPhysics= iad >= 0 .AND. (delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz') ttr(iq) = t1 @@ -363,5 +309,4 @@ ttr(jq+1:jq+nm)%parent = [ (TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] - ttr(jq+1:jq+nm)%isAdvected = [ (.FALSE., im=1, nm) ] ttr(jq+1:jq+nm)%isInPhysics = [ (.FALSE., im=1, nm) ] jq = jq + nm @@ -373,16 +318,4 @@ IF(indexUpdate(tracers)) CALL abort_physic(modname, 'problem with tracers indices update', 1) -!############################################################################################################################## - END IF -!############################################################################################################################## - -!############################################################################################################################## - IF(.NOT.lInit) THEN -!############################################################################################################################## - nqtot = SIZE(tracers) -!############################################################################################################################## - ELSE -!############################################################################################################################## - !=== READ PHYSICAL PARAMETERS FOR ISOTOPES niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE. @@ -390,6 +323,16 @@ !############################################################################################################################## - END IF -!############################################################################################################################## + ELSE +!############################################################################################################################## + DO iq = 1, nqtrue + t1 => tracers(iq) + IF(hadv(iq) == vadv(iq) ) iad = hadv(iq) + IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11 + tracers(iq)%isInPhysics= iad >= 0 .AND. (delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz') + END DO +!############################################################################################################################## + END IF +!############################################################################################################################## + !--- Convection / boundary layer activation for all tracers IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 @@ -401,39 +344,14 @@ CALL abort_physic(modname, 'problem with the computation of nqtottr', 1) - !=== DISPLAY THE RESULTS - CALL msg('nqo = '//TRIM(int2str(nqo)), modname) - CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) - CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) - CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) - CALL msg('niso = '//TRIM(int2str(niso)), modname) - CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) -IF (CPPKEY_INCA) THEN - CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) - CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) -END IF - t => tracers - CALL msg('Information stored in '//TRIM(modname)//': ', modname) - IF(dispTable('isssssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & - 'isPh', 'isAd', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & - cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, & - bool2str(t%isInPhysics), bool2str(t%isAdvected)), & - cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & - t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & - CALL abort_physic(modname, "problem with the tracers table content", 1) - IF(niso > 0) THEN - CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname) - CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) - CALL msg(' isoName = '//strStack(isoName), modname) - CALL msg(' isoZone = '//strStack(isoZone), modname) - CALL msg(' isoPhas = '//TRIM(isoPhas), modname) - ELSE - CALL msg('No isotopes identified.', modname) - END IF - -#ifdef ISOVERIF - CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname) -#endif -IF (CPPKEY_STRATAER) THEN - IF (type_trac == 'coag') THEN + !--- Compute indices for water + ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g')) + iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) + isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) + ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) + icf = strIdx(tracers(:)%name, addPhase('H2O', 'f')) + irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c')) + ircont = strIdx(tracers(:)%name, addPhase('H2O', 'a')) + + IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)]) nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)]) @@ -444,4 +362,33 @@ id_H2SO4_strat = strIdx(tnames, 'GASH2SO4') id_TEST_strat = strIdx(tnames, 'GASTEST' ) + END IF + + !=== DISPLAY THE RESULTS + IF(.NOT.is_master) RETURN + CALL msg('nqo = '//TRIM(int2str(nqo)), modname) + CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) + CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) + CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) + CALL msg('niso = '//TRIM(int2str(niso)), modname) + CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) + CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname, CPPKEY_INCA) + CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname, CPPKEY_INCA) + t => tracers + CALL msg('Information stored in '//TRIM(modname)//': ', modname) + IF(dispTable('issssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & + 'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & + cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),& + cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & + t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & + CALL abort_physic(modname, "problem with the tracers table content", 1) + CALL msg('No isotopes identified.', modname, nbIso == 0) + IF(nbIso == 0) RETURN + CALL msg('For isotopes family "H2O":', modname) + CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) + CALL msg(' isoName = '//strStack(isoName), modname) + CALL msg(' isoZone = '//strStack(isoZone), modname) + CALL msg(' isoPhas = '//TRIM(isoPhas), modname) + + IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname) CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname) @@ -452,6 +399,4 @@ CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname) END IF -END IF - CALL msg('end', modname) END SUBROUTINE init_infotrac_phy Index: LMDZ6/branches/contrails/libf/phylmd/iophy.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/iophy.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/iophy.F90 (revision 5489) @@ -13,6 +13,5 @@ INTEGER, SAVE :: itau_iophy LOGICAL :: check_dim = .false. - -!$OMP THREADPRIVATE(itau_iophy) +!$OMP THREADPRIVATE(io_lat,io_lon,phys_domain_id,npstn,nptabij,itau_iophy) INTERFACE histwrite_phy @@ -972,4 +971,5 @@ REAL, ALLOCATABLE, DIMENSION(:) :: fieldok logical, save :: is_active = .true. +!$OMP THREADPRIVATE(is_active) IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name) Index: LMDZ6/branches/contrails/libf/phylmd/iophys.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/iophys.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/iophys.F90 (revision 5489) @@ -110,9 +110,9 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - SUBROUTINE iophys_ini(timestep) + SUBROUTINE iophys_ini(timestep,nlev) + USE dimphy, ONLY: klev USE mod_phys_lmdz_para, ONLY: is_mpi_root USE vertical_layers_mod, ONLY: presnivs USE regular_lonlat_mod, ONLY: lon_reg, lat_reg - USE dimphy, ONLY: klev USE mod_grid_phy_lmdz, ONLY: klon_glo USE time_phylmdz_mod, ONLY : annee_ref, day_ref, day_ini @@ -139,9 +139,14 @@ ! ------------- +integer, intent(in) :: nlev +real, intent(in) :: timestep + real pi INTEGER nlat_eff INTEGER jour0,mois0,an0 -REAL timestep,t0 +REAL t0 CHARACTER(len=20) :: calendrier +integer ilev +real coord_vert(nlev) ! Arguments: @@ -178,7 +183,18 @@ print*,'iophys_ini annee_ref day_ref',annee_ref,day_ref,day_ini,calend,t0 - +if ( nlev == klev ) then + coord_vert=presnivs +print*,'ON EST LA ' +else + do ilev=1,nlev + coord_vert(ilev)=ilev + enddo +endif +print*,'nlev=',nlev +print*,'coord_vert',coord_vert call iotd_ini('phys.nc', & -size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs,jour0,mois0,an0,t0,timestep,calendrier) +size(lon_reg),nlat_eff,nlev,lon_reg(:)*180./pi,lat_reg*180./pi,coord_vert,jour0,mois0,an0,t0,timestep,calendrier) + ! SUBROUTINE iotd_ini(fichnom,iim,jjm,llm,prlon,prlat,pcoordv,jour0,mois0,an0,t0,timestep,calendrier) +! ------- ENDIF !$OMP END MASTER @@ -216,4 +232,6 @@ SUBROUTINE iotd_ecrit_seq(nom,lllm,titre,unite,px) +!call iotd_ecrit_seq('f0',1,'f0 in thermcell_plume_6A',' ',f0(1:ngrid)) + USE iotd_mod_h @@ -230,4 +248,5 @@ integer i,j,l,ijl + !print*,'iotd_ecrit_seq ,nom,lllm,titre,unite,px',nom,lllm,titre,unite,px allocate(zx(imax,jmax,lllm)) Index: LMDZ6/branches/contrails/libf/phylmd/iostart.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/iostart.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/iostart.f90 (revision 5489) @@ -4,6 +4,7 @@ INTEGER,SAVE :: nid_start INTEGER,SAVE :: nid_restart - INTEGER,SAVE :: idim1,idim2,idim3,idim4 +!$OMP THREADPRIVATE(nid_start,nid_restart,idim1,idim2,idim3,idim4) + INTEGER,PARAMETER :: length=100 Index: LMDZ6/branches/contrails/libf/phylmd/iotd_ecrit.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/iotd_ecrit.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/iotd_ecrit.f90 (revision 5489) @@ -55,4 +55,5 @@ ! Ajouts integer, save :: ntime=0 + !$OMP THREADPRIVATE(ntime) integer :: idim,varid character (len =50):: fichnom Index: LMDZ6/branches/contrails/libf/phylmd/lmdz_cloudth.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/lmdz_cloudth.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/lmdz_cloudth.f90 (revision 5489) @@ -69,5 +69,4 @@ REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) REAL zqs(ngrid), qcloud(ngrid) - REAL erf @@ -91,14 +90,14 @@ ! Initialisation des variables r?elles !------------------------------------------------------------------------------- - sigma1(:,:)=0. - sigma2(:,:)=0. - qlth(:,:)=0. - qlenv(:,:)=0. - qltot(:,:)=0. - rneb(:,:)=0. + sigma1(:,ind2)=0. + sigma2(:,ind2)=0. + qlth(:,ind2)=0. + qlenv(:,ind2)=0. + qltot(:,ind2)=0. + rneb(:,ind2)=0. qcloud(:)=0. - cth(:,:)=0. - cenv(:,:)=0. - ctot(:,:)=0. + cth(:,ind2)=0. + cenv(:,ind2)=0. + ctot(:,ind2)=0. qsatmmussig1=0. qsatmmussig2=0. @@ -317,19 +316,18 @@ REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) REAL zqs(ngrid), qcloud(ngrid) - REAL erf !------------------------------------------------------------------------------ ! Initialisation des variables r?elles !------------------------------------------------------------------------------ - sigma1(:,:)=0. - sigma2(:,:)=0. - qlth(:,:)=0. - qlenv(:,:)=0. - qltot(:,:)=0. - rneb(:,:)=0. + sigma1(:,ind2)=0. + sigma2(:,ind2)=0. + qlth(:,ind2)=0. + qlenv(:,ind2)=0. + qltot(:,ind2)=0. + rneb(:,ind2)=0. qcloud(:)=0. - cth(:,:)=0. - cenv(:,:)=0. - ctot(:,:)=0. + cth(:,ind2)=0. + cenv(:,ind2)=0. + ctot(:,ind2)=0. qsatmmussig1=0. qsatmmussig2=0. @@ -644,5 +642,4 @@ REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid) REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) - REAL erf @@ -663,17 +660,17 @@ ! Initialisation des variables r?elles !------------------------------------------------------------------------------- - sigma1(:,:)=0. - sigma2(:,:)=0. - qlth(:,:)=0. - qlenv(:,:)=0. - qltot(:,:)=0. - rneb(:,:)=0. + sigma1(:,ind2)=0. + sigma2(:,ind2)=0. + qlth(:,ind2)=0. + qlenv(:,ind2)=0. + qltot(:,ind2)=0. + rneb(:,ind2)=0. qcloud(:)=0. - cth(:,:)=0. - cenv(:,:)=0. - ctot(:,:)=0. - cth_vol(:,:)=0. - cenv_vol(:,:)=0. - ctot_vol(:,:)=0. + cth(:,ind2)=0. + cenv(:,ind2)=0. + ctot(:,ind2)=0. + cth_vol(:,ind2)=0. + cenv_vol(:,ind2)=0. + ctot_vol(:,ind2)=0. qsatmmussig1=0. qsatmmussig2=0. @@ -878,5 +875,4 @@ REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) REAL zqs(ngrid), qcloud(ngrid) - REAL erf REAL rhodz(ngrid,klev) @@ -895,17 +891,17 @@ !------------------------------------------------------------------------------ - sigma1(:,:)=0. - sigma2(:,:)=0. - qlth(:,:)=0. - qlenv(:,:)=0. - qltot(:,:)=0. - rneb(:,:)=0. + sigma1(:,ind2)=0. + sigma2(:,ind2)=0. + qlth(:,ind2)=0. + qlenv(:,ind2)=0. + qltot(:,ind2)=0. + rneb(:,ind2)=0. qcloud(:)=0. - cth(:,:)=0. - cenv(:,:)=0. - ctot(:,:)=0. - cth_vol(:,:)=0. - cenv_vol(:,:)=0. - ctot_vol(:,:)=0. + cth(:,ind2)=0. + cenv(:,ind2)=0. + ctot(:,ind2)=0. + cth_vol(:,ind2)=0. + cenv_vol(:,ind2)=0. + ctot_vol(:,ind2)=0. qsatmmussig1=0. qsatmmussig2=0. @@ -1306,5 +1302,5 @@ REAL qcloud(ngrid) !eau totale dans le nuage !Some arithmetic variables - REAL erf,pi,sqrt2,sqrt2pi + REAL pi,sqrt2,sqrt2pi !Depth of the layer REAL dz(ngrid,klev) !epaisseur de la couche en metre @@ -1320,13 +1316,13 @@ ! Initialization !------------------------------------------------------------------------------ - qlth(:,:)=0. - qlenv(:,:)=0. - qltot(:,:)=0. - cth_vol(:,:)=0. - cenv_vol(:,:)=0. - ctot_vol(:,:)=0. - cth_surf(:,:)=0. - cenv_surf(:,:)=0. - ctot_surf(:,:)=0. + qlth(:,ind2)=0. + qlenv(:,ind2)=0. + qltot(:,ind2)=0. + cth_vol(:,ind2)=0. + cenv_vol(:,ind2)=0. + ctot_vol(:,ind2)=0. + cth_surf(:,ind2)=0. + cenv_surf(:,ind2)=0. + ctot_surf(:,ind2)=0. qcloud(:)=0. rdd=287.04 @@ -1579,5 +1575,4 @@ REAL qlbef REAL dqsatenv(klon), dqsatth(klon) - REAL erf REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon) REAL zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon) Index: LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_old.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_old.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_old.f90 (revision 5489) @@ -3,5 +3,58 @@ ! MODULE lmdz_lscp_old + PRIVATE + + INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation + LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle + REAL, PARAMETER :: t_coup=234.0 + REAL, PARAMETER :: DDT0=.01 + REAL, PARAMETER :: ztfondue=278.15 + + LOGICAL, SAVE :: appel1er=.TRUE. + !$OMP THREADPRIVATE(appel1er) + + PUBLIC fisrtilp_first, fisrtilp + CONTAINS + +! firstilp first call part +SUBROUTINE fisrtilp_first(klon, klev, dtime, pfrac_nucl, pfrac_1nucl, pfrac_impa) +USE lmdz_lscp_ini, ONLY: prt_level, lunout +IMPLICIT NONE + REAL, INTENT(IN) :: dtime ! intervalle du temps (s) + INTEGER, INTENT(IN) :: klon, klev + INTEGER :: i, k + + !AA + ! Coeffients de fraction lessivee : pour OFF-LINE + ! + REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfrac_nucl + REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfrac_1nucl + REAL, DIMENSION(klon,klev), INTENT(OUT) :: pfrac_impa + + IF (appel1er) THEN + WRITE(lunout,*) 'fisrtilp, ninter:', ninter + WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel + WRITE(lunout,*) 'FISRTILP VERSION LUDO' + + IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN + WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime + WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes' + ! CALL abort + ENDIF + ! + !cdir collapse + DO k = 1, klev + DO i = 1, klon + pfrac_nucl(i,k)=1. + pfrac_1nucl(i,k)=1. + pfrac_impa(i,k)=1. + ENDDO + ENDDO + appel1er = .FALSE. + ENDIF + +END SUBROUTINE fisrtilp_first + SUBROUTINE fisrtilp(klon,klev,dtime,paprs,pplay,t,q,ptconv,ratqs,sigma_qtherm, & d_t, d_q, d_ql, d_qi, rneb,rneblsvol,radliq, rain, snow, & @@ -117,10 +170,5 @@ REAL :: smallestreal - INTEGER, PARAMETER :: ninter=5 ! sous-intervals pour la precipitation - LOGICAL, PARAMETER :: cpartiel=.TRUE. ! condensation partielle - REAL, PARAMETER :: t_coup=234.0 - REAL, PARAMETER :: DDT0=.01 - REAL, PARAMETER :: ztfondue=278.15 - ! -------------------------------------------------------------------------------- + ! -------------------------------------------------------------------------------- ! ! Variables locales: @@ -142,5 +190,4 @@ REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta, Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2, qcloud - REAL :: erf REAL :: zqev, zqevt, zqev0,zqevi, zqevti, zdelq @@ -165,6 +212,4 @@ REAL, DIMENSION(klon) :: zmqc ! - LOGICAL, SAVE :: appel1er=.TRUE. - !$OMP THREADPRIVATE(appel1er) ! ! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max @@ -196,4 +241,5 @@ REAL, DIMENSION(klon) :: zlh_solid REAL :: zm_solid + REAL :: tmp_var1d(klon) ! temporary variable for call site @@ -218,27 +264,7 @@ if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM' - IF (appel1er) THEN - WRITE(lunout,*) 'fisrtilp, ninter:', ninter - WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel - WRITE(lunout,*) 'FISRTILP VERSION LUDO' - - IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN - WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime - WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes' - ! CALL abort - ENDIF - appel1er = .FALSE. - ! - !cdir collapse - DO k = 1, klev - DO i = 1, klon - pfrac_nucl(i,k)=1. - pfrac_1nucl(i,k)=1. - pfrac_impa(i,k)=1. - beta(i,k)=0. !RomP initialisation - ENDDO - ENDDO - - ENDIF ! test sur appel1er + + beta(:,:)=0. !RomP initialisation => ym : could be probably removed but keept by security + ! !MAf Initialisation a 0 de zoliq @@ -954,5 +980,6 @@ ! -------------------------- if (iflag_t_glace.ge.1) then - CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:)) + tmp_var1d(:) = pplay(:,k)/paprs(:,1) + CALL icefrac_lsc(klon, zt(:), tmp_var1d, zfice(:)) endif @@ -1123,5 +1150,6 @@ ELSE if (iflag_t_glace.ge.1) then - CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:)) + tmp_var1d(:) = pplay(:,k)/paprs(:,1) + CALL icefrac_lsc(klon,zt(:),tmp_var1d,zfice(:)) endif if (iflag_fisrtilp_qsat.lt.1) then @@ -1242,5 +1270,6 @@ ENDDO ELSE ! of IF (iflag_t_glace.EQ.0) - CALL icefrac_lsc(klon,zt(:),pplay(:,k)/paprs(:,1),zfice(:)) + tmp_var1d(:) = pplay(:,k)/paprs(:,1) + CALL icefrac_lsc(klon,zt(:), tmp_var1d, zfice(:)) ! DO i = 1, klon ! IF (rneb(i,k).GT.0.0) THEN Index: LMDZ6/branches/contrails/libf/phylmd/lmdz_surf_wind.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/lmdz_surf_wind.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/lmdz_surf_wind.f90 (revision 5489) @@ -2,22 +2,22 @@ CONTAINS -SUBROUTINE surf_wind(klon,nsrfwnd,zu10m,zv10m,sigmaw,cstar,ustar,wstar,wind10ms,probu) +SUBROUTINE surf_wind(klon,nsurfwind,zu10m,zv10m,sigmaw,cstar,ustar,wstar,wind10ms,probu) USE lmdz_surf_wind_ini, ONLY : iflag_surf_wind IMPLICIT NONE -INTEGER, INTENT(IN) :: nsrfwnd, klon +INTEGER, INTENT(IN) :: nsurfwind, klon REAL, DIMENSION(klon), INTENT(IN) :: zu10m, zv10m REAL, DIMENSION(klon), INTENT(IN) :: cstar REAL, DIMENSION(klon), INTENT(IN) :: sigmaw REAL, DIMENSION(klon), INTENT(IN) :: ustar, wstar -REAL, DIMENSION(klon,nsrfwnd), INTENT(OUT) :: wind10ms, probu +REAL, DIMENSION(klon,nsurfwind), INTENT(OUT) :: wind10ms, probu -REAL, DIMENSION(klon,nsrfwnd) :: sigma_th, sigma_wk -REAL, DIMENSION(klon,nsrfwnd) :: xp, yp, zz -REAL, DIMENSION(klon,nsrfwnd) :: vwx, vwy, vw -REAL, DIMENSION(klon,nsrfwnd) :: vtx, vty -REAL, DIMENSION(klon,nsrfwnd) :: windx, windy, wind +REAL, DIMENSION(klon,nsurfwind) :: sigma_th, sigma_wk +REAL, DIMENSION(klon,nsurfwind) :: xp, yp, zz +REAL, DIMENSION(klon,nsurfwind) :: vwx, vwy, vw +REAL, DIMENSION(klon,nsurfwind) :: vtx, vty +REAL, DIMENSION(klon,nsurfwind) :: windx, windy, wind REAL, DIMENSION(klon) :: ubwk, vbwk ! ubwk et vbwk sont les vitesses moyennes dans les poches REAL, DIMENSION(klon) :: weilambda, U10mMOD @@ -30,5 +30,5 @@ REAL :: ktwk, ktth, kzth -print*,'LLLLLLLLLLLLLLLLLLLLL nsrfwnd=',nsrfwnd +!print*,'LLLLLLLLLLLLLLLLLLLLL nsurfwind=',nsurfwind pi=2.*acos(0.) ray=7000. @@ -37,5 +37,5 @@ kzth=1. kref=3 -nwb=nsrfwnd +nwb=nsurfwind ubwk(klon) = zu10m(klon) @@ -53,6 +53,6 @@ IF (iflag_surf_wind == 0) THEN !U10mMOD=sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) - IF (nsrfwnd /= 1 ) THEN - STOP 'Si iflag_surf_wind=0, nsrfwnd=1' + IF (nsurfwind /= 1 ) THEN + STOP 'Si iflag_surf_wind=0, nsurfwind=1' ENDIF DO i=1,klon @@ -66,5 +66,5 @@ DO i=1, klon - DO nmc=1, nsrfwnd + DO nmc=1, nsurfwind ! Utilisation de la distribution de weibull !U10mMOD=sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) @@ -90,5 +90,5 @@ DO i=1, klon - DO nmc=1, nsrfwnd + DO nmc=1, nsurfwind ! Utilisation de la distribution du vent a l interieur et a l exterieur des poches call Random_number(zz) ! tirage uniforme entre 0 et 1. @@ -122,5 +122,5 @@ wind(i,nmc) = sqrt(windx(i,nmc)**2 + windy(i,nmc)**2) wind10ms(i,nmc) = wind(i,nmc) - probu(i,nmc) = wind(i,nmc)/nsrfwnd + probu(i,nmc) = wind(i,nmc)/nsurfwind ELSE @@ -143,5 +143,5 @@ wind(i,nmc) = sqrt(windx(i,nmc)**2 + windy(i,nmc)**2) wind10ms(i,nmc) = wind(i,nmc) - probu(i,nmc) = wind(i,nmc)/nsrfwnd + probu(i,nmc) = wind(i,nmc)/nsurfwind ! print*, 'wind10ms', wind10ms(i,nmc) ENDIF Index: LMDZ6/branches/contrails/libf/phylmd/lmdz_wake.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/lmdz_wake.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/lmdz_wake.f90 (revision 5489) @@ -358,7 +358,7 @@ IF (CPPKEY_IOPHYS_WK) THEN IF (phys_sub) THEN - call iophys_ini(dtimesub) + call iophys_ini(dtimesub,klev) ELSE - call iophys_ini(dtime) + call iophys_ini(dtime,klev) ENDIF END IF Index: LMDZ6/branches/contrails/libf/phylmd/modd_csts.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/modd_csts.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/modd_csts.f90 (revision 5489) @@ -88,4 +88,11 @@ REAL,SAVE :: XSURF_EPSILON ! minimum space with 1.0 ! +!$OMP THREADPRIVATE(XPI,XDAY,XSIYEA,XSIDAY,XKARMAN,XLIGHTSPEED,XPLANCK,XBOLTZ,XAVOGADRO) +!$OMP THREADPRIVATE(XRADIUS,XOMEGA,XG,XP00,XSTEFAN,XI0,XMD,XMV,XRD,XRV) +!$OMP THREADPRIVATE(XCPD,XCPV,XRHOLW,XCL,XCI,XTT,XTTSI,XTTS,XICEC,XLVTT,XLSTT,XLMTT,XESTT) +!$OMP THREADPRIVATE(XALPW,XBETAW,XGAMW,XALPI,XBETAI,XGAMI,XTH00) +!$OMP THREADPRIVATE(XRHOLI,XCONDI,NDAYSEC) +!$OMP THREADPRIVATE(XSURF_TINY,XSURF_TINY_12,XSURF_EPSILON) + END MODULE MODD_CSTS Index: LMDZ6/branches/contrails/libf/phylmd/oasis.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/oasis.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/oasis.F90 (revision 5489) @@ -139,4 +139,7 @@ LOGICAL, SAVE :: cpl_current_omp INTEGER, DIMENSION(klon_mpi) :: ind_cell_glo_mpi + + !$OMP THREADPRIVATE(cpl_current_omp) + !* 1. Initializations Index: LMDZ6/branches/contrails/libf/phylmd/ocean_forced_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/ocean_forced_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/ocean_forced_mod.F90 (revision 5489) @@ -335,5 +335,5 @@ REAL :: zfra REAL, PARAMETER :: t_grnd=271.35 - REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol + REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol, icesub REAL, DIMENSION(klon) :: alb_neig, tsurf_tmp REAL, DIMENSION(klon) :: soilcap, soilflux @@ -452,5 +452,5 @@ CALL fonte_neige( knon, is_sic, knindex, dtime, & tsurf_tmp, precip_rain, precip_snow, & - snow, qsol, tsurf_new, evap & + snow, qsol, tsurf_new, evap, icesub & #ifdef ISO & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & Index: LMDZ6/branches/contrails/libf/phylmd/output_physiqex_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/output_physiqex_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/output_physiqex_mod.f90 (revision 5489) @@ -58,5 +58,5 @@ !$OMP MASTER - CALL iophys_ini(pdtphys) + CALL iophys_ini(pdtphys,klev) !$OMP END MASTER !$OMP BARRIER Index: LMDZ6/branches/contrails/libf/phylmd/pbl_surface_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/pbl_surface_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/pbl_surface_mod.F90 (revision 5489) @@ -277,5 +277,5 @@ !>jyg alb_dir_m, alb_dif_m, zxsens, zxevap, zxsnowerosion, & - alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, & + icesub_lic, alb3_lic, runoff, snowhgt, qsnow, to_ice, sissnow, & zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, & d_t, d_q, d_qbs, d_u, d_v, d_t_diss, & @@ -522,4 +522,5 @@ REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards REAL, DIMENSION(klon), INTENT(OUT) :: zxsnowerosion ! blowing snow flux at surface + REAL, DIMENSION(klon), INTENT(OUT) :: icesub_lic ! ice (no snow!) sublimation over ice sheet REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point !!! jyg le ??? @@ -745,5 +746,5 @@ REAL, DIMENSION(klon) :: AcoefQBS, BcoefQBS REAL, DIMENSION(klon) :: ypsref - REAL, DIMENSION(klon) :: yevap, yevap_pot, ytsurf_new, yalb3_new + REAL, DIMENSION(klon) :: yevap, yevap_pot, ytsurf_new, yalb3_new, yicesub_lic !albedo SB >>> REAL, DIMENSION(klon,nsw) :: yalb_dir_new, yalb_dif_new @@ -1246,5 +1247,5 @@ zxfluxt(:,:)=0. ; zxfluxq(:,:)=0.; zxfluxqbs(:,:)=0. qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0. - runoff(:)=0. + runoff(:)=0. ; icesub_lic(:)=0. #ifdef ISO zxxtevap(:,:)=0. @@ -2498,5 +2499,5 @@ ypsref, yu1, yv1, ygustiness, yrugoro, pctsrf, & ysnow, yqsurf, yqsol,yqbs1, yagesno, & - ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, & + ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap, yicesub_lic, yfluxsens,yfluxlat, & yfluxbs, ytsurf_new, y_dflux_t, y_dflux_q, & yzmea, yzsig, ycldt, & @@ -2521,4 +2522,5 @@ sissnow(i) = ysissnow(j) runoff(i) = yrunoff(j) + icesub_lic(i) = yicesub_lic(j)*ypct(j) ENDDO ! Martin @@ -3225,5 +3227,5 @@ ENDIF ! (iflag_split .eq.0) -!!! + ! tendencies of blowing snow Index: LMDZ6/branches/contrails/libf/phylmd/phyetat0_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/phyetat0_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/phyetat0_mod.f90 (revision 5489) @@ -538,5 +538,5 @@ it = 0 DO iq = 1, nqtot - IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE + IF(.NOT.tracers(iq)%isInPhysics) CYCLE it = it+1 tname = tracers(iq)%name Index: LMDZ6/branches/contrails/libf/phylmd/phyredem.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/phyredem.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/phyredem.f90 (revision 5489) @@ -360,5 +360,5 @@ it = 0 DO iq = 1, nqtot - IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE + IF(.NOT.tracers(iq)%isInPhysics) CYCLE it = it+1 CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it)) Index: LMDZ6/branches/contrails/libf/phylmd/phys_local_var_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/phys_local_var_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/phys_local_var_mod.F90 (revision 5489) @@ -385,4 +385,6 @@ REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw, water_budget !$OMP THREADPRIVATE(dthmin, evap, snowerosion, fder, plcl, plfc, prw, prlw, prsw, prbsw, water_budget) + REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: icesub_lic +!$OMP THREADPRIVATE(icesub_lic) REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zustar, zu10m, zv10m, rh2m !$OMP THREADPRIVATE(zustar, zu10m, zv10m, rh2m) @@ -1033,5 +1035,5 @@ ALLOCATE(cldm(klon), cldq(klon), cldt(klon), qsat2m(klon)) ALLOCATE(JrNt(klon)) - ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon)) + ALLOCATE(dthmin(klon), evap(klon), snowerosion(klon), fder(klon), plcl(klon), plfc(klon), icesub_lic(klon)) ALLOCATE(prw(klon), prlw(klon), prsw(klon), prbsw(klon), water_budget(klon), zustar(klon), zu10m(klon), zv10m(klon), rh2m(klon)) ALLOCATE(s_lcl(klon)) @@ -1469,5 +1471,5 @@ DEALLOCATE(cldm, cldq, cldt, qsat2m) DEALLOCATE(JrNt) - DEALLOCATE(dthmin, evap, snowerosion, fder, plcl, plfc) + DEALLOCATE(dthmin, evap, snowerosion, icesub_lic, fder, plcl, plfc) DEALLOCATE(prw, prlw, prsw, prbsw, water_budget, zustar, zu10m, zv10m, rh2m, s_lcl) DEALLOCATE(s_pblh, s_pblt, s_therm) Index: LMDZ6/branches/contrails/libf/phylmd/phys_output_ctrlout_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/phys_output_ctrlout_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/phys_output_ctrlout_mod.F90 (revision 5489) @@ -384,4 +384,6 @@ TYPE(ctrl_out), SAVE :: o_snowerosion = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & 'snowerosion', 'blowing snow flux', 'kg/(s*m2)', (/ ('', i=1, 10) /)) + TYPE(ctrl_out), SAVE :: o_icesub_lic = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), & + 'icesub_lic', 'sublimation of ice over landice tiles, mesh-averaged', 'kg/(s*m2)', (/ ('', i=1, 10) /)) TYPE(ctrl_out), SAVE :: o_ustart_lic = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), & 'ustart_lic', 'threshold velocity', 'm/s', (/ ('', i=1, 10) /)) @@ -2001,5 +2003,6 @@ TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_sat(:) TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_uscav(:) - TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet_con(:) + TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet_cv(:) + TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_wet(:) TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_dry(:) Index: LMDZ6/branches/contrails/libf/phylmd/phys_output_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/phys_output_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/phys_output_mod.F90 (revision 5489) @@ -7,4 +7,6 @@ USE phys_output_write_mod, ONLY : phys_output_write REAL, DIMENSION(nfiles),SAVE :: ecrit_files + !$OMP THREADPRIVATE(ecrit_files) + ! Abderrahmane 12 2007 @@ -139,4 +141,6 @@ REAL, DIMENSION(nfiles), SAVE :: phys_out_latmin = [ -90., -90., -90., -90., -90., -90., -90., -90., -90., -90.] REAL, DIMENSION(nfiles), SAVE :: phys_out_latmax = [ 90., 90., 90., 90., 90., 90., 90., 90., 90., 90.] +!$OMP THREADPRIVATE(phys_out_regfkey,phys_out_lonmin,phys_out_lonmax,phys_out_latmin,phys_out_latmax) + REAL, DIMENSION(klev,2) :: Ahyb_bounds, Bhyb_bounds REAL, DIMENSION(klev+1) :: lev_index @@ -172,5 +176,5 @@ ALLOCATE(o_dtr_evapls(nqtot),o_dtr_ls(nqtot),o_dtr_trsp(nqtot)) ALLOCATE(o_dtr_sscav(nqtot),o_dtr_sat(nqtot),o_dtr_uscav(nqtot)) - ALLOCATE(o_dtr_wet_con(nqtot)) + ALLOCATE(o_dtr_wet_cv(nqtot), o_dtr_wet(nqtot)) ALLOCATE(o_dtr_dry(nqtot),o_dtr_vdf(nqtot)) IF (CPPKEY_STRATAER) THEN @@ -513,5 +517,5 @@ itr = 0; itrb = 0 DO iq = 1, nqtot - IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE + IF(.NOT.tracers(iq)%isInPhysics) CYCLE itr = itr + 1 dn = 'd'//TRIM(tracers(iq)%name)//'_' @@ -542,5 +546,7 @@ lnam = 'tracer convective wet deposition'//TRIM(tracers(iq)%longName) - tnam = TRIM(dn)//'wet_con'; o_dtr_wet_con (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) + tnam = TRIM(dn)//'wet_cv'; o_dtr_wet_cv (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) + lnam = 'tracer total wet deposition'//TRIM(tracers(iq)%longName) + tnam = TRIM(dn)//'wet'; o_dtr_wet (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) lnam = 'tracer tendency dry deposition'//TRIM(tracers(iq)%longName) tnam = 'cum'//TRIM(dn)//'dry'; o_dtr_dry (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)]) @@ -636,5 +642,5 @@ ! DO iq=1,nqtot -! IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE +! IF(.NOT.tracers(iq)%isInPhysics) CYCLE ! WRITE(*,'(a,i1,a,10i3)')'trac(',iq,')%flag = ',o_trac(iq)%flag ! WRITE(*,'(a,i1,a)')'trac(',iq,')%name = '//TRIM(o_trac(iq)%name) Index: LMDZ6/branches/contrails/libf/phylmd/phys_output_var_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/phys_output_var_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/phys_output_var_mod.f90 (revision 5489) @@ -104,10 +104,9 @@ !$OMP THREADPRIVATE(clef_files, clef_stations, lev_files,nid_files,nnid_files) INTEGER, DIMENSION(nfiles), SAVE :: nnhorim - INTEGER, DIMENSION(nfiles), SAVE :: nhorim, nvertm INTEGER, DIMENSION(nfiles), SAVE :: nvertap, nvertbp, nvertAlt REAL, DIMENSION(nfiles), SAVE :: zoutm CHARACTER(LEN=20), DIMENSION(nfiles), SAVE :: type_ecri - !$OMP THREADPRIVATE(nnhorim, nhorim, nvertm, zoutm,type_ecri) + !$OMP THREADPRIVATE(nnhorim,nhorim,nvertm,nvertap,nvertbp,nvertAlt,zoutm,type_ecri) CHARACTER(LEN=20), DIMENSION(nfiles), SAVE :: type_ecri_files, phys_out_filetypes !$OMP THREADPRIVATE(type_ecri_files, phys_out_filetypes) Index: LMDZ6/branches/contrails/libf/phylmd/phys_output_write_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/phys_output_write_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/phys_output_write_mod.F90 (revision 5489) @@ -6,5 +6,6 @@ USE phytrac_mod, ONLY : d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, & d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls, & - d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, flux_tr_wet, flux_tr_dry + d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, & + flux_tr_wet_cv, flux_tr_wet, flux_tr_dry ! Author: Abderrahmane IDELKADI (original include file) @@ -48,5 +49,6 @@ o_psol, o_mass, o_qsurf, o_qsol, & o_precip, o_rain_fall, o_rain_con, o_ndayrain, o_plul, o_pluc, o_plun, & - o_snow, o_msnow, o_fsnow, o_evap, o_snowerosion, o_ustart_lic, o_qsalt_lic, o_rhosnow_lic, o_bsfall, & + o_snow, o_msnow, o_fsnow, o_evap, o_snowerosion, o_ustart_lic, o_qsalt_lic, o_rhosnow_lic, o_bsfall, & + o_icesub_lic, & o_ep,o_epmax_diag, & ! epmax_cape o_tops, o_tops0, o_topl, o_topl0, & @@ -189,5 +191,5 @@ o_dtr_insc, o_dtr_bcscav, o_dtr_evapls, & o_dtr_ls, o_dtr_trsp, o_dtr_sscav, o_dtr_dry, & - o_dtr_sat, o_dtr_uscav, o_dtr_wet_con, & + o_dtr_sat, o_dtr_uscav, o_dtr_wet_cv, o_dtr_wet, & o_trac_cum, o_du_gwd_rando, o_dv_gwd_rando, & o_ustr_gwd_hines,o_vstr_gwd_hines,o_ustr_gwd_rando,o_vstr_gwd_rando, & @@ -317,5 +319,5 @@ USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, & zn2mout, t2m_min_mon, t2m_max_mon, evap, & - snowerosion, zxustartlic, zxrhoslic, zxqsaltlic, & + snowerosion, icesub_lic, zxustartlic, zxrhoslic, zxqsaltlic, & l_mixmin,l_mix, pbl_eps, tke_shear, tke_buoy, tke_trans, & zu10m, zv10m, zq2m, zustar, zxqsurf, & @@ -916,4 +918,5 @@ CALL histwrite_phy(o_fsnow, zfra_o) CALL histwrite_phy(o_evap, evap) + CALL histwrite_phy(o_icesub_lic, icesub_lic) IF (ok_bs) THEN @@ -2863,5 +2866,6 @@ CALL histwrite_phy(o_dtr_uscav(itr),d_tr_uscav(:,:,itr)) !--2D fields - CALL histwrite_phy(o_dtr_wet_con(itr), flux_tr_wet(:,itr)) + CALL histwrite_phy(o_dtr_wet_cv(itr), flux_tr_wet_cv(:,itr)) + CALL histwrite_phy(o_dtr_wet(itr), flux_tr_wet(:,itr)) CALL histwrite_phy(o_dtr_dry(itr), flux_tr_dry(:,itr)) zx_tmp_fi2d=0. Index: LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90 (revision 5489) @@ -39,5 +39,5 @@ USE ioipsl_getin_p_mod, ONLY : getin_p USE indice_sol_mod - USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, addPhase + USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, addPhase, ivap, iliq, isol, ibs, icf, irvc, ircont USE strings_mod, ONLY: strIdx USE iophy @@ -78,5 +78,5 @@ USE lmdz_lscp, ONLY : lscp USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop - USE lmdz_lscp_old, ONLY : fisrtilp + USE lmdz_lscp_old, ONLY : fisrtilp, fisrtilp_first USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim USE lmdz_wake_ini, ONLY : wake_ini @@ -248,5 +248,5 @@ cldh, cldl,cldm, cldq, cldt, & JrNt, & - dthmin, evap, snowerosion,fder, plcl, plfc, & + dthmin, evap, snowerosion, icesub_lic, fder, plcl, plfc, & prw, prlw, prsw, prbsw, water_budget, & s_lcl, s_pblh, s_pblt, s_therm, & @@ -376,4 +376,5 @@ USE phys_output_write_spl_mod, ONLY: phys_output_write_spl USE phytracr_spl_mod, ONLY: phytracr_spl_out_init, phytracr_spl + USE s2s, ONLY : s2s_initialize IMPLICIT NONE !>====================================================================== @@ -512,8 +513,4 @@ !====================================================================== ! - ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional) - INTEGER,SAVE :: ivap, iliq, isol, ibs, icf, irvc, ircont -!$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc, ircont) - ! ! ! Variables argument: @@ -1021,5 +1018,5 @@ REAL picefra(klon,klev) - REAL zrel_oro(klon) + REAL nm_oro(klon) !IM cf. AM 081204 END ! @@ -1096,5 +1093,5 @@ CHARACTER*80 abort_message LOGICAL, SAVE :: ok_sync, ok_sync_omp - !$OMP THREADPRIVATE(ok_sync) + !$OMP THREADPRIVATE(ok_sync,ok_sync_omp) REAL date0 @@ -1106,5 +1103,4 @@ REAL ztsol(klon) REAL q2m(klon,nbsrf) ! humidite a 2m - REAL fsnowerosion(klon,nbsrf) ! blowing snow flux at surface REAL qbsfra ! blowing snow fraction !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels @@ -1270,7 +1266,7 @@ ! Subgrid scale wind : ! Need to be allocatable/save because the number of bin is not known (provided by surf_wind_ini) - integer, save :: nsrfwnd=1 + integer, save :: nsurfwind=1 real, dimension(:,:), allocatable, save :: surf_wind_value, surf_wind_proba ! module and probability of sugrdi wind wind sample - !$OMP THREADPRIVATE(nsrfwnd,surf_wind_value, surf_wind_proba) + !$OMP THREADPRIVATE(nsurfwind,surf_wind_value, surf_wind_proba) @@ -1352,11 +1348,7 @@ IF (first) THEN - ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g')) - iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) - isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) - ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) - icf = strIdx(tracers(:)%name, addPhase('H2O', 'f')) - irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c')) - ircont = strIdx(tracers(:)%name, addPhase('H2O', 'a')) + + CALL s2s_initialize ! initialization of source to source tools + ! CALL init_etat0_limit_unstruct ! IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) @@ -1841,8 +1833,9 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CALL surf_wind_ini(klon,lunout) - CALL getin_p('nsrfwnd',nsrfwnd) - allocate(surf_wind_value(klon,nsrfwnd),surf_wind_proba(klon,nsrfwnd)) + CALL getin_p('nsurfwind',nsurfwind) + allocate(surf_wind_value(klon,nsurfwind),surf_wind_proba(klon,nsurfwind)) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + CALL iophys_ini(pdtphys,nsurfwind) ! replay automatic include ! replay automatic include CALL wake_ini(rg,rd,rv,prt_level) CALL yamada_ini(klon,lunout,prt_level) @@ -2917,8 +2910,5 @@ cdragh, cdragm, u1, v1, & beta_aridity, & - !albedo SB >>> - ! albsol1, albsol2, sens, evap, & - albsol_dir, albsol_dif, sens, evap, snowerosion, & - !albedo SB <<< + albsol_dir, albsol_dif, sens, evap, snowerosion, icesub_lic, & albsol3_lic,runoff, snowhgt, qsnow, to_ice, sissnow, & zxtsol, zxfluxlat, zt2m, qsat2m, zn2mout, & @@ -3736,15 +3726,23 @@ ! poches, la tendance moyenne associ\'ee doit etre ! multipliee par la fraction surfacique qu'ils couvrent. + IF (mod(iflag_pbl_split/10,10) == 1) THEN + ! On tient compte du splitting pour modifier les profils deltatq/T des poches + DO k=1,klev + DO i=1,klon + d_deltat_the(i,k) = - d_t_ajs(i,k) + d_deltaq_the(i,k) = - d_q_ajs(i,k) + ENDDO + ENDDO + ELSE + d_deltat_the(:,:) = 0. + d_deltaq_the(:,:) = 0. + ENDIF + DO k=1,klev DO i=1,klon - ! - d_deltat_the(i,k) = - d_t_ajs(i,k) - d_deltaq_the(i,k) = - d_q_ajs(i,k) - ! d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i)) d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i)) d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i)) d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i)) - ! ENDDO ENDDO @@ -3837,5 +3835,5 @@ !=================================================================== ! Computation of subrgid scale near-surface wind distribution - call surf_wind(klon,nsrfwnd,u10m,v10m,wake_s,wake_Cstar,ustar,wstar,surf_wind_value,surf_wind_proba) + call surf_wind(klon,nsurfwind,u10m,v10m,wake_s,wake_Cstar,ustar,wstar,surf_wind_value,surf_wind_proba) !=================================================================== @@ -3924,5 +3922,6 @@ ELSE - + + CALL fisrtilp_first(klon, klev, phys_tstep, pfrac_impa, pfrac_nucl, pfrac_1nucl) CALL fisrtilp(klon,klev,phys_tstep,paprs,pplay, & t_seri, q_seri,ptconv,ratqs,sigma_qtherm, & @@ -4859,4 +4858,15 @@ ! a l'echelle sous-maille: ! + + ! calculation of nm_oro + DO i=1,klon + ! nm_oro is a proxy for the number of subgrid scale mountains + ! -> condition on nm_oro can deactivate the lifting on tilted planar terrains + ! such as ice sheets (work by V. Wiener) + ! in such a case, the SSO scheme should activate only where nm_oro>0 i.e. by setting + ! nm_oro_t=0. + 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. + ENDDO + IF (prt_level .GE.10) THEN print *,' call orography ? ', ok_orodr @@ -4869,11 +4879,7 @@ DO i=1,klon itest(i)=0 - zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) - !zrel_oro: relative mountain height wrt relief explained by mean slope - ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains - ! such as ice sheets (work by V. Wiener) ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to ! earn computation time but they are not physical. - IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN + 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 itest(i)=1 igwd=igwd+1 @@ -4924,9 +4930,5 @@ DO i=1,klon itest(i)=0 - !zrel_oro: relative mountain height wrt relief explained by mean slope - ! -> condition on zrel_oro can deactivate the lifting on tilted planar terrains - ! such as ice sheets (work by V. Wiener) - zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) - IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN + IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN itest(i)=1 igwd=igwd+1 @@ -5169,5 +5171,5 @@ ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! - IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN + IF ((zstd(i).GT.1.0) .AND.(nm_oro(i).GT.nm_oro_t)) THEN itest(i)=1 igwd=igwd+1 @@ -5181,5 +5183,5 @@ DO i=1,klon itest(i)=0 - IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN + 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 itest(i)=1 igwd=igwd+1 Index: LMDZ6/branches/contrails/libf/phylmd/phystokenc_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/phystokenc_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/phystokenc_mod.f90 (revision 5489) @@ -142,5 +142,6 @@ REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: upwd REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: dnwd - +!$OMP THREADPRIVATE(sh,da,phi,mp,upwd,dnwd) + REAL, SAVE :: dtcum INTEGER, SAVE:: iadvtr=0 Index: LMDZ6/branches/contrails/libf/phylmd/phytrac_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/phytrac_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/phytrac_mod.f90 (revision 5489) @@ -35,5 +35,6 @@ REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav - REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: flux_tr_wet ! tracer wet deposit (surface) jyg + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: flux_tr_wet ! tracer wet deposit (surface) jyg + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: flux_tr_wet_cv ! tracer convective wet deposit (surface) jyg REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra dans pluie,air descente insaturee REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel @@ -48,5 +49,6 @@ !$OMP THREADPRIVATE(qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa,d_tr_lessi_nucl) -!$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet,qPr,qDi) +!$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav) +!$OMP THREADPRIVATE(flux_tr_wet,flux_tr_wet_cv,qPr,qDi) !$OMP THREADPRIVATE(d_tr_insc,d_tr_bcscav,d_tr_evapls,d_tr_ls,qPrls) !$OMP THREADPRIVATE(d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv) @@ -69,5 +71,5 @@ ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr)) ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr)) - ALLOCATE(flux_tr_wet(klon,nbtr)) + ALLOCATE(flux_tr_wet(klon,nbtr),flux_tr_wet_cv(klon,nbtr)) ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr)) ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr)) @@ -411,4 +413,5 @@ flux_tr_dry(i,it)=0. flux_tr_wet(i,it)=0. + flux_tr_wet_cv(i,it)=0. ENDDO ENDDO @@ -700,12 +703,12 @@ !--with the full array tr_seri even if only item it is processed - CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep, & - sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, & - pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, & - paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, & - ccntrAA_3d,ccntrENV_3d,coefcoli_3d, & - d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet, & - qDi,qPr, & - qPa,qMel,qTrdi,dtrcvMA,Mint, & + CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep, & + sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, & + pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, & + paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, & + ccntrAA_3d,ccntrENV_3d,coefcoli_3d, & + d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,flux_tr_wet_cv, & + qDi,qPr, & + qPa,qMel,qTrdi,dtrcvMA,Mint, & zmfd1a,zmfphi2,zmfdam) @@ -923,4 +926,10 @@ beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc,d_tr_bcscav,d_tr_evapls,qPrls) + !total wet deposit = large scale wet deposit + convective wet deposit + DO i = 1, klon + flux_tr_wet(i, it) = flux_tr_wet_cv(i, it) + & + qPrls(i, it)*(prfl(i, 1)+psfl(i, 1))*pdtphys + ENDDO ! i = 1, klon + !large scale scavenging tendency DO k = 1, klev Index: LMDZ6/branches/contrails/libf/phylmd/readaerosol_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/readaerosol_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/readaerosol_mod.f90 (revision 5489) @@ -4,5 +4,5 @@ REAL, SAVE :: not_valid=-333. - +!$OMP THREADPRIVATE(not_valid) INTEGER, SAVE :: nbp_lon_src !$OMP THREADPRIVATE(nbp_lon_src) @@ -10,4 +10,5 @@ !$OMP THREADPRIVATE(nbp_lat_src) REAL, ALLOCATABLE, SAVE :: psurf_interp(:,:) +!$OMP THREADPRIVATE(psurf_interp) CONTAINS Index: LMDZ6/branches/contrails/libf/phylmd/s2s.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/s2s.F90 (revision 5489) +++ LMDZ6/branches/contrails/libf/phylmd/s2s.F90 (revision 5489) @@ -0,0 +1,20 @@ +#ifdef CPP_GPUM + MODULE s2s + USE s2s_mod + END MODULE s2s +#else + +! s2s wrapper + MODULE s2s + + PRIVATE + PUBLIC s2s_initialize + + CONTAINS + + SUBROUTINE s2s_initialize() + END SUBROUTINE s2s_initialize + + END MODULE s2s + +#endif Index: LMDZ6/branches/contrails/libf/phylmd/surf_land_bucket_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/surf_land_bucket_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/surf_land_bucket_mod.F90 (revision 5489) @@ -102,5 +102,5 @@ REAL, DIMENSION(klon) :: soilcap, soilflux REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol - REAL, DIMENSION(klon) :: alb_neig, alb_lim + REAL, DIMENSION(klon) :: alb_neig, alb_lim, icesub REAL, DIMENSION(klon) :: zfra REAL, DIMENSION(klon) :: radsol ! total net radiance at surface @@ -239,5 +239,5 @@ CALL fonte_neige( knon, is_ter, knindex, dtime, & tsurf, precip_rain, precip_snow, & - snow, qsol, tsurf_new, evap & + snow, qsol, tsurf_new, evap, icesub & #ifdef ISO & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & Index: LMDZ6/branches/contrails/libf/phylmd/surf_landice_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/surf_landice_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/surf_landice_mod.F90 (revision 5489) @@ -18,5 +18,5 @@ ps, u1, v1, gustiness, rugoro, pctsrf, & snow, qsurf, qsol, qbs1, agesno, & - tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, fluxbs, & + tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, icesub_lic, fluxsens, fluxlat, fluxbs, & tsurf_new, dflux_s, dflux_l, & alt, slope, cloudf, & @@ -48,8 +48,7 @@ #endif -!FC USE clesphys_mod_h USE yomcst_mod_h -USE ioipsl_getin_p_mod, ONLY : getin_p + USE ioipsl_getin_p_mod, ONLY : getin_p USE lmdz_blowing_snow_ini, ONLY : c_esalt_bs, zeta_bs, pbst_bs, prt_bs, rhoice_bs, rhohard_bs USE lmdz_blowing_snow_ini, ONLY : rhofresh_bs, tau_eqsalt_bs, tau_dens0_bs, tau_densmin_bs @@ -60,5 +59,4 @@ USE dimsoil_mod_h, ONLY: nsoilmx -! INCLUDE "indicesol.h" @@ -121,5 +119,5 @@ REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir,alb_dif !albedo SB <<< - REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat + REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat, icesub_lic REAL, DIMENSION(klon), INTENT(OUT) :: fluxbs REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new @@ -135,6 +133,4 @@ #ifdef ISO REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap -! real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de -! fonte_neige #endif @@ -163,5 +159,4 @@ REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec REAL, DIMENSION(klon) :: snow_prec,qsol_prec -! real, DIMENSION(klon) :: run_off_lic_0_diag #endif @@ -257,4 +252,5 @@ ! landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ... ! landice_opt = 1 : prepare and call INterace Lmdz SISvat (INLANDSIS) +! landice_opt = 2 : skip surf_landice and use orchidee over all land surfaces !**************************************************************************************** @@ -375,6 +371,4 @@ ! !**************************************************************************************** -! beta(:) = 1.0 -! dif_grnd(:) = 0.0 ! Suppose zero surface speed @@ -393,5 +387,4 @@ #ifdef ISO #ifdef ISOVERIF - !write(*,*) 'surf_land_ice 1499' DO i=1,knon IF (iso_eau > 0) THEN @@ -427,12 +420,4 @@ ! !**************************************************************************************** - -! -!IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux" -! alb1(1 : knon) = 0.6 !IM cf FH/GK -! alb1(1 : knon) = 0.82 -! alb1(1 : knon) = 0.77 !211003 Ksta0.77 -! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5 -!IM: KstaTER0.77 & LMD_ARMIP6 ! Attantion: alb1 and alb2 are not the same! @@ -622,5 +607,5 @@ CALL fonte_neige(knon, is_lic, knindex, dtime, & tsurf, precip_rain, precip_totsnow, & - snow, qsol, tsurf_new, evap_totsnow & + snow, qsol, tsurf_new, evap_totsnow, icesub_lic & #ifdef ISO & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & Index: LMDZ6/branches/contrails/libf/phylmd/traclmdz_mod.f90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/traclmdz_mod.f90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/traclmdz_mod.f90 (revision 5489) @@ -261,5 +261,5 @@ it = 0 DO iq = 1, nqtot - IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE + IF(.NOT.tracers(iq)%isInPhysics) CYCLE it = it+1 ! Test if tracer is zero everywhere. @@ -310,5 +310,5 @@ USE yomcst_mod_h -USE dimphy + USE dimphy USE infotrac_phy, ONLY: nbtr, pbl_flg USE strings_mod, ONLY: int2str Index: LMDZ6/branches/contrails/libf/phylmd/yamada_c.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmd/yamada_c.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmd/yamada_c.F90 (revision 5489) @@ -138,19 +138,8 @@ CALL getin_p('iflag_tke_diff',iflag_tke_diff) allocate(l0(klon)) -#define IOPHYS -#ifdef IOPHYS -! call iophys_ini(timestep) -#endif firstcall=.false. endif IF (ngrid<=0) RETURN ! Bizarre : on n a pas ce probeleme pour coef_diff_turb - -#ifdef IOPHYS -if (okiophys) then -call iophys_ecrit('q2i',klev,'q2 debut my','m2/s2',q2(:,1:klev)) -call iophys_ecrit('kmi',klev,'Kz debut my','m/s2',km(:,1:klev)) -endif -#endif nlay=klev Index: LMDZ6/branches/contrails/libf/phylmdiso/phyetat0_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmdiso/phyetat0_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmdiso/phyetat0_mod.F90 (revision 5489) @@ -549,5 +549,5 @@ it = 0 DO iq = 1, nqtot - IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE + IF(.NOT.tracers(iq)%isInPhysics) CYCLE it = it+1 tname = tracers(iq)%name Index: LMDZ6/branches/contrails/libf/phylmdiso/phyredem.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmdiso/phyredem.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmdiso/phyredem.F90 (revision 5489) @@ -370,5 +370,5 @@ it = 0 DO iq = 1, nqtot - IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE + IF(.NOT.tracers(iq)%isInPhysics) CYCLE it = it+1 CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it)) Index: LMDZ6/branches/contrails/libf/phylmdiso/physiq_mod.F90 =================================================================== --- LMDZ6/branches/contrails/libf/phylmdiso/physiq_mod.F90 (revision 5488) +++ LMDZ6/branches/contrails/libf/phylmdiso/physiq_mod.F90 (revision 5489) @@ -39,5 +39,5 @@ USE ioipsl_getin_p_mod, ONLY : getin_p USE indice_sol_mod - USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,addPhase, ivap, iliq, isol + USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,addPhase, ivap, iliq, isol, ibs, icf, irvc USE strings_mod, ONLY: strIdx USE iophy @@ -579,14 +579,4 @@ !====================================================================== ! - ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional) -! INTEGER,SAVE :: ivap, iliq, isol, irneb, ibs -!!$OMP THREADPRIVATE(ivap, iliq, isol, irneb, ibs) -! Camille Risi 25 juillet 2023: ivap,iliq,isol deja definis dans infotrac_phy. -! Et ils sont utiles ailleurs que dans physiq_mod (ex: -! reevap -> je commente les 2 lignes au dessus et je laisse la definition -! plutot dans infotrac_phy - INTEGER,SAVE :: irneb, ibs, icf,irvc -!$OMP THREADPRIVATE(irneb, ibs, icf,irvc) -! ! ! Variables argument: @@ -1121,5 +1111,5 @@ REAL picefra(klon,klev) - REAL zrel_oro(klon) + REAL nm_oro(klon) !IM cf. AM 081204 END ! @@ -1459,10 +1449,4 @@ IF (first) THEN - ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g')) - iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) - isol = strIdx(tracers(:)%name, addPhase('H2O', 's')) - ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b')) - icf = strIdx(tracers(:)%name, addPhase('H2O', 'f')) - irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c')) ! CALL init_etat0_limit_unstruct IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) @@ -6283,8 +6267,19 @@ ! a l'echelle sous-maille: ! + + ! calculation of nm_oro + DO i=1,klon + ! nm_oro is a proxy for the number of subgrid scale mountains + ! -> condition on nm_oro can deactivate the lifting on tilted planar terrains + ! such as ice sheets (work by V. Wiener) + ! in such a case, the SSO scheme should activate only where nm_oro>0 i.e. by setting + ! nm_oro_t=0. + 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. + END DO + IF (prt_level .GE.10) THEN print *,' call orography ? ', ok_orodr ENDIF - ! + IF (ok_orodr) THEN ! @@ -6293,11 +6288,7 @@ DO i=1,klon itest(i)=0 - zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) - !zrel_oro: relative mountain height wrt relief explained by mean slope - ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains - ! such as ice sheets (work by V. Wiener) ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to ! earn computation time but they are not physical. - IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN + 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 itest(i)=1 igwd=igwd+1 @@ -6352,9 +6343,5 @@ DO i=1,klon itest(i)=0 - !zrel_oro: relative mountain height wrt relief explained by mean slope - ! -> condition on zrel_oro can deactivate the lifting on tilted planar terrains - ! such as ice sheets (work by V. Wiener) - zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) - IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN + IF (((zpic(i)-zmea(i)).GT.zpmm_orolf_t).AND.(nm_oro(i).GT.nm_oro_t)) THEN itest(i)=1 igwd=igwd+1 @@ -6630,5 +6617,5 @@ ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! - IF ((zstd(i).GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN + IF ((zstd(i).GT.1.0) .AND.(nm_oro(i).GT.nm_oro_t)) THEN itest(i)=1 igwd=igwd+1 @@ -6642,5 +6629,5 @@ DO i=1,klon itest(i)=0 - IF (((zpic(i)-zmea(i)).GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN + 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 itest(i)=1 igwd=igwd+1