module phyetat0_mod implicit none real, save :: tab_cntrl_mod(100) !$OMP THREADPRIVATE(tab_cntrl_mod) !====================================================================== contains !====================================================================== subroutine phyetat0(fichnom,tab0,Lmodif,nsoil,ngrid,nlay,nq,nqsoil, & day_ini,time0,tsurf,tsoil,albedo,emis,q2,qsurf,qsoil, & tauscaling,totcloudfrac,wstar,watercap,perennial_co2ice, & def_slope,def_slope_mean,subslope_dist) use tracer_mod, only: noms ! tracer names use surfdat_h, only: phisfi, albedodat, z0, z0_default, zmea, zstd, & zsig, zgam, zthe, hmons, summit, base, watercaptag use iostart, only: nid_start, open_startphy, close_startphy, & get_field, get_var, inquire_field, & inquire_dimension, inquire_dimension_length use nonoro_gwd_ran_mod, only: du_nonoro_gwd, dv_nonoro_gwd use nonoro_gwd_mix_mod, only: du_eddymix_gwd, dv_eddymix_gwd, de_eddymix_rto, & df_eddymix_flx, dh_eddymix_gwd, dq_eddymix_gwd use compute_dtau_mod, only: dtau use dust_rad_adjust_mod, only: dust_rad_adjust_prev,dust_rad_adjust_next use dust_param_mod, only: dustscaling_mode use ioipsl_getin_p_mod, only: getin_p use comsoil_h, only: flux_geo use comslope_mod, only: nslope, major_slope use paleoclimate_mod, only: paleoclimate, h2o_ice_depth, lag_co2_ice, d_coef use comcstfi_h, only: pi use geometry_mod, only: latitude implicit none include "callkeys.h" !====================================================================== ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 ! Adaptation � Mars : Yann Wanherdrick ! Objet: Lecture de l etat initial pour la physique ! Modifs: Aug.2010 EM : use NetCDF90 to load variables (enables using ! r4 or r8 restarts independently of having compiled ! the GCM in r4 or r8) ! June 2013 TN : Possibility to read files with a time axis ! November 2013 EM : Enabeling parallel, using iostart module ! March 2020 AD: Enabling initialization of physics without startfi ! flag: startphy_file !====================================================================== integer nbsrf !Mars nbsrf a 1 au lieu de 4 parameter (nbsrf=1) ! nombre de sous-fractions pour une maille !====================================================================== ! Arguments: ! --------- ! inputs: character(*), intent(in) :: fichnom ! "startfi.nc" file integer, intent(in) :: tab0 integer, intent(in) :: Lmodif integer, intent(in) :: nsoil ! # of soil layers integer, intent(in) :: ngrid ! # of atmospheric columns integer, intent(in) :: nlay ! # of atmospheric layers integer, intent(in) :: nq integer, intent(in) :: nqsoil ! # of tracers in the soil integer, intent(inout) :: day_ini real, intent(inout) :: time0 ! outputs: real, intent(out) :: tsurf(ngrid,nslope) ! surface temperature real, intent(out) :: tsoil(ngrid,nsoil,nslope) ! soil temperature real, intent(out) :: albedo(ngrid,2,nslope) ! surface albedo real, intent(out) :: emis(ngrid,nslope) ! surface emissivity real, intent(out) :: q2(ngrid,nlay+1) real, intent(out) :: qsurf(ngrid,nq,nslope) ! tracers on surface real, intent(out) :: qsoil(ngrid,nsoil,nqsoil,nslope) ! tracers in the subsurface real, intent(out) :: tauscaling(ngrid) ! dust conversion factor real, intent(out) :: totcloudfrac(ngrid) ! total cloud fraction real, intent(out) :: wstar(ngrid) ! Max vertical velocity in thermals (m/s) real, intent(out) :: watercap(ngrid,nslope) ! h2o_ice_cover real, intent(out) :: perennial_co2ice(ngrid,nslope) ! perennial co2 ice(kg/m^2) real, intent(out) :: def_slope(nslope+1) ! boundaries for bining of the slopes real, intent(out) :: def_slope_mean(nslope) real, intent(out) :: subslope_dist(ngrid,nslope) ! undermesh statistics !====================================================================== ! Local variables: real :: surffield(ngrid) ! to temporarily store a surface field real :: xmin, xmax ! to display min and max of a field integer :: ig, iq, lmax, islope, nid, nvarid, ierr, i, nsrf, nqold ! integer :: isoil ! integer :: length ! parameter (length=100) character(7) :: str7 character(2) :: str2 character(1) :: yes real :: p_rad, p_omeg, p_g, p_mugaz, p_daysec ! flag which identifies if 'startfi.nc' file is using old names (qsurf01,...) logical :: oldtracernames = .false. integer :: count character(30) :: txt ! to store some text ! specific for time real, allocatable :: time(:) ! times stored in start integer :: timelen ! number of times stored in the file integer :: indextime ! index of selected time integer :: edges(3),corner(3) logical :: found real :: timestart ! to pick which initial state to start from real :: surfemis ! constant emissivity when no startfi real :: surfalbedo ! constant albedo when no startfi real :: watercaptag_tmp(ngrid) ! Sub-grid scale slopes logical :: startphy_slope ! to be retrocompatible and add the nslope dimension real, allocatable :: default_def_slope(:) real :: sum_dist real :: current_max !var to find max distrib slope ! Variables for CO2 index integer :: igcm_co2_tmp character(5) :: modname="phyetat0" !====================================================================== write(*,*) "phyetat0: startphy_file", startphy_file if (startphy_file) then ! open physics initial state file: call open_startphy(fichnom) ! possibility to modify tab_cntrl in tabfi write(*,*) write(*,*) 'TABFI in phyeta0: Lmodif=',Lmodif," tab0=",tab0 call tabfi (nid_start,Lmodif,tab0,day_ini,lmax,p_rad, & p_omeg,p_g,p_mugaz,p_daysec,time0) else ! "academic" initialization of planetary parameters via tabfi call tabfi (0,0,0,day_ini,lmax,p_rad, & p_omeg,p_g,p_mugaz,p_daysec,time0) endif ! of if (startphy_file) if (startphy_file) then call get_var("def_slope",def_slope,found) if (.not. found) then startphy_slope=.false. write(*,*)'slope_settings: Problem while reading ' write(*,*)'Checking that nslope=1' if (nslope == 1) then write(*,*)'We take default def_slope and subslope dist' allocate(default_def_slope(nslope + 1)) default_def_slope(1) = -90. default_def_slope(2) = 90. subslope_dist = 1. def_slope = default_def_slope else write(*,*)'Variable def_slope is not present in the start and' write(*,*)'you are trying to run with nslope!=1' write(*,*)'This is not possible, you have to go through newstart' endif else startphy_slope=.true. call get_field("subslope_dist",subslope_dist,found,indextime) if (.not. found) then write(*,*)'slope_settings: Problem while reading ' write(*,*)'We have to abort.' write(*,*)'Please check that nslope is coherent, you can modify this parameter with newstart' call abort_physic(modname,"phyetat0: Failed loading ",1) endif endif else ! (no startphy_file) if (nslope == 1) then allocate(default_def_slope(2)) default_def_slope = 0. subslope_dist = 1. def_slope = default_def_slope else write(*,*)'Without startfi, lets first run with nslope=1' call abort_physic(modname,"phyetat0: No startfi and nslope!=1",1) endif endif do islope = 1,nslope def_slope_mean(islope) = (def_slope(islope) + def_slope(islope + 1))/2. enddo DO ig = 1,ngrid sum_dist = 0. DO islope = 1,nslope sum_dist = sum_dist + subslope_dist(ig,islope) ENDDO DO islope = 1,nslope subslope_dist(ig,islope) = subslope_dist(ig,islope)/sum_dist ENDDO ENDDO !Now determine the major subslope, ie. the maximal distribution DO ig=1,ngrid major_slope(ig)=1 current_max=subslope_dist(ig,1) DO islope=2,nslope if(subslope_dist(ig,islope).GT.current_max) then major_slope(ig)=islope current_max=subslope_dist(ig,islope) ENDIF ENDDO ENDDO if (startphy_file) then ! Load surface geopotential: call get_field("phisfi",phisfi,found) if (.not.found) then call abort_physic(modname, & "phyetat0: Failed loading ",1) endif else phisfi(:)=0. endif ! of if (startphy_file) write(*,*) "phyetat0: surface geopotential range:", & minval(phisfi), maxval(phisfi) if (startphy_file) then ! Load bare ground albedo: call get_field("albedodat",albedodat,found) if (.not.found) then call abort_physic(modname, & "phyetat0: Failed loading ",1) endif else ! If no startfi file, use parameter surfalbedo in def file surfalbedo=0.1 call getin_p("surfalbedo_without_startfi",surfalbedo) print*,"surfalbedo_without_startfi",surfalbedo albedodat(:)=surfalbedo endif ! of if (startphy_file) write(*,*) "phyetat0: Bare ground albedo range:", & minval(albedodat), maxval(albedodat) ! ZMEA if (startphy_file) then call get_field("ZMEA",zmea,found) if (.not.found) then call abort_physic(modname, & "phyetat0: Failed loading ",1) endif else zmea(:)=0. endif ! of if (startphy_file) write(*,*) "phyetat0: range:", & minval(zmea), maxval(zmea) ! ZSTD if (startphy_file) then call get_field("ZSTD",zstd,found) if (.not.found) then call abort_physic(modname, & "phyetat0: Failed loading ",1) endif else zstd(:)=0. endif ! of if (startphy_file) write(*,*) "phyetat0: range:", & minval(zstd), maxval(zstd) ! ZSIG if (startphy_file) then call get_field("ZSIG",zsig,found) if (.not.found) then call abort_physic(modname, & "phyetat0: Failed loading ",1) endif else zsig(:)=0. endif ! of if (startphy_file) write(*,*) "phyetat0: range:", & minval(zsig), maxval(zsig) ! ZGAM if (startphy_file) then call get_field("ZGAM",zgam,found) if (.not.found) then call abort_physic(modname, & "phyetat0: Failed loading ",1) endif else zgam(:)=0. endif ! of if (startphy_file) write(*,*) "phyetat0: range:", & minval(zgam), maxval(zgam) ! ZTHE if (startphy_file) then call get_field("ZTHE",zthe,found) if (.not.found) then call abort_physic(modname, & "phyetat0: Failed loading ",1) endif else zthe(:)=0. endif ! of if (startphy_file) write(*,*) "phyetat0: range:", & minval(zthe), maxval(zthe) ! hmons if (startphy_file) then call get_field("hmons",hmons,found) if (.not.found) then write(*,*) "WARNING: phyetat0: Failed loading " if (rdstorm) then call abort_physic(modname, & "phyetat0: Failed loading ",1) else write(*,*) "will continue anyway..." write(*,*) "because you may not need it." hmons(:)=0. end if ! if (rdstorm) else do ig=1,ngrid if (hmons(ig) .eq. -999999.) hmons(ig)=0. enddo endif ! (.not.found) else hmons(:)=0. endif ! if (startphy_file) write(*,*) "phyetat0: range:", & minval(hmons), maxval(hmons) ! summit if (startphy_file) then call get_field("summit",summit,found) if (.not.found) then write(*,*) "WARNING: phyetat0: Failed loading " if (rdstorm) then call abort_physic(modname, & "phyetat0: Failed loading ",1) else write(*,*) "will continue anyway..." write(*,*) "because you may not need it." summit(:)=0. end if else do ig=1,ngrid if (summit(ig) .eq. -999999.) summit(ig)=0. enddo endif ! if (.not.found) else summit(:)=0. endif ! if (startphy_file) write(*,*) "phyetat0: range:", & minval(summit), maxval(summit) ! base if (startphy_file) then call get_field("base",base,found) if (.not.found) then write(*,*) "WARNING: phyetat0: Failed loading " if (rdstorm) then call abort_physic(modname, & "phyetat0: Failed loading ",1) else write(*,*) "will continue anyway..." write(*,*) "because you may not need it." base(:)=0. end if else do ig=1,ngrid if (base(ig) .eq. -999999.) base(ig)=0. enddo endif ! if(.not.found) else base(:)=0. endif ! if (startphy_file) write(*,*) "phyetat0: range:", & minval(base), maxval(base) ! Time axis ! obtain timestart from run.def timestart=-9999 ! default value call getin_p("timestart",timestart) if (startphy_file) then found=inquire_dimension("Time") if (.not.found) then indextime = 1 write(*,*) "phyetat0: No time axis found in "//trim(fichnom) else write(*,*) "phyetat0: Time axis found in "//trim(fichnom) timelen=inquire_dimension_length("Time") allocate(time(timelen)) ! load "Time" array: call get_var("Time",time,found) if (.not.found) then call abort_physic(modname, & "phyetat0: Failed loading