source: trunk/LMDZ.MARS/libf/phymars/dyn1d/init_testphys1d_mod.F90 @ 3154

Last change on this file since 3154 was 3152, checked in by jbclement, 2 years ago

PEM:

  • The PEM deftank folder is now in LMDZ.COMMON/libf/evolution/ (not anymore in the Mars PCM deftank).
  • Small corrections related to r3149.

JBC

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