| 1 | MODULE init_testphys1d_mod |
|---|
| 2 | |
|---|
| 3 | implicit none |
|---|
| 4 | |
|---|
| 5 | contains |
|---|
| 6 | |
|---|
| 7 | SUBROUTINE init_testphys1d(start1Dname,startfiname,therestart1D,therestartfi,ngrid,nlayer,odpref, & |
|---|
| 8 | nq,q,time,psurf,u,v,temp,ndt,ptif,pks,dttestphys,zqsat,dq,dqdyn,day0,day,gru,grv,w, & |
|---|
| 9 | play,plev,latitude,longitude,cell_area,atm_wat_profile,atm_wat_tau) |
|---|
| 10 | |
|---|
| 11 | use ioipsl_getincom, only: getin ! To use 'getin' |
|---|
| 12 | use comcstfi_h, only: pi, rad, omeg, g, mugaz, rcp, r, cpp |
|---|
| 13 | use time_phylmdz_mod, only: daysec, steps_per_sol, outputs_per_sol, iphysiq |
|---|
| 14 | use planete_h, only: year_day, periheli, aphelie, peri_day, obliquit, emin_turb, lmixmin |
|---|
| 15 | use surfdat_h, only: albedodat, z0_default, z0, emissiv, emisice, albedice, iceradius, dtemisice, & |
|---|
| 16 | zmea, zstd, zsig, zgam, zthe, hmons, summit, base, phisfi, watercaptag, watercap, & |
|---|
| 17 | tsurf, emis, qsurf, perennial_co2ice, ini_surfdat_h_slope_var, end_surfdat_h_slope_var |
|---|
| 18 | use infotrac, only: nqtot, tname, nqperes, nqfils |
|---|
| 19 | use read_profile_mod, only: read_profile |
|---|
| 20 | use iostart, only: open_startphy, get_var, close_startphy |
|---|
| 21 | use physics_distribution_mod, only: init_physics_distribution |
|---|
| 22 | use comsoil_h, only: volcapa, nsoilmx, inertiesoil, inertiedat, layer, mlayer, flux_geo, tsoil, & |
|---|
| 23 | adsorption_soil, qsoil, igcm_h2o_ice_soil, porosity_reg, & |
|---|
| 24 | ini_comsoil_h_slope_var, end_comsoil_h_slope_var, ads_massive_ice |
|---|
| 25 | use comvert_mod, only: ap, bp, aps, bps, pa, preff, presnivs, pseudoalt, scaleheight |
|---|
| 26 | use dimradmars_mod, only: tauvis, totcloudfrac, albedo, ini_dimradmars_mod_slope_var, end_dimradmars_mod_slope_var |
|---|
| 27 | use regular_lonlat_mod, only: init_regular_lonlat |
|---|
| 28 | use mod_interface_dyn_phys, only: init_interface_dyn_phys |
|---|
| 29 | use geometry_mod, only: init_geometry, init_geometry_cell_area_for_outputs |
|---|
| 30 | use dimphy, only: init_dimphy |
|---|
| 31 | use comgeomfi_h, only: sinlat, ini_fillgeom |
|---|
| 32 | use slope_mod, only: theta_sl, psi_sl |
|---|
| 33 | use comslope_mod, only: def_slope, subslope_dist |
|---|
| 34 | use dust_param_mod, only: tauscaling |
|---|
| 35 | use tracer_mod, only: igcm_co2 |
|---|
| 36 | use logic_mod, only: hybrid |
|---|
| 37 | use vertical_layers_mod, only: init_vertical_layers |
|---|
| 38 | use inichim_newstart_mod, only: inichim_newstart |
|---|
| 39 | use mod_grid_phy_lmdz, only: regular_lonlat |
|---|
| 40 | use phys_state_var_init_mod, only: phys_state_var_init |
|---|
| 41 | use turb_mod, only: q2 |
|---|
| 42 | use nonoro_gwd_ran_mod, only: du_nonoro_gwd, dv_nonoro_gwd |
|---|
| 43 | use conf_phys_mod, only: conf_phys |
|---|
| 44 | use paleoclimate_mod, only: paleoclimate, ini_paleoclimate_h, end_paleoclimate_h, h2o_ice_depth |
|---|
| 45 | use comslope_mod, only: nslope, subslope_dist, ini_comslope_h, end_comslope_h |
|---|
| 46 | use co2condens_mod, only: CO2cond_ps |
|---|
| 47 | use callkeys_mod, only: water, photochem, callthermos |
|---|
| 48 | ! Mostly for XIOS outputs: |
|---|
| 49 | use mod_const_mpi, only: COMM_LMDZ |
|---|
| 50 | |
|---|
| 51 | implicit none |
|---|
| 52 | |
|---|
| 53 | include "dimensions.h" |
|---|
| 54 | |
|---|
| 55 | !======================================================================= |
|---|
| 56 | ! Arguments |
|---|
| 57 | !======================================================================= |
|---|
| 58 | integer, intent(in) :: ngrid, nlayer |
|---|
| 59 | real, intent(in) :: odpref ! DOD reference pressure (Pa) |
|---|
| 60 | character(*), intent(in) :: start1Dname, startfiname ! Name of starting files for 1D |
|---|
| 61 | logical, intent(in) :: therestart1D, therestartfi ! Use of starting files for 1D |
|---|
| 62 | |
|---|
| 63 | integer, intent(inout) :: nq |
|---|
| 64 | |
|---|
| 65 | real, dimension(:,:,:), allocatable, intent(out) :: q ! tracer mixing ratio (e.g. kg/kg) |
|---|
| 66 | real, intent(out) :: time ! time (0<time<1; time=0.5 at noon) |
|---|
| 67 | real, intent(out) :: psurf ! Surface pressure |
|---|
| 68 | real, dimension(nlayer), intent(out) :: u, v ! zonal, meridional wind |
|---|
| 69 | real, dimension(nlayer), intent(out) :: temp ! temperature at the middle of the layers |
|---|
| 70 | integer, intent(out) :: ndt |
|---|
| 71 | real, intent(out) :: ptif, pks |
|---|
| 72 | real, intent(out) :: dttestphys ! testphys1d timestep |
|---|
| 73 | real, dimension(:), allocatable, intent(out) :: zqsat ! useful for (atm_wat_profile=2) |
|---|
| 74 | real, dimension(:,:,:), allocatable, intent(out) :: dq, dqdyn ! Physical and dynamical tandencies |
|---|
| 75 | integer, intent(out) :: day0 ! initial (sol ; =0 at Ls=0) and final date |
|---|
| 76 | real, intent(out) :: day ! date during the run |
|---|
| 77 | real, intent(out) :: gru, grv ! prescribed "geostrophic" background wind |
|---|
| 78 | real, dimension(nlayer), intent(out) :: w ! "Dummy wind" in 1D |
|---|
| 79 | real, dimension(nlayer), intent(out) :: play ! Pressure at the middle of the layers (Pa) |
|---|
| 80 | real, dimension(nlayer + 1), intent(out) :: plev ! intermediate pressure levels (pa) |
|---|
| 81 | real, dimension(1), intent(out) :: latitude, longitude, cell_area |
|---|
| 82 | real, intent(out) :: atm_wat_profile, atm_wat_tau ! Force atmospheric water profiles |
|---|
| 83 | |
|---|
| 84 | !======================================================================= |
|---|
| 85 | ! Local variables |
|---|
| 86 | !======================================================================= |
|---|
| 87 | integer :: ierr, iq, j, ilayer, isoil, nlevel, nsoil, flagthermo, flagh2o, nslope_tmp |
|---|
| 88 | integer :: dayn ! Final date |
|---|
| 89 | real, dimension(nlayer) :: zlay ! altitude estimee dans les couches (km) |
|---|
| 90 | real, dimension(0:nlayer) :: tmp1, tmp2 |
|---|
| 91 | |
|---|
| 92 | ! Dummy variables along "dynamics scalar grid" |
|---|
| 93 | real, dimension(:,:,:,:), allocatable :: qdyn |
|---|
| 94 | real, dimension(:,:), allocatable :: psdyn |
|---|
| 95 | |
|---|
| 96 | ! RV & JBC: Use of starting files for 1D |
|---|
| 97 | logical :: found |
|---|
| 98 | character(30) :: header |
|---|
| 99 | real, dimension(100) :: tab_cntrl |
|---|
| 100 | |
|---|
| 101 | ! New flag to compute paleo orbital configurations + few variables JN |
|---|
| 102 | logical :: paleomars |
|---|
| 103 | real :: halfaxe, eccentric, Lsperi |
|---|
| 104 | |
|---|
| 105 | ! MVals: isotopes as in the dynamics (CRisi) |
|---|
| 106 | integer :: ipere, ierr0 |
|---|
| 107 | character(30), dimension(:), allocatable :: tnom_transp ! transporting fluid short name |
|---|
| 108 | character(80) :: line ! to store a line of text |
|---|
| 109 | logical :: continu |
|---|
| 110 | |
|---|
| 111 | ! LL: Possibility to add subsurface ice |
|---|
| 112 | real :: ice_depth ! depth of the ice table, ice_depth < 0. means no ice |
|---|
| 113 | real :: inertieice ! ice thermal inertia |
|---|
| 114 | integer :: iref |
|---|
| 115 | |
|---|
| 116 | ! LL: Subsurface water ice |
|---|
| 117 | real :: rho_H2O_ice ! Density (kg/m^3) of water ice |
|---|
| 118 | |
|---|
| 119 | !======================================================================= |
|---|
| 120 | ! Code |
|---|
| 121 | !======================================================================= |
|---|
| 122 | !------------------------------------------------------ |
|---|
| 123 | ! Prescribed constants to be set here |
|---|
| 124 | !------------------------------------------------------ |
|---|
| 125 | ! Mars planetary constants |
|---|
| 126 | ! ------------------------ |
|---|
| 127 | rad = 3397200. ! mars radius (m) ~3397200 m |
|---|
| 128 | daysec = 88775. ! length of a sol (s) ~88775 s |
|---|
| 129 | omeg = 4.*asin(1.)/daysec ! rotation rate (rad.s-1) |
|---|
| 130 | g = 3.72 ! gravity (m.s-2) ~3.72 |
|---|
| 131 | mugaz = 43.49 ! atmosphere molar mass (g.mol-1) ~43.49 |
|---|
| 132 | rcp = .256793 ! = r/cp ~0.256793 |
|---|
| 133 | r = 8.314511*1000./mugaz |
|---|
| 134 | cpp = r/rcp |
|---|
| 135 | year_day = 669 ! length of year (sols) ~668.6 |
|---|
| 136 | periheli = 206.66 ! minimum sun-mars distance (Mkm) ~206.66 |
|---|
| 137 | aphelie = 249.22 ! maximum sun-mars distance (Mkm) ~249.22 |
|---|
| 138 | halfaxe = 227.94 ! demi-grand axe de l'ellipse |
|---|
| 139 | peri_day = 485. ! perihelion date (sols since N. Spring) |
|---|
| 140 | obliquit = 25.2 ! Obliquity (deg) ~25.2 |
|---|
| 141 | eccentric = 0.0934 ! Eccentricity (0.0934) |
|---|
| 142 | Lsperi = 251. ! Solar longitude of perihelion |
|---|
| 143 | |
|---|
| 144 | ! Planetary Boundary Layer and Turbulence parameters |
|---|
| 145 | ! -------------------------------------------------- |
|---|
| 146 | z0_default = 1.e-2 ! surface roughness (m) ~0.01 |
|---|
| 147 | emin_turb = 1.e-6 ! minimal turbulent energy ~1.e-8 |
|---|
| 148 | lmixmin = 30 ! mixing length ~100 |
|---|
| 149 | |
|---|
| 150 | ! Cap properties and surface emissivities |
|---|
| 151 | ! --------------------------------------- |
|---|
| 152 | emissiv = 0.95 ! Bare ground emissivity ~.95 |
|---|
| 153 | emisice(1) = 0.95 ! Northern cap emissivity |
|---|
| 154 | emisice(2) = 0.95 ! Southern cap emisssivity |
|---|
| 155 | albedice(1) = 0.5 ! Northern cap albedo |
|---|
| 156 | albedice(2) = 0.5 ! Southern cap albedo |
|---|
| 157 | iceradius(1) = 100.e-6 ! mean scat radius of CO2 snow (north) |
|---|
| 158 | iceradius(2) = 100.e-6 ! mean scat radius of CO2 snow (south) |
|---|
| 159 | dtemisice(1) = 2. ! time scale for snow metamorphism (north) |
|---|
| 160 | dtemisice(2) = 2. ! time scale for snow metamorphism (south) |
|---|
| 161 | |
|---|
| 162 | ! Water ice properties |
|---|
| 163 | ! --------------------------------------- |
|---|
| 164 | inertieice = 2100. |
|---|
| 165 | rho_H2O_ice = 920. |
|---|
| 166 | |
|---|
| 167 | ! Mesh surface (not a very usefull quantity in 1D) |
|---|
| 168 | ! ------------------------------------------------ |
|---|
| 169 | cell_area(1) = 1. |
|---|
| 170 | |
|---|
| 171 | ! Check if there is a 'traceur.def' file and process it |
|---|
| 172 | ! Load tracer names from file 'traceur.def' |
|---|
| 173 | ! ----------------------------------------------------- |
|---|
| 174 | open(90,file = 'traceur.def',status = 'old',form = 'formatted',iostat = ierr) |
|---|
| 175 | if (ierr /= 0) then |
|---|
| 176 | write(*,*) 'Cannot find required file "traceur.def"' |
|---|
| 177 | write(*,*) ' If you want to run with tracers, I need it' |
|---|
| 178 | write(*,*) ' ... might as well stop here ...' |
|---|
| 179 | error stop |
|---|
| 180 | else |
|---|
| 181 | write(*,*) "init_testphys1d: Reading file traceur.def" |
|---|
| 182 | ! read number of tracers: |
|---|
| 183 | read(90,*,iostat = ierr) nq |
|---|
| 184 | nqtot = nq ! set value of nqtot (in infotrac module) as nq |
|---|
| 185 | if (ierr /= 0) then |
|---|
| 186 | write(*,*) "init_testphys1d: error reading number of tracers" |
|---|
| 187 | write(*,*) " (first line of traceur.def) " |
|---|
| 188 | error stop |
|---|
| 189 | endif |
|---|
| 190 | if (nq < 1) then |
|---|
| 191 | write(*,*) "init_testphys1d: error number of tracers" |
|---|
| 192 | write(*,*) "is nq=",nq," but must be >=1!" |
|---|
| 193 | error stop |
|---|
| 194 | endif |
|---|
| 195 | endif |
|---|
| 196 | |
|---|
| 197 | ! Allocate arrays |
|---|
| 198 | allocate(tname(nq),q(1,nlayer,nq),zqsat(nlayer)) |
|---|
| 199 | allocate(dq(1,nlayer,nq),dqdyn(1,nlayer,nq),tnom_transp(nq)) |
|---|
| 200 | |
|---|
| 201 | ! Read tracer names from file traceur.def |
|---|
| 202 | do iq = 1,nq |
|---|
| 203 | read(90,'(80a)',iostat = ierr) line ! store the line from traceur.def |
|---|
| 204 | if (ierr /= 0) then |
|---|
| 205 | error stop 'init_testphys1d: error reading tracer names...' |
|---|
| 206 | endif |
|---|
| 207 | ! if format is tnom_0, tnom_transp (isotopes) |
|---|
| 208 | read(line,*,iostat = ierr0) tname(iq),tnom_transp(iq) |
|---|
| 209 | if (ierr0 /= 0) then |
|---|
| 210 | read(line,*) tname(iq) |
|---|
| 211 | tnom_transp(iq) = 'air' |
|---|
| 212 | endif |
|---|
| 213 | enddo |
|---|
| 214 | close(90) |
|---|
| 215 | |
|---|
| 216 | ! Isotopes: as in the 3D case we have to determine father/son relations for isotopes and carrying fluid |
|---|
| 217 | allocate(nqfils(nqtot)) |
|---|
| 218 | nqperes = 0 |
|---|
| 219 | nqfils = 0 |
|---|
| 220 | do iq = 1,nqtot |
|---|
| 221 | if (tnom_transp(iq) == 'air') then |
|---|
| 222 | ! ceci est un traceur père |
|---|
| 223 | write(*,*) 'Le traceur',iq,', appele ',trim(tname(iq)),', est un pere' |
|---|
| 224 | nqperes = nqperes + 1 |
|---|
| 225 | else !if (tnom_transp(iq) == 'air') then |
|---|
| 226 | ! ceci est un fils. Qui est son père? |
|---|
| 227 | write(*,*) 'Le traceur',iq,', appele ',trim(tname(iq)),', est un fils' |
|---|
| 228 | continu = .true. |
|---|
| 229 | ipere = 1 |
|---|
| 230 | do while (continu) |
|---|
| 231 | if (tnom_transp(iq) == tname(ipere)) then |
|---|
| 232 | ! Son père est ipere |
|---|
| 233 | write(*,*) 'Le traceur',iq,'appele ',trim(tname(iq)),' est le fils de ',ipere,'appele ',trim(tname(ipere)) |
|---|
| 234 | nqfils(ipere) = nqfils(ipere) + 1 |
|---|
| 235 | continu = .false. |
|---|
| 236 | else !if (tnom_transp(iq) == tnom_0(ipere)) then |
|---|
| 237 | ipere = ipere + 1 |
|---|
| 238 | if (ipere > nqtot) then |
|---|
| 239 | write(*,*) 'Le traceur',iq,'appele ',trim(tname(iq)),', est orpelin.' |
|---|
| 240 | call abort_gcm('infotrac_init','Un traceur est orphelin',1) |
|---|
| 241 | endif !if (ipere > nqtot) then |
|---|
| 242 | endif !if (tnom_transp(iq) == tnom_0(ipere)) then |
|---|
| 243 | enddo !do while (continu) |
|---|
| 244 | endif !if (tnom_transp(iq) == 'air') then |
|---|
| 245 | enddo !do iq=1,nqtot |
|---|
| 246 | write(*,*) 'nqperes=',nqperes |
|---|
| 247 | write(*,*) 'nqfils=',nqfils |
|---|
| 248 | |
|---|
| 249 | #ifdef CPP_XIOS |
|---|
| 250 | call init_physics_distribution(regular_lonlat,4,1,1,1,nlayer,COMM_LMDZ) |
|---|
| 251 | #else |
|---|
| 252 | call init_physics_distribution(regular_lonlat,4,1,1,1,nlayer,1) |
|---|
| 253 | #endif |
|---|
| 254 | |
|---|
| 255 | ! Date and local time at beginning of run |
|---|
| 256 | ! --------------------------------------- |
|---|
| 257 | if (.not. therestartfi) then |
|---|
| 258 | ! Date (in sols since spring solstice) at beginning of run |
|---|
| 259 | day0 = 0 ! default value for day0 |
|---|
| 260 | write(*,*) 'Initial date (in martian sols; =0 at Ls=0)?' |
|---|
| 261 | call getin("day0",day0) |
|---|
| 262 | day = float(day0) |
|---|
| 263 | write(*,*) " day0 = ",day0 |
|---|
| 264 | ! Local time at beginning of run |
|---|
| 265 | time = 0 ! default value for time |
|---|
| 266 | write(*,*)'Initial local time (in hours, between 0 and 24)?' |
|---|
| 267 | call getin("time",time) |
|---|
| 268 | write(*,*)" time = ",time |
|---|
| 269 | time = time/24. ! convert time (hours) to fraction of sol |
|---|
| 270 | else |
|---|
| 271 | call open_startphy(trim(startfiname)) |
|---|
| 272 | call get_var("controle",tab_cntrl,found) |
|---|
| 273 | if (.not. found) then |
|---|
| 274 | call abort_physic("open_startphy","tabfi: Failed reading <controle> array",1) |
|---|
| 275 | else |
|---|
| 276 | write(*,*)'tabfi: tab_cntrl',tab_cntrl |
|---|
| 277 | endif |
|---|
| 278 | day0 = tab_cntrl(3) |
|---|
| 279 | day = float(day0) |
|---|
| 280 | |
|---|
| 281 | call get_var("Time",time,found) |
|---|
| 282 | call close_startphy |
|---|
| 283 | endif !(.not. therestartfi) |
|---|
| 284 | |
|---|
| 285 | ! Discretization (Definition of grid and time steps) |
|---|
| 286 | ! -------------------------------------------------- |
|---|
| 287 | nlevel = nlayer + 1 |
|---|
| 288 | nsoil = nsoilmx |
|---|
| 289 | |
|---|
| 290 | steps_per_sol = 48 ! Default value for day_step (old name for steps_per_sol) |
|---|
| 291 | write(*,*)'Number of time steps per sol?' |
|---|
| 292 | call getin("day_step",steps_per_sol) |
|---|
| 293 | write(*,*) " steps_per_sol (aka day_step) = ",steps_per_sol |
|---|
| 294 | |
|---|
| 295 | outputs_per_sol = steps_per_sol ! Default value for outputs_per_sol |
|---|
| 296 | |
|---|
| 297 | ndt = 10 ! Default value for ndt |
|---|
| 298 | write(*,*)'Number of sols to run?' |
|---|
| 299 | call getin("ndt",ndt) |
|---|
| 300 | write(*,*) " ndt = ",ndt |
|---|
| 301 | |
|---|
| 302 | dayn = day0 + ndt |
|---|
| 303 | ndt = ndt*steps_per_sol |
|---|
| 304 | dttestphys = daysec/steps_per_sol |
|---|
| 305 | |
|---|
| 306 | ! Imposed surface pressure |
|---|
| 307 | ! ------------------------ |
|---|
| 308 | psurf = 610. ! Default value for psurf |
|---|
| 309 | write(*,*) 'Surface pressure (Pa)?' |
|---|
| 310 | if (.not. therestart1D) then |
|---|
| 311 | call getin("psurf",psurf) |
|---|
| 312 | else |
|---|
| 313 | open(3,file = trim(start1Dname),status = "old",action = "read") |
|---|
| 314 | read(3,*) header, psurf |
|---|
| 315 | endif |
|---|
| 316 | write(*,*) " psurf = ",psurf |
|---|
| 317 | |
|---|
| 318 | ! Coefficient to control the surface pressure change |
|---|
| 319 | ! To be defined in "callphys.def" so that the PEM can read it asa well |
|---|
| 320 | ! If CO2cond_ps = 0, surface pressure is kept constant; If CO2cond_ps = 1, surface pressure varies normally |
|---|
| 321 | ! CO2cond_ps = 300*400/144.37e6 = 8.31e-4 (ratio of polar cap surface over planetary surface) is a typical value for tests |
|---|
| 322 | ! -------------------------------------------------------------------- |
|---|
| 323 | CO2cond_ps = 1. ! Default value |
|---|
| 324 | write(*,*) 'Coefficient to control the surface pressure change?' |
|---|
| 325 | call getin("CO2cond_ps",CO2cond_ps) |
|---|
| 326 | if (CO2cond_ps < 0. .or. CO2cond_ps > 1.) then |
|---|
| 327 | write(*,*) 'Value for ''CO2cond_ps'' is not between 0 and 1.' |
|---|
| 328 | error stop 'Please, specify a correct value!' |
|---|
| 329 | endif |
|---|
| 330 | |
|---|
| 331 | ! Reference pressures |
|---|
| 332 | pa = 20. ! Transition pressure (for hybrid coord.) |
|---|
| 333 | preff = 610. ! Reference surface pressure |
|---|
| 334 | |
|---|
| 335 | ! Aerosol properties |
|---|
| 336 | ! ------------------ |
|---|
| 337 | tauvis = 0.2 ! Default value for tauvis (dust opacity) |
|---|
| 338 | write(*,'("Reference dust opacity at ",f4.0," Pa?")') odpref |
|---|
| 339 | call getin("tauvis",tauvis) |
|---|
| 340 | write(*,*) " tauvis =",tauvis |
|---|
| 341 | |
|---|
| 342 | ! Orbital parameters |
|---|
| 343 | ! ------------------ |
|---|
| 344 | if (.not. therestartfi) then |
|---|
| 345 | paleomars = .false. ! Default: no water ice reservoir |
|---|
| 346 | call getin("paleomars",paleomars) |
|---|
| 347 | write(*,*) "paleomars=", paleomars |
|---|
| 348 | if (paleomars) then |
|---|
| 349 | write(*,*) "Orbital parameters taken from callphys.def" |
|---|
| 350 | |
|---|
| 351 | write(*,*)'Obliquity?' |
|---|
| 352 | call getin("obliquit",obliquit) |
|---|
| 353 | write(*,*) " obliquit =",obliquit |
|---|
| 354 | |
|---|
| 355 | write(*,*) 'Eccentricity (0<e<1)?' |
|---|
| 356 | call getin('eccentric',eccentric) |
|---|
| 357 | write(*,*)"eccentric =",eccentric |
|---|
| 358 | if (eccentric < 0. .or. eccentric > 1.) then |
|---|
| 359 | write(*,*) 'Value for ''eccentric'' is not between 0 and 1.' |
|---|
| 360 | error stop 'Please, specify a correct value!' |
|---|
| 361 | endif |
|---|
| 362 | |
|---|
| 363 | call getin('Lsperi',Lsperi) |
|---|
| 364 | write(*,*) 'Solar longitude of perihelion (0<Ls<360)?' |
|---|
| 365 | write(*,*)"Lsperi =",Lsperi |
|---|
| 366 | if (eccentric < 0. .or. eccentric > 360.) then |
|---|
| 367 | write(*,*) 'Value for ''Lsperi'' is not between 0 and 360.' |
|---|
| 368 | error stop 'Please, specify a correct value!' |
|---|
| 369 | endif |
|---|
| 370 | |
|---|
| 371 | Lsperi = Lsperi*pi/180. ! Convert to rad for peri_day |
|---|
| 372 | periheli = halfaxe*(1. - eccentric) |
|---|
| 373 | aphelie = halfaxe*(1. + eccentric) |
|---|
| 374 | call call_dayperi(Lsperi,eccentric,peri_day,year_day) |
|---|
| 375 | write(*,*) "Corresponding orbital params for PCM" |
|---|
| 376 | write(*,*) " periheli =",periheli |
|---|
| 377 | write(*,*) " aphelie =",aphelie |
|---|
| 378 | write(*,*) " peri_day =",peri_day |
|---|
| 379 | else |
|---|
| 380 | write(*,*) "Default present-day orbital parameters" |
|---|
| 381 | endif |
|---|
| 382 | else |
|---|
| 383 | write(*,*) "Orbital parameters taken from startfi.nc" |
|---|
| 384 | endif !(.not. therestartfi) |
|---|
| 385 | |
|---|
| 386 | ! Latitude/longitude |
|---|
| 387 | ! ------------------ |
|---|
| 388 | latitude = 0. ! default value for latitude |
|---|
| 389 | write(*,*) 'Latitude (in degrees)?' |
|---|
| 390 | call getin("latitude",latitude(1)) |
|---|
| 391 | write(*,*) " latitude =",latitude |
|---|
| 392 | latitude = latitude*pi/180. |
|---|
| 393 | longitude = 0. |
|---|
| 394 | longitude = longitude*pi/180. |
|---|
| 395 | |
|---|
| 396 | ! Some initializations (some of which have already been done above!) |
|---|
| 397 | ! and loads parameters set in callphys.def and allocates some arrays |
|---|
| 398 | ! Mars possible matter with dttestphys in input and include!!! |
|---|
| 399 | ! Initializations below should mimick what is done in iniphysiq for 3D GCM |
|---|
| 400 | call init_interface_dyn_phys |
|---|
| 401 | call init_regular_lonlat(1,1,longitude,latitude,(/0.,0./),(/0.,0./)) |
|---|
| 402 | call init_geometry(1,longitude,latitude,(/0.,0.,0.,0./),(/0.,0.,0.,0./),cell_area,[1]) |
|---|
| 403 | call init_geometry_cell_area_for_outputs(1,cell_area) |
|---|
| 404 | ! Ehouarn: init_vertial_layers called later (because disvert not called yet) |
|---|
| 405 | ! call init_vertical_layers(nlayer,preff,scaleheight,ap,bp,aps,bps,presnivs,pseudoalt) |
|---|
| 406 | call init_dimphy(1,nlayer) ! Initialize dimphy module |
|---|
| 407 | call phys_state_var_init(1,llm,nq,tname,day0,dayn,time,daysec,dttestphys,rad,g,r,cpp,nqperes,nqfils) ! MVals: variables isotopes |
|---|
| 408 | call ini_fillgeom(1,latitude,longitude,(/1.0/)) |
|---|
| 409 | call conf_phys(1,llm,nq) |
|---|
| 410 | call initracer(ngrid,nq,qsurf) |
|---|
| 411 | |
|---|
| 412 | ! In 1D model physics are called every time step |
|---|
| 413 | ! ovverride iphysiq value that has been set by conf_phys |
|---|
| 414 | if (iphysiq /= 1) then |
|---|
| 415 | write(*,*) "init_testphys1d: setting iphysiq=1" |
|---|
| 416 | iphysiq = 1 |
|---|
| 417 | endif |
|---|
| 418 | |
|---|
| 419 | ! Initialize local slope parameters |
|---|
| 420 | ! --------------------------------- |
|---|
| 421 | nslope_tmp = nslope |
|---|
| 422 | write(*,*)'Number of slopes?' ! Number of subgrid scale slopes |
|---|
| 423 | call getin("nslope",nslope_tmp) |
|---|
| 424 | write(*,*) " nslope = ", nslope_tmp |
|---|
| 425 | if (.not. therestartfi) then |
|---|
| 426 | nslope = nslope_tmp |
|---|
| 427 | call end_comslope_h |
|---|
| 428 | call ini_comslope_h(1,nslope) |
|---|
| 429 | select case (nslope) |
|---|
| 430 | case(1) |
|---|
| 431 | ! Sub-slopes parameters (minimum/maximun angles) |
|---|
| 432 | def_slope(1) = -90. |
|---|
| 433 | def_slope(2) = 90. |
|---|
| 434 | ! Fraction of subslopes in mesh |
|---|
| 435 | subslope_dist(1,1) = 1. |
|---|
| 436 | case(3) |
|---|
| 437 | ! Sub-slopes parameters (minimum/maximun angles) |
|---|
| 438 | def_slope(1) = -50. |
|---|
| 439 | def_slope(2) = -3. |
|---|
| 440 | def_slope(3) = 3. |
|---|
| 441 | def_slope(4) = 50. |
|---|
| 442 | ! Fraction of subslopes in mesh |
|---|
| 443 | subslope_dist(1,1) = 0.1 |
|---|
| 444 | subslope_dist(1,2) = 0.8 |
|---|
| 445 | subslope_dist(1,3) = 0.1 |
|---|
| 446 | case(5) |
|---|
| 447 | ! Sub-slopes parameters (minimum/maximun angles) |
|---|
| 448 | def_slope(1) = -43. |
|---|
| 449 | def_slope(2) = -9. |
|---|
| 450 | def_slope(3) = -3. |
|---|
| 451 | def_slope(4) = 3. |
|---|
| 452 | def_slope(5) = 9. |
|---|
| 453 | def_slope(6) = 43. |
|---|
| 454 | ! Fraction of subslopes in mesh |
|---|
| 455 | subslope_dist(1,1) = 0.025 |
|---|
| 456 | subslope_dist(1,2) = 0.075 |
|---|
| 457 | subslope_dist(1,3) = 0.8 |
|---|
| 458 | subslope_dist(1,4) = 0.075 |
|---|
| 459 | subslope_dist(1,5) = 0.025 |
|---|
| 460 | case(7) |
|---|
| 461 | ! Sub-slopes parameters (minimum/maximun angles) |
|---|
| 462 | def_slope(1) = -43. |
|---|
| 463 | def_slope(2) = -19. |
|---|
| 464 | def_slope(3) = -9. |
|---|
| 465 | def_slope(4) = -3. |
|---|
| 466 | def_slope(5) = 3. |
|---|
| 467 | def_slope(6) = 9. |
|---|
| 468 | def_slope(7) = 19. |
|---|
| 469 | def_slope(8) = 43. |
|---|
| 470 | ! Fraction of subslopes in mesh |
|---|
| 471 | subslope_dist(1,1) = 0.01 |
|---|
| 472 | subslope_dist(1,2) = 0.02 |
|---|
| 473 | subslope_dist(1,3) = 0.06 |
|---|
| 474 | subslope_dist(1,4) = 0.8 |
|---|
| 475 | subslope_dist(1,5) = 0.06 |
|---|
| 476 | subslope_dist(1,6) = 0.02 |
|---|
| 477 | subslope_dist(1,7) = 0.01 |
|---|
| 478 | case default |
|---|
| 479 | error stop 'Number of slopes not possible: nslope should be 1, 3, 5 or 7!' |
|---|
| 480 | end select |
|---|
| 481 | |
|---|
| 482 | call end_surfdat_h_slope_var |
|---|
| 483 | call ini_surfdat_h_slope_var(1,nq,nslope) |
|---|
| 484 | call end_comsoil_h_slope_var |
|---|
| 485 | call ini_comsoil_h_slope_var(1,nslope) |
|---|
| 486 | call end_dimradmars_mod_slope_var |
|---|
| 487 | call ini_dimradmars_mod_slope_var(1,nslope) |
|---|
| 488 | call end_paleoclimate_h |
|---|
| 489 | call ini_paleoclimate_h(1,nslope) |
|---|
| 490 | else |
|---|
| 491 | if (nslope /= nslope_tmp) then |
|---|
| 492 | error stop 'Number of slopes not compatible between "startfi.nc" and "run.def".' |
|---|
| 493 | else |
|---|
| 494 | write(*,*) 'Be careful: subslopes distribution and definition are taken from "startfi.nc" and not initialized by default!' |
|---|
| 495 | endif |
|---|
| 496 | endif |
|---|
| 497 | |
|---|
| 498 | ! Slope inclination angle (deg) 0: horizontal, 90: vertical |
|---|
| 499 | theta_sl = 0. ! default: no inclination |
|---|
| 500 | call getin("slope_inclination",theta_sl) |
|---|
| 501 | |
|---|
| 502 | ! Slope orientation (deg) |
|---|
| 503 | ! 0 == Northward, 90 == Eastward, 180 == Southward, 270 == Westward |
|---|
| 504 | psi_sl = 0. ! default value |
|---|
| 505 | call getin("slope_orientation",psi_sl) |
|---|
| 506 | |
|---|
| 507 | ! Initialize tracers (surface and atmosphere) |
|---|
| 508 | !-------------------------------------------- |
|---|
| 509 | write(*,*) "init_testphys1d: initializing tracers" |
|---|
| 510 | if (.not. therestart1D) then |
|---|
| 511 | call read_profile(nq,nlayer,qsurf(1,:,1),q) |
|---|
| 512 | do iq = 1,nq |
|---|
| 513 | qsurf(1,iq,:) = qsurf(1,iq,1) |
|---|
| 514 | enddo |
|---|
| 515 | else |
|---|
| 516 | do iq = 1,nq |
|---|
| 517 | read(3,*) header, (qsurf(1,iq,j), j = 1,size(qsurf,3)), (q(1,ilayer,iq), ilayer = 1,nlayer) |
|---|
| 518 | if (trim(tname(iq)) /= trim(header)) then |
|---|
| 519 | write(*,*) 'Tracer names between "traceur.def" and "'//trim(start1Dname)//'" do not match!' |
|---|
| 520 | write(*,*) 'Please, write the tracer names in the same order for both files.' |
|---|
| 521 | error stop |
|---|
| 522 | endif |
|---|
| 523 | enddo |
|---|
| 524 | endif |
|---|
| 525 | |
|---|
| 526 | ! Initialize albedo / soil thermal inertia |
|---|
| 527 | ! ---------------------------------------- |
|---|
| 528 | if (.not. therestartfi) then |
|---|
| 529 | albedodat(1) = 0.2 ! default value for albedodat |
|---|
| 530 | write(*,*)'Albedo of bare ground?' |
|---|
| 531 | call getin("albedo",albedodat(1)) |
|---|
| 532 | write(*,*) " albedo = ",albedodat(1) |
|---|
| 533 | albedo(1,:,:) = albedodat(1) |
|---|
| 534 | |
|---|
| 535 | inertiedat(1,1) = 400 ! default value for inertiedat |
|---|
| 536 | write(*,*)'Soil thermal inertia (SI)?' |
|---|
| 537 | call getin("inertia",inertiedat(1,1)) |
|---|
| 538 | write(*,*) " inertia = ",inertiedat(1,1) |
|---|
| 539 | |
|---|
| 540 | ice_depth = -1 ! default value: no ice |
|---|
| 541 | call getin("subsurface_ice_depth",ice_depth) |
|---|
| 542 | write(*,*) " subsurface_ice_depth = ",ice_depth |
|---|
| 543 | h2o_ice_depth(:,:) = ice_depth |
|---|
| 544 | z0(1) = z0_default ! default value for roughness |
|---|
| 545 | write(*,*) 'Surface roughness length z0 (m)?' |
|---|
| 546 | call getin("z0",z0(1)) |
|---|
| 547 | write(*,*) " z0 = ",z0(1) |
|---|
| 548 | endif !(.not. therestartfi) |
|---|
| 549 | |
|---|
| 550 | ! For the gravity wave scheme |
|---|
| 551 | ! --------------------------- |
|---|
| 552 | zmea(1) = 0. |
|---|
| 553 | zstd(1) = 0. |
|---|
| 554 | zsig(1) = 0. |
|---|
| 555 | zgam(1) = 0. |
|---|
| 556 | zthe(1) = 0. |
|---|
| 557 | |
|---|
| 558 | ! For the non-orographic gravity waves scheme |
|---|
| 559 | du_nonoro_gwd(1,:) = 0 |
|---|
| 560 | dv_nonoro_gwd(1,:) = 0 |
|---|
| 561 | |
|---|
| 562 | ! For the slope wind scheme |
|---|
| 563 | ! ------------------------- |
|---|
| 564 | hmons(1) = 0. |
|---|
| 565 | write(*,*)'hmons is initialized to ',hmons(1) |
|---|
| 566 | summit(1) = 0. |
|---|
| 567 | write(*,*)'summit is initialized to ',summit(1) |
|---|
| 568 | base(1) = 0. |
|---|
| 569 | |
|---|
| 570 | ! Default values initializing the coefficients calculated later |
|---|
| 571 | ! ------------------------------------------------------------- |
|---|
| 572 | tauscaling(1) = 1. ! calculated in aeropacity_mod.F |
|---|
| 573 | totcloudfrac(1) = 1. ! calculated in watercloud_mod.F |
|---|
| 574 | |
|---|
| 575 | ! Specific initializations for "physiq" |
|---|
| 576 | ! ------------------------------------- |
|---|
| 577 | ! surface geopotential is not used (or useful) since in 1D |
|---|
| 578 | ! everything is controled by surface pressure |
|---|
| 579 | phisfi(1) = 0. |
|---|
| 580 | |
|---|
| 581 | ! Initialization to take into account prescribed winds |
|---|
| 582 | ! ---------------------------------------------------- |
|---|
| 583 | ptif = 2.*omeg*sinlat(1) |
|---|
| 584 | |
|---|
| 585 | ! Geostrophic wind |
|---|
| 586 | gru = 10. ! default value for gru |
|---|
| 587 | write(*,*)'zonal eastward component of the geostrophic wind (m/s)?' |
|---|
| 588 | call getin("u",gru) |
|---|
| 589 | write(*,*) " u = ",gru |
|---|
| 590 | grv = 0. !default value for grv |
|---|
| 591 | write(*,*)'meridional northward component of the geostrophic wind (m/s)?' |
|---|
| 592 | call getin("v",grv) |
|---|
| 593 | write(*,*) " v = ",grv |
|---|
| 594 | |
|---|
| 595 | ! Initialize winds for first time step |
|---|
| 596 | !------------------------------------- |
|---|
| 597 | if (.not. therestart1D) then |
|---|
| 598 | u = gru |
|---|
| 599 | v = grv |
|---|
| 600 | else |
|---|
| 601 | read(3,*) header, (u(ilayer), ilayer = 1,nlayer) |
|---|
| 602 | read(3,*) header, (v(ilayer), ilayer = 1,nlayer) |
|---|
| 603 | endif |
|---|
| 604 | w = 0. ! default: no vertical wind |
|---|
| 605 | |
|---|
| 606 | ! Initialize turbulent kinetic energy |
|---|
| 607 | !------------------------------------ |
|---|
| 608 | q2 = 0. |
|---|
| 609 | |
|---|
| 610 | ! CO2 ice on the surface |
|---|
| 611 | ! ---------------------- |
|---|
| 612 | if (.not. therestartfi) then |
|---|
| 613 | qsurf(1,igcm_co2,:) = 0. ! default value for co2ice |
|---|
| 614 | write(*,*)'Initial CO2 ice on the surface (kg.m-2)' |
|---|
| 615 | call getin("co2ice",qsurf(1,igcm_co2,1)) |
|---|
| 616 | qsurf(1,igcm_co2,:) = qsurf(1,igcm_co2,1) |
|---|
| 617 | write(*,*) " co2ice = ",qsurf(1,igcm_co2,1) |
|---|
| 618 | endif !(.not. therestartfi) |
|---|
| 619 | |
|---|
| 620 | ! Emissivity |
|---|
| 621 | ! ---------- |
|---|
| 622 | if (.not. therestartfi) then |
|---|
| 623 | emis = emissiv |
|---|
| 624 | if (qsurf(1,igcm_co2,1) == 1.) then |
|---|
| 625 | emis = emisice(1) ! northern hemisphere |
|---|
| 626 | if (latitude(1) < 0) emis = emisice(2) ! southern hemisphere |
|---|
| 627 | endif |
|---|
| 628 | endif !(.not. therestartfi) |
|---|
| 629 | |
|---|
| 630 | ! Compute pressures and altitudes of atmospheric levels |
|---|
| 631 | ! ----------------------------------------------------- |
|---|
| 632 | ! Vertical Coordinates |
|---|
| 633 | ! """""""""""""""""""" |
|---|
| 634 | hybrid = .true. |
|---|
| 635 | write(*,*)'Hybrid coordinates?' |
|---|
| 636 | call getin("hybrid",hybrid) |
|---|
| 637 | write(*,*) " hybrid = ", hybrid |
|---|
| 638 | |
|---|
| 639 | call disvert_noterre |
|---|
| 640 | ! Now that disvert has been called, initialize module vertical_layers_mod |
|---|
| 641 | call init_vertical_layers(nlayer,preff,scaleheight,ap,bp,aps,bps,presnivs,pseudoalt) |
|---|
| 642 | |
|---|
| 643 | plev = ap + psurf*bp |
|---|
| 644 | play = aps + psurf*bps |
|---|
| 645 | zlay = -200.*r*log(play/plev(1))/g |
|---|
| 646 | |
|---|
| 647 | ! Initialize temperature profile |
|---|
| 648 | ! ------------------------------ |
|---|
| 649 | pks = psurf**rcp |
|---|
| 650 | |
|---|
| 651 | ! Altitude in km in profile: divide zlay by 1000 |
|---|
| 652 | tmp1(0) = 0. |
|---|
| 653 | tmp1(1:) = zlay/1000. |
|---|
| 654 | |
|---|
| 655 | call profile(nlayer + 1,tmp1,tmp2) |
|---|
| 656 | |
|---|
| 657 | if (.not. therestart1D) then |
|---|
| 658 | tsurf = tmp2(0) |
|---|
| 659 | temp = tmp2(1:) |
|---|
| 660 | else |
|---|
| 661 | read(3,*) header, (tsurf(1,j), j = 1,size(tsurf,2)), (temp(ilayer), ilayer = 1,nlayer) |
|---|
| 662 | close(3) |
|---|
| 663 | endif |
|---|
| 664 | |
|---|
| 665 | ! Initialize soil properties, temperature and content |
|---|
| 666 | ! ------------------------------------------ |
|---|
| 667 | volcapa = 1.e6 ! volumetric heat capacity |
|---|
| 668 | |
|---|
| 669 | if (.not. therestartfi) qsoil = 0. |
|---|
| 670 | |
|---|
| 671 | if (.not. therestartfi) then |
|---|
| 672 | ! Initialize depths |
|---|
| 673 | ! ----------------- |
|---|
| 674 | do isoil = 0,nsoil - 1 |
|---|
| 675 | mlayer(isoil) = 2.e-4*(1 + isoil**2.9*(1 - exp(-real(isoil)/20.))) ! mid layer depth |
|---|
| 676 | enddo |
|---|
| 677 | do isoil = 1,nsoil - 1 |
|---|
| 678 | layer(isoil) = (mlayer(isoil) + mlayer(isoil - 1))/2 |
|---|
| 679 | enddo |
|---|
| 680 | layer(nsoil) = 2*mlayer(nsoil - 1) - mlayer(nsoil - 2) |
|---|
| 681 | |
|---|
| 682 | ! Creating the new soil inertia table if there is subsurface ice: |
|---|
| 683 | if (ice_depth > 0) then |
|---|
| 684 | iref = 1 ! ice/regolith boundary index |
|---|
| 685 | if (ice_depth < layer(1)) then |
|---|
| 686 | inertiedat(1,1) = sqrt(layer(1)/((ice_depth/inertiedat(1,1)**2) + ((layer(1) - ice_depth)/inertieice**2))) |
|---|
| 687 | inertiedat(1,2:) = inertieice |
|---|
| 688 | if(adsorption_soil) then |
|---|
| 689 | ! add subsurface ice in qsoil if one runs with adsorption |
|---|
| 690 | if(ads_massive_ice) then |
|---|
| 691 | qsoil(1,1,igcm_h2o_ice_soil,:) = (ice_depth-layer(2))/(layer(1) - layer(2))*rho_H2O_ice ! assume no porosity in the ice |
|---|
| 692 | qsoil(1,2:,igcm_h2o_ice_soil,:) = rho_H2O_ice |
|---|
| 693 | else |
|---|
| 694 | qsoil(1,1,igcm_h2o_ice_soil,:) = (ice_depth-layer(2))/(layer(1) - layer(2))*porosity_reg*rho_H2O_ice |
|---|
| 695 | qsoil(1,2:,igcm_h2o_ice_soil,:) = porosity_reg*rho_H2O_ice |
|---|
| 696 | endif |
|---|
| 697 | endif |
|---|
| 698 | else ! searching for the ice/regolith boundary: |
|---|
| 699 | do isoil = 1,nsoil |
|---|
| 700 | if ((ice_depth >= layer(isoil)) .and. (ice_depth < layer(isoil + 1))) then |
|---|
| 701 | iref = isoil + 1 |
|---|
| 702 | exit |
|---|
| 703 | endif |
|---|
| 704 | enddo |
|---|
| 705 | ! We then change the soil inertia table: |
|---|
| 706 | inertiedat(1,:iref - 1) = inertiedat(1,1) |
|---|
| 707 | ! We compute the transition in layer(iref) |
|---|
| 708 | inertiedat(1,iref) = sqrt((layer(iref) - layer(iref - 1))/(((ice_depth - layer(iref - 1))/inertiedat(1,1)**2) + ((layer(iref) - ice_depth)/inertieice**2))) |
|---|
| 709 | ! Finally, we compute the underlying ice: |
|---|
| 710 | inertiedat(1,iref + 1:) = inertieice |
|---|
| 711 | |
|---|
| 712 | if(adsorption_soil) then |
|---|
| 713 | ! add subsurface ice in qsoil if one runs with adsorption |
|---|
| 714 | qsoil(1,:iref - 1,igcm_h2o_ice_soil,:) = 0. |
|---|
| 715 | if(ads_massive_ice) then |
|---|
| 716 | qsoil(1,iref+1:,igcm_h2o_ice_soil,:) = rho_H2O_ice |
|---|
| 717 | qsoil(1,iref,igcm_h2o_ice_soil,:) = (ice_depth-layer(iref))/(layer(iref-1) - layer(iref))*rho_H2O_ice |
|---|
| 718 | else |
|---|
| 719 | qsoil(1,iref+1:,igcm_h2o_ice_soil,:) = porosity_reg*rho_H2O_ice |
|---|
| 720 | qsoil(1,iref,igcm_h2o_ice_soil,:) = (ice_depth-layer(iref))/(layer(iref-1) - layer(iref))*porosity_reg*rho_H2O_ice |
|---|
| 721 | endif |
|---|
| 722 | endif |
|---|
| 723 | endif ! (ice_depth < layer(1)) |
|---|
| 724 | else ! ice_depth < 0 all is set to surface thermal inertia |
|---|
| 725 | inertiedat(1,:) = inertiedat(1,1) ! soil thermal inertia |
|---|
| 726 | endif ! ice_depth > 0 |
|---|
| 727 | |
|---|
| 728 | do isoil = 1,nsoil |
|---|
| 729 | inertiesoil(1,isoil,:) = inertiedat(1,isoil) |
|---|
| 730 | tsoil(1,isoil,:) = tsurf(1,:) ! soil temperature |
|---|
| 731 | enddo |
|---|
| 732 | endif !(.not. therestartfi) |
|---|
| 733 | |
|---|
| 734 | ! Initialize subsurface geothermal flux |
|---|
| 735 | ! ------------------------------------- |
|---|
| 736 | flux_geo = 0. |
|---|
| 737 | call getin("flux_geo",flux_geo(1,1)) |
|---|
| 738 | write(*,*) " flux_geo = ",flux_geo(1,1) |
|---|
| 739 | flux_geo = flux_geo(1,1) |
|---|
| 740 | |
|---|
| 741 | |
|---|
| 742 | ! Initialize traceurs |
|---|
| 743 | ! ------------------- |
|---|
| 744 | if (photochem .or. callthermos) then |
|---|
| 745 | write(*,*) 'Initializing chemical species' |
|---|
| 746 | ! flagthermo=0: initialize over all atmospheric layers |
|---|
| 747 | flagthermo = 0 |
|---|
| 748 | ! check if "h2o_vap" has already been initialized |
|---|
| 749 | ! (it has been if there is a "profile_h2o_vap" file around) |
|---|
| 750 | inquire(file = "profile_h2o_vap",exist = found) |
|---|
| 751 | if (found) then |
|---|
| 752 | flagh2o = 0 ! 0: do not initialize h2o_vap |
|---|
| 753 | else |
|---|
| 754 | flagh2o = 1 ! 1: initialize h2o_vap in inichim_newstart |
|---|
| 755 | endif |
|---|
| 756 | |
|---|
| 757 | ! hack to accomodate that inichim_newstart assumes that |
|---|
| 758 | ! q & psurf arrays are on the dynamics scalar grid |
|---|
| 759 | allocate(qdyn(2,1,llm,nq),psdyn(2,1)) |
|---|
| 760 | qdyn(1,1,1:llm,1:nq) = q(1,1:llm,1:nq) |
|---|
| 761 | psdyn(1:2,1) = psurf |
|---|
| 762 | call inichim_newstart(ngrid,nq,qdyn,qsurf(1,:,1),psdyn,flagh2o,flagthermo) |
|---|
| 763 | q(1,1:llm,1:nq) = qdyn(1,1,1:llm,1:nq) |
|---|
| 764 | endif |
|---|
| 765 | |
|---|
| 766 | ! Check if the surface is a water ice reservoir |
|---|
| 767 | ! --------------------------------------------- |
|---|
| 768 | if (.not. therestartfi) watercap(1,:) = 0 ! Initialize watercap |
|---|
| 769 | watercaptag(1) = .false. ! Default: no water ice reservoir |
|---|
| 770 | write(*,*)'Water ice cap on ground?' |
|---|
| 771 | call getin("watercaptag",watercaptag) |
|---|
| 772 | write(*,*) " watercaptag = ",watercaptag |
|---|
| 773 | |
|---|
| 774 | ! Initialize perennial_co2ice |
|---|
| 775 | ! --------------------------- |
|---|
| 776 | if (.not. therestartfi .and. paleoclimate) perennial_co2ice = 0. |
|---|
| 777 | |
|---|
| 778 | ! Check if the atmospheric water profile is specified |
|---|
| 779 | ! --------------------------------------------------- |
|---|
| 780 | ! Adding an option to force atmospheric water values JN |
|---|
| 781 | atm_wat_profile = -1. ! Default: free atmospheric water profile |
|---|
| 782 | if (water) then |
|---|
| 783 | write(*,*)'Force atmospheric water vapor profile (uniform column value in kg.m-2)?' |
|---|
| 784 | call getin('atm_wat_profile',atm_wat_profile) |
|---|
| 785 | write(*,*) 'atm_wat_profile = ', atm_wat_profile |
|---|
| 786 | if (abs(atm_wat_profile + 1.) < 1.e-15) then ! if == -1. |
|---|
| 787 | write(*,*) 'Free atmospheric water vapor profile' |
|---|
| 788 | write(*,*) 'Total water is conserved in the column' |
|---|
| 789 | else if (abs(atm_wat_profile) < 1.e-15) then ! if == 0. |
|---|
| 790 | write(*,*) 'Dry atmospheric water vapor profile' |
|---|
| 791 | else if (0. < atm_wat_profile) then |
|---|
| 792 | write(*,*) 'Prescribed atmospheric water vapor profile' |
|---|
| 793 | write(*,*) 'Unless it reaches saturation (maximal value)' |
|---|
| 794 | else |
|---|
| 795 | error stop 'Water vapor profile value not correct!' |
|---|
| 796 | endif |
|---|
| 797 | endif |
|---|
| 798 | |
|---|
| 799 | ! Check if the atmospheric water profile relaxation is specified |
|---|
| 800 | ! -------------------------------------------------------------- |
|---|
| 801 | ! Adding an option to relax atmospheric water values JBC |
|---|
| 802 | atm_wat_tau = -1. ! Default: no time relaxation |
|---|
| 803 | if (water) then |
|---|
| 804 | write(*,*) 'Relax atmospheric water vapor profile with time constant (s)?' |
|---|
| 805 | call getin('atm_wat_tau',atm_wat_tau) |
|---|
| 806 | write(*,*) 'atm_wat_tau = ', atm_wat_tau |
|---|
| 807 | if (atm_wat_tau < 0.) then |
|---|
| 808 | write(*,*) 'Atmospheric water vapor profile is not relaxed (forcing).' |
|---|
| 809 | else |
|---|
| 810 | if (0. <= atm_wat_profile) then |
|---|
| 811 | write(*,*) 'Relaxed atmospheric water vapor profile towards ', atm_wat_profile |
|---|
| 812 | write(*,*) 'Unless it reaches saturation (maximal value)' |
|---|
| 813 | else |
|---|
| 814 | write(*,*) 'Reference atmospheric water vapor profile not known!' |
|---|
| 815 | error stop 'Please, specify atm_wat_profile' |
|---|
| 816 | endif |
|---|
| 817 | endif |
|---|
| 818 | endif |
|---|
| 819 | |
|---|
| 820 | END SUBROUTINE init_testphys1d |
|---|
| 821 | |
|---|
| 822 | END MODULE init_testphys1d_mod |
|---|