MODULE init_testphys1d_mod implicit none contains SUBROUTINE init_testphys1d(start1Dname,startfiname,therestart1D,therestartfi,ngrid,nlayer,odpref, & nq,q,time,psurf,u,v,temp,ndt,ptif,pks,dttestphys,zqsat,dq,dqdyn,day0,day,gru,grv,w, & play,plev,latitude,longitude,cell_area,ctrl_h2ovap,relaxtime_h2ovap,qref_h2ovap, & ctrl_h2oice,relaxtime_h2oice,qref_h2oice) use ioipsl_getincom, only: getin ! To use 'getin' use comcstfi_h, only: pi, rad, omeg, g, mugaz, rcp, r, cpp use time_phylmdz_mod, only: daysec, steps_per_sol, outputs_per_sol, iphysiq use planete_h, only: year_day, periheli, aphelie, peri_day, obliquit, emin_turb, lmixmin use surfdat_h, only: albedodat, z0_default, z0, emissiv, emisice, albedice, iceradius, dtemisice, & zmea, zstd, zsig, zgam, zthe, hmons, summit, base, phisfi, watercaptag, watercap, & tsurf, emis, qsurf, perennial_co2ice, ini_surfdat_h_slope_var, end_surfdat_h_slope_var use infotrac, only: nqtot, tname, nqperes, nqfils use read_profile_mod, only: read_profile use profile_temp_mod, only: profile_temp use iostart, only: open_startphy, get_var, close_startphy use physics_distribution_mod, only: init_physics_distribution use comsoil_h, only: volcapa, nsoilmx, inertiesoil, inertiedat, layer, mlayer, flux_geo, tsoil, & adsorption_soil, qsoil, igcm_h2o_ice_soil, porosity_reg, & ini_comsoil_h_slope_var, end_comsoil_h_slope_var, ads_massive_ice use comvert_mod, only: ap, bp, aps, bps, pa, preff, presnivs, pseudoalt, scaleheight use dimradmars_mod, only: tauvis, totcloudfrac, albedo, ini_dimradmars_mod_slope_var, end_dimradmars_mod_slope_var use regular_lonlat_mod, only: init_regular_lonlat use mod_interface_dyn_phys, only: init_interface_dyn_phys use geometry_mod, only: init_geometry, init_geometry_cell_area_for_outputs use dimphy, only: init_dimphy use comgeomfi_h, only: sinlat, ini_fillgeom use slope_mod, only: theta_sl, psi_sl use comslope_mod, only: def_slope, subslope_dist use dust_param_mod, only: tauscaling use tracer_mod, only: igcm_co2 use logic_mod, only: hybrid use vertical_layers_mod, only: init_vertical_layers use inichim_newstart_mod, only: inichim_newstart use mod_grid_phy_lmdz, only: regular_lonlat use phys_state_var_init_mod, only: phys_state_var_init use turb_mod, only: q2 use nonoro_gwd_ran_mod, only: du_nonoro_gwd, dv_nonoro_gwd use conf_phys_mod, only: conf_phys use paleoclimate_mod, only: paleoclimate, ini_paleoclimate_h, end_paleoclimate_h, h2o_ice_depth use comslope_mod, only: nslope, subslope_dist, ini_comslope_h, end_comslope_h use co2condens_mod, only: CO2cond_ps use callkeys_mod, only: water, photochem, callthermos use call_dayperi_mod, only: call_dayperi use initracer_mod, only: initracer ! Mostly for XIOS outputs: use mod_const_mpi, only: COMM_LMDZ implicit none include "dimensions.h" !======================================================================= ! Arguments !======================================================================= integer, intent(in) :: ngrid, nlayer real, intent(in) :: odpref ! DOD reference pressure (Pa) character(*), intent(in) :: start1Dname, startfiname ! Name of starting files for 1D logical, intent(in) :: therestart1D, therestartfi ! Use of starting files for 1D integer, intent(inout) :: nq real, dimension(:,:,:), allocatable, intent(out) :: q ! tracer mixing ratio (e.g. kg/kg) real, intent(out) :: time ! time (0=1!" error stop endif endif ! Allocate arrays allocate(tname(nq),q(1,nlayer,nq),zqsat(nlayer)) allocate(dq(1,nlayer,nq),dqdyn(1,nlayer,nq),tnom_transp(nq)) ! Read tracer names from file traceur.def do iq = 1,nq read(90,'(80a)',iostat = ierr) line ! store the line from traceur.def if (ierr /= 0) then error stop 'init_testphys1d: error reading tracer names...' endif ! if format is tnom_0, tnom_transp (isotopes) read(line,*,iostat = ierr0) tname(iq),tnom_transp(iq) if (ierr0 /= 0) then read(line,*) tname(iq) tnom_transp(iq) = 'air' endif enddo close(90) ! Isotopes: as in the 3D case we have to determine father/son relations for isotopes and carrying fluid allocate(nqfils(nqtot)) nqperes = 0 nqfils = 0 do iq = 1,nqtot if (tnom_transp(iq) == 'air') then ! ceci est un traceur père write(*,*) 'Le traceur',iq,', appele ',trim(tname(iq)),', est un pere' nqperes = nqperes + 1 else !if (tnom_transp(iq) == 'air') then ! ceci est un fils. Qui est son père? write(*,*) 'Le traceur',iq,', appele ',trim(tname(iq)),', est un fils' continu = .true. ipere = 1 do while (continu) if (tnom_transp(iq) == tname(ipere)) then ! Son père est ipere write(*,*) 'Le traceur',iq,'appele ',trim(tname(iq)),' est le fils de ',ipere,'appele ',trim(tname(ipere)) nqfils(ipere) = nqfils(ipere) + 1 continu = .false. else !if (tnom_transp(iq) == tnom_0(ipere)) then ipere = ipere + 1 if (ipere > nqtot) then write(*,*) 'Le traceur',iq,'appele ',trim(tname(iq)),', est orpelin.' call abort_gcm('infotrac_init','Un traceur est orphelin',1) endif !if (ipere > nqtot) then endif !if (tnom_transp(iq) == tnom_0(ipere)) then enddo !do while (continu) endif !if (tnom_transp(iq) == 'air') then enddo !do iq=1,nqtot write(*,*) 'nqperes=',nqperes write(*,*) 'nqfils=',nqfils #ifdef CPP_XIOS call init_physics_distribution(regular_lonlat,4,1,1,1,nlayer,COMM_LMDZ) #else call init_physics_distribution(regular_lonlat,4,1,1,1,nlayer,1) #endif ! Date and local time at beginning of run ! --------------------------------------- if (.not. therestartfi) then ! Date (in sols since spring solstice) at beginning of run day0 = 0 ! default value for day0 write(*,*) 'Initial date (in martian sols; =0 at Ls=0)?' call getin("day0",day0) day = float(day0) write(*,*) " day0 = ",day0 ! Local time at beginning of run time = 0 ! default value for time write(*,*)'Initial local time (in hours, between 0 and 24)?' call getin("time",time) write(*,*)" time = ",time time = time/24. ! convert time (hours) to fraction of sol else call open_startphy(trim(startfiname)) call get_var("controle",tab_cntrl,found) if (.not. found) then call abort_physic("open_startphy","tabfi: Failed reading array",1) else write(*,*)'tabfi: tab_cntrl',tab_cntrl endif day0 = tab_cntrl(3) day = float(day0) call get_var("Time",time,found) call close_startphy endif !(.not. therestartfi) ! Discretization (Definition of grid and time steps) ! -------------------------------------------------- nlevel = nlayer + 1 nsoil = nsoilmx steps_per_sol = 48 ! Default value for day_step (old name for steps_per_sol) write(*,*)'Number of time steps per sol?' call getin("day_step",steps_per_sol) write(*,*) " steps_per_sol (aka day_step) = ",steps_per_sol outputs_per_sol = steps_per_sol ! Default value for outputs_per_sol ndt = 10 ! Default value for ndt write(*,*)'Number of sols to run?' call getin("ndt",ndt) write(*,*) " ndt = ",ndt dayn = day0 + ndt ndt = ndt*steps_per_sol dttestphys = daysec/steps_per_sol ! Imposed surface pressure ! ------------------------ psurf = 610. ! Default value for psurf write(*,*) 'Surface pressure (Pa)?' if (.not. therestart1D) then call getin("psurf",psurf) else open(3,file = trim(start1Dname),status = "old",action = "read") read(3,*) header, psurf endif write(*,*) " psurf = ",psurf ! Compute pressures and altitudes of atmospheric levels ! ----------------------------------------------------- ! Vertical Coordinates ! """""""""""""""""""" hybrid = .true. write(*,*)'Hybrid coordinates?' call getin("hybrid",hybrid) write(*,*) " hybrid = ", hybrid ! Reference pressures pa = 20. ! Transition pressure (for hybrid coord.) preff = 610. ! Reference surface pressure call disvert_noterre ! Now that disvert has been called, initialize module vertical_layers_mod call init_vertical_layers(nlayer,preff,scaleheight,ap,bp,aps,bps,presnivs,pseudoalt) plev = ap + psurf*bp play = aps + psurf*bps zlay = -200.*r*log(play/plev(1))/g ! Coefficient to control the surface pressure change ! To be defined in "callphys.def" so that the PEM can read it asa well ! If CO2cond_ps = 0, surface pressure is kept constant; If CO2cond_ps = 1, surface pressure varies normally ! CO2cond_ps = 300*400/144.37e6 = 8.31e-4 (ratio of polar cap surface over planetary surface) is a typical value for tests ! -------------------------------------------------------------------- CO2cond_ps = 1. ! Default value write(*,*) 'Coefficient to control the surface pressure change?' call getin("CO2cond_ps",CO2cond_ps) if (CO2cond_ps < 0. .or. CO2cond_ps > 1.) then write(*,*) 'Value for ''CO2cond_ps'' is not between 0 and 1.' error stop 'Please, specify a correct value!' endif ! Aerosol properties ! ------------------ tauvis = 0.2 ! Default value for tauvis (dust opacity) write(*,'("Reference dust opacity at ",f4.0," Pa?")') odpref call getin("tauvis",tauvis) write(*,*) " tauvis =",tauvis ! Orbital parameters ! ------------------ if (.not. therestartfi) then paleomars = .false. ! Default: no water ice reservoir call getin("paleomars",paleomars) write(*,*) "paleomars=", paleomars if (paleomars) then write(*,*) "Orbital parameters taken from callphys.def" write(*,*)'Obliquity?' call getin("obliquit",obliquit) write(*,*) " obliquit =",obliquit write(*,*) 'Eccentricity (0 0) then iref = 1 ! ice/regolith boundary index if (ice_depth < layer(1)) then inertiedat(1,1) = sqrt(layer(1)/((ice_depth/inertiedat(1,1)**2) + ((layer(1) - ice_depth)/inertieice**2))) inertiedat(1,2:) = inertieice if(adsorption_soil) then ! add subsurface ice in qsoil if one runs with adsorption if(ads_massive_ice) then qsoil(1,1,igcm_h2o_ice_soil,:) = (ice_depth-layer(2))/(layer(1) - layer(2))*rho_H2O_ice ! assume no porosity in the ice qsoil(1,2:,igcm_h2o_ice_soil,:) = rho_H2O_ice else qsoil(1,1,igcm_h2o_ice_soil,:) = (ice_depth-layer(2))/(layer(1) - layer(2))*porosity_reg*rho_H2O_ice qsoil(1,2:,igcm_h2o_ice_soil,:) = porosity_reg*rho_H2O_ice endif endif else ! searching for the ice/regolith boundary: do isoil = 1,nsoil if ((ice_depth >= layer(isoil)) .and. (ice_depth < layer(isoil + 1))) then iref = isoil + 1 exit endif enddo ! We then change the soil inertia table: inertiedat(1,:iref - 1) = inertiedat(1,1) ! We compute the transition in layer(iref) inertiedat(1,iref) = sqrt((layer(iref) - layer(iref - 1))/(((ice_depth - layer(iref - 1))/inertiedat(1,1)**2) + ((layer(iref) - ice_depth)/inertieice**2))) ! Finally, we compute the underlying ice: inertiedat(1,iref + 1:) = inertieice if(adsorption_soil) then ! add subsurface ice in qsoil if one runs with adsorption qsoil(1,:iref - 1,igcm_h2o_ice_soil,:) = 0. if(ads_massive_ice) then qsoil(1,iref+1:,igcm_h2o_ice_soil,:) = rho_H2O_ice qsoil(1,iref,igcm_h2o_ice_soil,:) = (ice_depth-layer(iref))/(layer(iref-1) - layer(iref))*rho_H2O_ice else qsoil(1,iref+1:,igcm_h2o_ice_soil,:) = porosity_reg*rho_H2O_ice qsoil(1,iref,igcm_h2o_ice_soil,:) = (ice_depth-layer(iref))/(layer(iref-1) - layer(iref))*porosity_reg*rho_H2O_ice endif endif endif ! (ice_depth < layer(1)) else ! ice_depth < 0 all is set to surface thermal inertia inertiedat(1,:) = inertiedat(1,1) ! soil thermal inertia endif ! ice_depth > 0 do isoil = 1,nsoil inertiesoil(1,isoil,:) = inertiedat(1,isoil) tsoil(1,isoil,:) = tsurf(1,:) ! soil temperature enddo endif !(.not. therestartfi) ! Initialize subsurface geothermal flux ! ------------------------------------- flux_geo = 0. call getin("flux_geo",flux_geo(1,1)) write(*,*) " flux_geo = ",flux_geo(1,1) flux_geo = flux_geo(1,1) ! Initialize traceurs ! ------------------- if (photochem .or. callthermos) then write(*,*) 'Initializing chemical species' ! flagthermo=0: initialize over all atmospheric layers flagthermo = 0 ! check if "h2o_vap" has already been initialized ! (it has been if there is a "profile_h2o_vap" file around) inquire(file = "profile_h2o_vap",exist = found) if (found) then flagh2o = 0 ! 0: do not initialize h2o_vap else flagh2o = 1 ! 1: initialize h2o_vap in inichim_newstart endif ! hack to accomodate that inichim_newstart assumes that ! q & psurf arrays are on the dynamics scalar grid allocate(qdyn(2,1,llm,nq),psdyn(2,1)) qdyn(1,1,1:llm,1:nq) = q(1,1:llm,1:nq) psdyn(1:2,1) = psurf call inichim_newstart(ngrid,nq,qdyn,qsurf(1,:,1),psdyn,flagh2o,flagthermo) q(1,1:llm,1:nq) = qdyn(1,1,1:llm,1:nq) endif ! Check if the surface is a water ice reservoir ! --------------------------------------------- if (.not. therestartfi) watercap(1,:) = 0 ! Initialize watercap watercaptag(1) = .false. ! Default: no water ice reservoir write(*,*)'Water ice cap on ground?' call getin("watercaptag",watercaptag) write(*,*) " watercaptag = ",watercaptag ! Initialize perennial_co2ice ! --------------------------- if (.not. therestartfi .and. paleoclimate) perennial_co2ice = 0. ! Prescription of atmospheric water vapour/ice profiles ! ---------------------------------------------- ctrl_h2ovap = .false. ; ctrl_h2oice = .false. ! Default: free atmospheric water vapour/ice profiles relaxtime_h2ovap = -1. ; relaxtime_h2oice = -1. ! Default: no time relaxation qref_h2ovap = 0. ; qref_h2oice = 0. ! Default if (water) then write(*,*)'Force atmospheric water vapour profile (mixing ratio in kg/kg)?' call getin('ctrl_h2ovap',ctrl_h2ovap) write(*,*) 'ctrl_h2ovap = ', ctrl_h2ovap if (ctrl_h2ovap) then write(*,*) 'Atmospheric water vapour profile is prescribed' open(10,file = 'profile_ref_h2o_vap',status = 'old',form = 'formatted',action = 'read',iostat = ierr) if (ierr == 0) then do ilayer = 1,nlayer read(10,*,iostat=ierr) qref_h2ovap(ilayer) if (ierr /= 0) error stop 'Not enough atmospheric layers defined in the file "profile_ref_h2o_vap"!' enddo else error stop 'File "profile_ref_h2o_vap" was not found!' endif close(10) write(*,*) 'Relax atmospheric water vapour profile with time constant (s)?' call getin('relaxtime_h2ovap',relaxtime_h2ovap) write(*,*) 'relaxtime_h2ovap = ', relaxtime_h2ovap if (relaxtime_h2ovap < 0.) then write(*,*) 'Atmospheric water vapour profile is not relaxed (forcing).' else write(*,*) 'Atmospheric water vapour profile is relaxed towards the profile in "profile_ref_h2o_vap"' endif else write(*,*) 'Free atmospheric water vapour profile' endif write(*,*)'Force atmospheric water ice profile (mixing ratio in kg/kg)?' call getin('ctrl_h2oice',ctrl_h2oice) write(*,*) 'ctrl_h2oice = ', ctrl_h2oice if (ctrl_h2oice) then write(*,*) 'Atmospheric water ice profile is prescribed' open(10,file = 'profile_ref_h2o_ice',status = 'old',form = 'formatted',action = 'read',iostat = ierr) if (ierr == 0) then do ilayer = 1,nlayer read(10,*,iostat=ierr) qref_h2oice(ilayer) if (ierr /= 0) error stop 'Not enough atmospheric layers defined in the file "profile_ref_h2o_ice"!' enddo else error stop 'File "profile_ref_h2o_ice" was not found!' endif close(10) write(*,*) 'Relax atmospheric water ice profile with time constant (s)?' call getin('relaxtime_h2oice',relaxtime_h2oice) write(*,*) 'relaxtime_h2oice = ', relaxtime_h2oice if (relaxtime_h2oice < 0.) then write(*,*) 'Atmospheric water ice profile is not relaxed (forcing).' else write(*,*) 'Atmospheric water ice profile is relaxed towards the profile in "profile_ref_h2o_ice"' endif else write(*,*) 'Free atmospheric water ice profile' endif endif END SUBROUTINE init_testphys1d END MODULE init_testphys1d_mod