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