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