1 | PROGRAM testphys1d |
---|
2 | |
---|
3 | use comsoil_h, only: inertiedat, inertiesoil, nsoilmx, tsoil |
---|
4 | use surfdat_h, only: albedodat, perenial_co2ice, watercap, tsurf, emis, qsurf |
---|
5 | use comslope_mod, only: def_slope, subslope_dist |
---|
6 | use phyredem, only: physdem0, physdem1 |
---|
7 | use watersat_mod, only: watersat |
---|
8 | use tracer_mod, only: igcm_h2o_vap, igcm_h2o_ice, noms |
---|
9 | use comcstfi_h, only: pi, rad, omeg, g, mugaz, rcp, r, cpp |
---|
10 | use time_phylmdz_mod, only: daysec, day_step |
---|
11 | use dimradmars_mod, only: tauvis, totcloudfrac, albedo |
---|
12 | use dust_param_mod, only: tauscaling |
---|
13 | use comvert_mod, only: ap, bp, aps, bps, pa, preff, sig |
---|
14 | use physiq_mod, only: physiq |
---|
15 | use turb_mod, only: q2 |
---|
16 | use write_output_mod, only: write_output |
---|
17 | use init_testphys1d_mod, only: init_testphys1d |
---|
18 | ! Mostly for XIOS outputs: |
---|
19 | use mod_const_mpi, only: init_const_mpi |
---|
20 | use parallel_lmdz, only: init_parallel |
---|
21 | |
---|
22 | implicit none |
---|
23 | |
---|
24 | !======================================================================= |
---|
25 | ! subject: |
---|
26 | ! -------- |
---|
27 | ! PROGRAM useful to run physical part of the martian GCM in a 1D column |
---|
28 | ! |
---|
29 | ! Can be compiled with a command like (e.g. for 25 layers) |
---|
30 | ! "makegcm -p mars -d 25 testphys1d" |
---|
31 | ! It requires the files "testphys1d.def" "callphys.def" |
---|
32 | ! and a 'run.def' file (containing a "INCLUDEDEF=callphys.def" line) |
---|
33 | ! and a file describing the sigma layers (e.g. "z2sig.def") |
---|
34 | ! |
---|
35 | ! author: Frederic Hourdin, R.Fournier,F.Forget |
---|
36 | ! ------- |
---|
37 | ! |
---|
38 | ! update: 12/06/2003, including chemistry (S. Lebonnois) |
---|
39 | ! and water ice (F. Montmessin) |
---|
40 | ! 27/09/2023, upgrade to F90 (JB Clément) |
---|
41 | ! |
---|
42 | !======================================================================= |
---|
43 | |
---|
44 | include "dimensions.h" |
---|
45 | !#include "dimradmars.h" |
---|
46 | !#include "comgeomfi.h" |
---|
47 | !#include "surfdat.h" |
---|
48 | !#include "slope.h" |
---|
49 | !#include "comsoil.h" |
---|
50 | !#include "comdiurn.h" |
---|
51 | include "callkeys.h" |
---|
52 | !#include "comsaison.h" |
---|
53 | !#include "control.h" |
---|
54 | include "netcdf.inc" |
---|
55 | !#include "advtrac.h" |
---|
56 | |
---|
57 | !-------------------------------------------------------------- |
---|
58 | ! Declarations |
---|
59 | !-------------------------------------------------------------- |
---|
60 | integer, parameter :: ngrid = 1 ! (2+(jjm-1)*iim - 1/jjm) |
---|
61 | integer, parameter :: nlayer = llm |
---|
62 | real, parameter :: odpref = 610. ! DOD reference pressure (Pa) |
---|
63 | integer :: unitstart ! unite d'ecriture de "startfi" |
---|
64 | integer :: ndt, ilayer, ilevel, isoil, idt, iq |
---|
65 | logical :: firstcall, lastcall |
---|
66 | integer :: day0 ! initial (sol ; =0 at Ls=0) |
---|
67 | real :: day ! date during the run |
---|
68 | real :: time ! time (0<time<1 ; time=0.5 a midi) |
---|
69 | real :: dttestphys ! testphys1d timestep |
---|
70 | real, dimension(nlayer) :: play ! Pressure at the middle of the layers (Pa) |
---|
71 | real, dimension(nlayer + 1) :: plev ! intermediate pressure levels (pa) |
---|
72 | real :: psurf ! Surface pressure |
---|
73 | real, dimension(nlayer) :: u, v ! zonal, meridional wind |
---|
74 | real :: gru, grv ! prescribed "geostrophic" background wind |
---|
75 | real, dimension(nlayer) :: temp ! temperature at the middle of the layers |
---|
76 | real, dimension(:,:,:), allocatable :: q ! tracer mixing ratio (e.g. kg/kg) |
---|
77 | real, dimension(1) :: wstar = 0. ! Thermals vertical velocity |
---|
78 | |
---|
79 | ! Physical and dynamical tandencies (e.g. m.s-2, K/s, Pa/s) |
---|
80 | real, dimension(nlayer) :: du, dv, dtemp, dudyn, dvdyn, dtempdyn |
---|
81 | real, dimension(1) :: dpsurf |
---|
82 | real, dimension(:,:,:), allocatable :: dq, dqdyn |
---|
83 | |
---|
84 | ! Various intermediate variables |
---|
85 | integer :: aslun |
---|
86 | real :: zls, pks, ptif, qtotinit, qtot |
---|
87 | real, dimension(nlayer) :: phi, h, s, w |
---|
88 | integer :: nq = 1 ! number of tracers |
---|
89 | real, dimension(1) :: latitude, longitude, cell_area |
---|
90 | logical :: there |
---|
91 | character(len = 2) :: str2 |
---|
92 | character(len = 7) :: str7 |
---|
93 | character(len = 44) :: txt |
---|
94 | |
---|
95 | ! RV & JBC: Use of starting files for 1D |
---|
96 | logical :: startfiles_1D, therestart1D, therestartfi |
---|
97 | |
---|
98 | ! JN & JBC: Force atmospheric water profiles |
---|
99 | real :: atm_wat_profile, atm_wat_tau |
---|
100 | real, dimension(:), allocatable :: zqsat ! useful for (atm_wat_profile=2) |
---|
101 | !======================================================================= |
---|
102 | |
---|
103 | !======================================================================= |
---|
104 | ! INITIALISATION |
---|
105 | !======================================================================= |
---|
106 | #ifdef CPP_XIOS |
---|
107 | call init_const_mpi |
---|
108 | call init_parallel |
---|
109 | #endif |
---|
110 | |
---|
111 | ! Initialize "serial/parallel" related stuff |
---|
112 | !call init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/)) |
---|
113 | !call init_phys_lmdz(1,1,llm,1,(/1/)) |
---|
114 | !call initcomgeomphy |
---|
115 | |
---|
116 | call init_testphys1d(.false.,ngrid,nlayer,odpref,nq,q,time,psurf,u,v,temp,startfiles_1D,therestart1D, & |
---|
117 | therestartfi,ndt,ptif,pks,dttestphys,zqsat,dq,dqdyn,day0,day,gru,grv,w, & |
---|
118 | play,plev,latitude,longitude,cell_area,atm_wat_profile,atm_wat_tau) |
---|
119 | |
---|
120 | ! Write a "startfi" file |
---|
121 | ! ---------------------- |
---|
122 | ! This file will be read during the first call to "physiq". |
---|
123 | ! It is needed to transfert physics variables to "physiq"... |
---|
124 | if (.not. therestartfi) then |
---|
125 | call physdem0("startfi.nc",longitude,latitude,nsoilmx,ngrid, & |
---|
126 | llm,nq,dttestphys,float(day0),0.,cell_area, & |
---|
127 | albedodat,inertiedat,def_slope,subslope_dist) |
---|
128 | call physdem1("startfi.nc",nsoilmx,ngrid,llm,nq,dttestphys,time, & |
---|
129 | tsurf,tsoil,inertiesoil,albedo,emis,q2,qsurf,tauscaling, & |
---|
130 | totcloudfrac,wstar,watercap,perenial_co2ice) |
---|
131 | endif !(.not. therestartfi) |
---|
132 | |
---|
133 | !======================================================================= |
---|
134 | ! 1D MODEL TIME STEPPING LOOP |
---|
135 | !======================================================================= |
---|
136 | firstcall = .true. |
---|
137 | lastcall = .false. |
---|
138 | do idt = 1,ndt |
---|
139 | if (idt == ndt) lastcall = .true. |
---|
140 | ! if (idt == ndt - day_step - 1) then ! test |
---|
141 | ! lastcall = .true. |
---|
142 | ! call solarlong(day*1.0,zls) |
---|
143 | ! write(103,*) 'Ls=',zls*180./pi |
---|
144 | ! write(103,*) 'Lat=', latitude(1)*180./pi |
---|
145 | ! write(103,*) 'Tau=', tauvis/odpref*psurf |
---|
146 | ! write(103,*) 'RunEnd - Atmos. Temp. File' |
---|
147 | ! write(103,*) 'RunEnd - Atmos. Temp. File' |
---|
148 | ! write(104,*) 'Ls=',zls*180./pi |
---|
149 | ! write(104,*) 'Lat=', latitude(1) |
---|
150 | ! write(104,*) 'Tau=', tauvis/odpref*psurf |
---|
151 | ! write(104,*) 'RunEnd - Atmos. Temp. File' |
---|
152 | ! endif |
---|
153 | |
---|
154 | ! Compute geopotential |
---|
155 | ! ~~~~~~~~~~~~~~~~~~~~ |
---|
156 | s(:) = (aps(:)/psurf + bps(:))**rcp |
---|
157 | h(:) = cpp*temp(:)/(pks*s(:)) |
---|
158 | |
---|
159 | phi(1) = pks*h(1)*(1. - s(1)) |
---|
160 | do ilayer = 2,nlayer |
---|
161 | phi(ilayer) = phi(ilayer - 1) + pks*(h(ilayer - 1) + h(ilayer))*.5*(s(ilayer - 1) - s(ilayer)) |
---|
162 | enddo |
---|
163 | |
---|
164 | ! Modify atmospheric water if asked |
---|
165 | ! Added "atm_wat_profile" flag (JN + JBC) |
---|
166 | ! --------------------------------------- |
---|
167 | if (water) then |
---|
168 | call watersat(nlayer,temp,play,zqsat) |
---|
169 | if (0. <= atm_wat_profile .and. atm_wat_profile <= 1.) then |
---|
170 | ! If atmospheric water is monitored |
---|
171 | if (atm_wat_tau < 0.) then ! Prescribed atm_wat_profile: wet if >0, dry if =0 |
---|
172 | q(1,:,igcm_h2o_vap) = min(zqsat(:),atm_wat_profile*g/psurf) |
---|
173 | q(1,:,igcm_h2o_ice) = 0. ! reset h2o ice |
---|
174 | else ! Relaxation towards the value atm_wat_profile with relaxation time atm_wat_tau |
---|
175 | q(1,:,igcm_h2o_vap) = atm_wat_profile*g/psurf + (q(1,:,igcm_h2o_vap) - atm_wat_profile*g/psurf)*dexp(-dttestphys/atm_wat_tau) |
---|
176 | q(1,:,igcm_h2o_vap) = min(zqsat(:),q(1,:,igcm_h2o_vap)) |
---|
177 | q(1,:,igcm_h2o_ice) = 0. ! reset h2o ice |
---|
178 | endif |
---|
179 | endif |
---|
180 | endif |
---|
181 | |
---|
182 | ! Call physics |
---|
183 | ! -------------------- |
---|
184 | call physiq(1,llm,nq,firstcall,lastcall,day,time,dttestphys,plev,play,phi,u,v,temp,q,w,du,dv,dtemp,dq,dpsurf) |
---|
185 | ! ^----- outputs -----^ |
---|
186 | |
---|
187 | ! Wind increment: specific for 1D |
---|
188 | ! -------------------------------- |
---|
189 | ! The physics compute the tendencies on u and v, |
---|
190 | ! here we just add Coriolos effect |
---|
191 | !do ilayer = 1,nlayer |
---|
192 | ! du(ilayer) = du(ilayer) + ptif*(v(ilayer) - grv) |
---|
193 | ! dv(ilayer) = dv(ilayer) + ptif*(-u(ilayer) + gru) |
---|
194 | !enddo |
---|
195 | ! For some tests: No coriolis force at equator |
---|
196 | !if (latitude(1) == 0.) then |
---|
197 | du(:) = du(:) + (gru - u(:))/1.e4 |
---|
198 | dv(:) = dv(:) + (grv - v(:))/1.e4 |
---|
199 | !endif |
---|
200 | |
---|
201 | ! Compute time for next time step |
---|
202 | ! ------------------------------- |
---|
203 | firstcall = .false. |
---|
204 | time = time + dttestphys/daysec |
---|
205 | if (time > 1.) then |
---|
206 | time = time - 1. |
---|
207 | day = day + 1 |
---|
208 | endif |
---|
209 | |
---|
210 | ! Compute winds and temperature for next time step |
---|
211 | ! ------------------------------------------------ |
---|
212 | u(:) = u(:) + dttestphys*du(:) |
---|
213 | v(:) = v(:) + dttestphys*dv(:) |
---|
214 | temp(:) = temp(:) + dttestphys*dtemp(:) |
---|
215 | |
---|
216 | ! Compute pressure for next time step |
---|
217 | ! ----------------------------------- |
---|
218 | psurf = psurf + dttestphys*dpsurf(1) ! surface pressure change |
---|
219 | plev(:) = ap(:) + psurf*bp(:) |
---|
220 | play(:) = aps(:) + psurf*bps(:) |
---|
221 | |
---|
222 | ! Increment tracers |
---|
223 | q(1,:,:) = q(1,:,:) + dttestphys*dq(1,:,:) |
---|
224 | enddo ! End of time stepping loop (idt=1,ndt) |
---|
225 | |
---|
226 | ! Writing the "restart1D.txt" file for the next run |
---|
227 | if (startfiles_1D) call writerestart1D('restart1D.txt',psurf,tsurf(:,1),nlayer,temp,u,v,nq,noms,qsurf(1,:,1),q) |
---|
228 | |
---|
229 | write(*,*) "testphys1d: everything is cool." |
---|
230 | |
---|
231 | END PROGRAM testphys1d |
---|
232 | |
---|
233 | !*********************************************************************** |
---|
234 | !*********************************************************************** |
---|
235 | ! Dummy subroutine used only in 3D, but required to |
---|
236 | ! compile testphys1d (to cleanly use writediagfi) |
---|
237 | SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn) |
---|
238 | |
---|
239 | implicit none |
---|
240 | |
---|
241 | integer :: im, jm, ngrid, nfield |
---|
242 | real, dimension(im,jm,nfield) :: pdyn |
---|
243 | real, dimension(ngrid,nfield) :: pfi |
---|
244 | |
---|
245 | if (ngrid /= 1) then |
---|
246 | write(*,*) "gr_fi_dyn error: in 1D ngrid should be 1!!!" |
---|
247 | stop |
---|
248 | endif |
---|
249 | |
---|
250 | pdyn(1,1,1:nfield) = pfi(1,1:nfield) |
---|
251 | |
---|
252 | END SUBROUTINE gr_fi_dyn |
---|
253 | |
---|
254 | !*********************************************************************** |
---|
255 | !*********************************************************************** |
---|