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

Last change on this file since 3203 was 3203, checked in by jbclement, 10 months ago

Mars PCM:

  • Addition of the possibility to use subslopes parametization in 1D. To do so, put 'nslope=x' in "run.def" where x (1, 3, 5 or 7) is the number of slopes you want to, or modify it in an appropriate "startfi.nc". Then, default subslopes definition and distribution are used by the model. The already existing case of using one slope whose inclination and orientation are defined in "run.def" is still possible.
  • Some cleanings throughout the code, in particular related to unused variables.

JBC

File size: 30.8 KB
Line 
1MODULE init_testphys1d_mod
2
3implicit none
4
5contains
6
7SUBROUTINE 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
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, perennial_co2ice, ini_surfdat_h_slope_var, end_surfdat_h_slope_var
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, &
23                                    ini_comsoil_h_slope_var, end_comsoil_h_slope_var
24use comvert_mod,              only: ap, bp, aps, bps, pa, preff, presnivs, pseudoalt, scaleheight
25use dimradmars_mod,           only: tauvis, totcloudfrac, albedo, ini_dimradmars_mod_slope_var, end_dimradmars_mod_slope_var
26use regular_lonlat_mod,       only: init_regular_lonlat
27use mod_interface_dyn_phys,   only: init_interface_dyn_phys
28use geometry_mod,             only: init_geometry, init_geometry_cell_area_for_outputs
29use dimphy,                   only: init_dimphy
30use comgeomfi_h,              only: sinlat, ini_fillgeom
31use slope_mod,                only: theta_sl, psi_sl
32use comslope_mod,             only: def_slope, subslope_dist
33use dust_param_mod,           only: tauscaling
34use tracer_mod,               only: igcm_co2
35use logic_mod,                only: hybrid
36use vertical_layers_mod,      only: init_vertical_layers
37use inichim_newstart_mod,     only: inichim_newstart
38use mod_grid_phy_lmdz,        only: regular_lonlat
39use phys_state_var_init_mod,  only: phys_state_var_init
40use turb_mod,                 only: q2
41use nonoro_gwd_ran_mod,       only: du_nonoro_gwd, dv_nonoro_gwd
42use conf_phys_mod,            only: conf_phys
43use paleoclimate_mod,         only: paleoclimate, ini_paleoclimate_h, end_paleoclimate_h
44use comslope_mod,             only: nslope, subslope_dist, ini_comslope_h, end_comslope_h
45! Mostly for XIOS outputs:
46use mod_const_mpi,            only: COMM_LMDZ
47
48implicit none
49
50include "dimensions.h"
51include "callkeys.h"
52
53!=======================================================================
54! Arguments
55!=======================================================================
56integer,      intent(in) :: ngrid, nlayer
57real,         intent(in) :: odpref                     ! DOD reference pressure (Pa)
58character(*), intent(in) :: start1Dname, startfiname   ! Name of starting files for 1D
59logical,      intent(in) :: therestart1D, therestartfi ! Use of starting files for 1D
60
61integer, intent(inout) :: nq
62
63real, dimension(:,:,:), allocatable, intent(out) :: q     ! tracer mixing ratio (e.g. kg/kg)
64real,                                intent(out) :: time  ! time (0<time<1; time=0.5 at noon)
65real,                                intent(out) :: psurf ! Surface pressure
66real, dimension(nlayer),             intent(out) :: u, v  ! zonal, meridional wind
67real, dimension(nlayer),             intent(out) :: temp  ! temperature at the middle of the layers
68integer,                             intent(out) :: ndt
69real,                                intent(out) :: ptif, pks
70real,                                intent(out) :: dttestphys                   ! testphys1d timestep
71real, dimension(:),     allocatable, intent(out) :: zqsat                        ! useful for (atm_wat_profile=2)
72real, dimension(:,:,:), allocatable, intent(out) :: dq, dqdyn                    ! Physical and dynamical tandencies
73integer,                             intent(out) :: day0                         ! initial (sol ; =0 at Ls=0) and final date
74real,                                intent(out) :: day                          ! date during the run
75real,                                intent(out) :: gru, grv                     ! prescribed "geostrophic" background wind
76real, dimension(nlayer),             intent(out) :: w                            ! "Dummy wind" in 1D
77real, dimension(nlayer),             intent(out) :: play                         ! Pressure at the middle of the layers (Pa)
78real, dimension(nlayer + 1),         intent(out) :: plev                         ! intermediate pressure levels (pa)
79real, dimension(1),                  intent(out) :: latitude, longitude, cell_area
80real,                                intent(out) :: atm_wat_profile, atm_wat_tau ! Force atmospheric water profiles
81real,                                intent(out) :: CO2cond_ps                   ! Coefficient to control the surface pressure change
82
83!=======================================================================
84! Local variables
85!=======================================================================
86integer                   :: ierr, iq, j, ilayer, isoil, nlevel, nsoil, flagthermo, flagh2o
87integer                   :: dayn ! Final date
88real, dimension(nlayer)   :: zlay ! altitude estimee dans les couches (km)
89real, dimension(0:nlayer) :: tmp1, tmp2
90
91! Dummy variables along "dynamics scalar grid"
92real, dimension(:,:,:,:), allocatable :: qdyn
93real, dimension(:,:),     allocatable :: psdyn
94
95! RV & JBC: Use of starting files for 1D
96logical                :: found
97character(30)          :: header
98real, dimension(100)   :: tab_cntrl
99
100! New flag to compute paleo orbital configurations + few variables JN
101logical :: paleomars
102real    :: halfaxe, eccentric, Lsperi
103
104! MVals: isotopes as in the dynamics (CRisi)
105integer                                  :: ipere, ierr0
106character(30), dimension(:), allocatable :: tnom_transp ! transporting fluid short name
107character(80)                            :: line        ! to store a line of text
108logical                                  :: continu
109
110! LL: Possibility to add subsurface ice
111real    :: ice_depth          ! depth of the ice table, ice_depth < 0. means no ice
112real    :: inertieice = 2100. ! ice thermal inertia
113integer :: iref
114
115!=======================================================================
116! Code
117!=======================================================================
118!------------------------------------------------------
119! Prescribed constants to be set here
120!------------------------------------------------------
121! Mars planetary constants
122! ------------------------
123rad = 3397200.            ! mars radius (m) ~3397200 m
124daysec = 88775.           ! length of a sol (s) ~88775 s
125omeg = 4.*asin(1.)/daysec ! rotation rate (rad.s-1)
126g = 3.72                  ! gravity (m.s-2) ~3.72
127mugaz = 43.49             ! atmosphere mola mass (g.mol-1) ~43.49
128rcp = .256793             ! = r/cp ~0.256793
129r = 8.314511*1000./mugaz
130cpp = r/rcp
131year_day = 669            ! length of year (sols) ~668.6
132periheli = 206.66         ! minimum sun-mars distance (Mkm) ~206.66
133aphelie = 249.22          ! maximum sun-mars distance (Mkm) ~249.22
134halfaxe = 227.94          ! demi-grand axe de l'ellipse
135peri_day = 485.           ! perihelion date (sols since N. Spring)
136obliquit = 25.2           ! Obliquity (deg) ~25.2
137eccentric = 0.0934        ! Eccentricity (0.0934)
138
139! Planetary Boundary Layer and Turbulence parameters
140! --------------------------------------------------
141z0_default = 1.e-2 ! surface roughness (m) ~0.01
142emin_turb = 1.e-6  ! minimal turbulent energy ~1.e-8
143lmixmin = 30       ! mixing length ~100
144
145! Cap properties and surface emissivities
146! ---------------------------------------
147emissiv = 0.95         ! Bare ground emissivity ~.95
148emisice(1) = 0.95      ! Northern cap emissivity
149emisice(2) = 0.95      ! Southern cap emisssivity
150albedice(1) = 0.5      ! Northern cap albedo
151albedice(2) = 0.5      ! Southern cap albedo
152iceradius(1) = 100.e-6 ! mean scat radius of CO2 snow (north)
153iceradius(2) = 100.e-6 ! mean scat radius of CO2 snow (south)
154dtemisice(1) = 2.      ! time scale for snow metamorphism (north)
155dtemisice(2) = 2.      ! time scale for snow metamorphism (south)
156
157! Mesh surface (not a very usefull quantity in 1D)
158! ------------------------------------------------
159cell_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! -----------------------------------------------------
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! Coefficient to control the surface pressure change
309! To be defined in "callphys.def" so that the PEM can read it asa well
310! --------------------------------------------------------------------
311CO2cond_ps = 1. ! Default value
312write(*,*) 'Coefficient to control the surface pressure change?'
313call getin("CO2cond_ps",CO2cond_ps)
314if (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!'
317endif
318
319! Reference pressures
320pa = 20.     ! Transition pressure (for hybrid coord.)
321preff = 610. ! Reference surface pressure
322
323! Aerosol properties
324! ------------------
325tauvis = 0.2 ! Default value for tauvis (dust opacity)
326write(*,'("Reference dust opacity at ",f4.0," Pa?")')odpref
327call getin("tauvis",tauvis)
328write(*,*) " tauvis = ",tauvis
329
330! Orbital parameters
331! ------------------
332if (.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
373endif !(.not. therestartfi)
374
375! Latitude/longitude
376! ------------------
377latitude = 0. ! default value for latitude
378write(*,*)'latitude (in degrees)?'
379call getin("latitude",latitude(1))
380write(*,*) " latitude = ",latitude
381latitude = latitude*pi/180.
382longitude = 0.
383longitude = 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
389call init_interface_dyn_phys
390call init_regular_lonlat(1,1,longitude,latitude,(/0.,0./),(/0.,0./))
391call init_geometry(1,longitude,latitude,(/0.,0.,0.,0./),(/0.,0.,0.,0./),cell_area)
392call 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)
395call init_dimphy(1,nlayer) ! Initialize dimphy module
396call phys_state_var_init(1,llm,nq,tname,day0,dayn,time,daysec,dttestphys,rad,g,r,cpp,nqperes,nqfils) ! MVals: variables isotopes
397call ini_fillgeom(1,latitude,longitude,(/1.0/))
398call conf_phys(1,llm,nq)
399call 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
403if (iphysiq /= 1) then
404    write(*,*) "init_testphys1d: setting iphysiq=1"
405    iphysiq = 1
406endif
407
408! Initialize local slope parameters
409! ---------------------------------
410nslope = 1 ! default: one slope
411if (.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,:)
484endif
485
486! Slope inclination angle (deg) 0: horizontal, 90: vertical
487theta_sl = 0. ! default: no inclination
488call getin("slope_inclination",theta_sl)
489
490! Slope orientation (deg)
491! 0 == Northward, 90 == Eastward, 180 == Southward, 270 == Westward
492psi_sl = 0. ! default value
493call getin("slope_orientation",psi_sl)
494
495! Initialize tracers (surface and atmosphere)
496!--------------------------------------------
497write(*,*) "init_testphys1d: initializing tracers"
498if (.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
503else
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
512endif
513
514! Initialize albedo / soil thermal inertia
515! ----------------------------------------
516if (.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)
536endif !(.not. therestartfi)
537
538! For the gravity wave scheme
539! ---------------------------
540zmea(1) = 0.
541zstd(1) = 0.
542zsig(1) = 0.
543zgam(1) = 0.
544zthe(1) = 0.
545
546! For the non-orographic gravity waves scheme
547du_nonoro_gwd(1,:) = 0
548dv_nonoro_gwd(1,:) = 0
549
550! For the slope wind scheme
551! -------------------------
552hmons(1) = 0.
553write(*,*)'hmons is initialized to ',hmons(1)
554summit(1) = 0.
555write(*,*)'summit is initialized to ',summit(1)
556base(1) = 0.
557
558! Default values initializing the coefficients calculated later
559! -------------------------------------------------------------
560tauscaling(1) = 1.   ! calculated in aeropacity_mod.F
561totcloudfrac(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
567phisfi(1) = 0.
568
569! Initialization to take into account prescribed winds
570! ----------------------------------------------------
571ptif = 2.*omeg*sinlat(1)
572
573! Geostrophic wind
574gru = 10. ! default value for gru
575write(*,*)'zonal eastward component of the geostrophic wind (m/s)?'
576call getin("u",gru)
577write(*,*) " u = ",gru
578grv = 0. !default value for grv
579write(*,*)'meridional northward component of the geostrophic wind (m/s)?'
580call getin("v",grv)
581write(*,*) " v = ",grv
582
583! Initialize winds for first time step
584!-------------------------------------
585if (.not. therestart1D) then
586    u = gru
587    v = grv
588else
589    read(3,*) header, (u(ilayer), ilayer = 1,nlayer)
590    read(3,*) header, (v(ilayer), ilayer = 1,nlayer)
591endif
592w = 0. ! default: no vertical wind
593
594! Initialize turbulent kinetic energy
595!------------------------------------
596q2 = 0.
597
598! CO2 ice on the surface
599! ----------------------
600if (.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)
606endif !(.not. therestartfi)
607
608! Emissivity
609! ----------
610if (.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
616endif !(.not. therestartfi)
617
618! Compute pressures and altitudes of atmospheric levels
619! -----------------------------------------------------
620! Vertical Coordinates
621! """"""""""""""""""""
622hybrid = .true.
623write(*,*)'Hybrid coordinates?'
624call getin("hybrid",hybrid)
625write(*,*) " hybrid = ", hybrid
626
627call disvert_noterre
628! Now that disvert has been called, initialize module vertical_layers_mod
629call init_vertical_layers(nlayer,preff,scaleheight,ap,bp,aps,bps,presnivs,pseudoalt)
630
631plev = ap + psurf*bp
632play = aps + psurf*bps
633zlay = -200.*r*log(play/plev(1))/g
634
635! Initialize temperature profile
636! ------------------------------
637pks = psurf**rcp
638
639! Altitude in km in profile: divide zlay by 1000
640tmp1(0) = 0.
641tmp1(1:) = zlay/1000.
642
643call profile(nlayer + 1,tmp1,tmp2)
644
645if (.not. therestart1D) then
646    tsurf = tmp2(0)
647    temp = tmp2(1:)
648else
649    read(3,*) header, (tsurf(1,:), j = 1,size(tsurf,2)), (temp(ilayer), ilayer = 1,nlayer)
650    close(3)
651endif
652
653! Initialize soil properties and temperature
654! ------------------------------------------
655volcapa = 1.e6 ! volumetric heat capacity
656
657if (.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
692endif !(.not. therestartfi)
693
694! Initialize subsurface geothermal flux
695! -------------------------------------
696flux_geo = 0.
697call getin("flux_geo",flux_geo(1,1))
698write(*,*) " flux_geo = ",flux_geo(1,1)
699flux_geo = flux_geo(1,1)
700
701! Initialize soil content
702! -----------------------
703if (.not. therestartfi) qsoil = 0.
704
705! Initialize depths
706! -----------------
707do isoil = 0,nsoil - 1
708    mlayer(isoil) = 2.e-4*(1 + isoil**2.9*(1 - exp(-real(isoil)/20.))) ! mid layer depth
709enddo
710do isoil = 1,nsoil - 1
711    layer(isoil) = (mlayer(isoil) + mlayer(isoil - 1))/2
712enddo
713layer(nsoil) = 2*mlayer(nsoil - 1) - mlayer(nsoil - 2)
714
715! Initialize traceurs
716! -------------------
717if (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)
737endif
738
739! Check if the surface is a water ice reservoir
740! ---------------------------------------------
741if (.not. therestartfi) watercap(1,:) = 0 ! Initialize watercap
742watercaptag(1) = .false. ! Default: no water ice reservoir
743write(*,*)'Water ice cap on ground?'
744call getin("watercaptag",watercaptag)
745write(*,*) " watercaptag = ",watercaptag
746
747! Initialize perennial_co2ice
748! ---------------------------
749if (.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
754atm_wat_profile = -1. ! Default: free atm wat profile
755if (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
774endif
775
776! Check if the atmospheric water profile relaxation is specified
777! --------------------------------------------------------------
778! Adding an option to relax atmospheric water values JBC
779atm_wat_tau = -1. ! Default: no time relaxation
780if (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
795endif
796
797END SUBROUTINE init_testphys1d
798
799END MODULE init_testphys1d_mod
Note: See TracBrowser for help on using the repository browser.