1 | MODULE physics_dry_mod |
---|
2 | USE ICOSA |
---|
3 | PUBLIC init_physics_dry, physics_dry |
---|
4 | |
---|
5 | CONTAINS |
---|
6 | |
---|
7 | SUBROUTINE init_physics_dry |
---|
8 | USE ICOSA !sarvesh |
---|
9 | USE time_mod !sarvesh |
---|
10 | USE dimphys_mod |
---|
11 | USE RADIATION |
---|
12 | |
---|
13 | IMPLICIT NONE |
---|
14 | INTEGER::i,j,ij |
---|
15 | !-------------------------------------- ORBITAL PARAMETER---- |
---|
16 | periheli=150. |
---|
17 | CALL getin('periheli', periheli) |
---|
18 | aphelie=150. |
---|
19 | CALL getin('aphelie',aphelie) |
---|
20 | coefir=0.08 |
---|
21 | CALL getin('coefir',coefir) |
---|
22 | coefvis=0.99 |
---|
23 | CALL getin('coefvis',coefvis) |
---|
24 | obliquit=0.0 |
---|
25 | CALL getin('obliquit',obliquit) |
---|
26 | peri_day=0. |
---|
27 | CALL getin('peri_day',peri_day) |
---|
28 | year_day=360. |
---|
29 | CALL getin('year_day',year_day) |
---|
30 | callrad=.true. |
---|
31 | CALL getin('callrad', callrad) |
---|
32 | calldifv=.true. |
---|
33 | CALL getin('calldifv', calldifv) |
---|
34 | calladj=.true. |
---|
35 | CALL getin('calladj', calladj) |
---|
36 | callcond=.true. |
---|
37 | callsoil=.true. |
---|
38 | CALL getin('callsoil',callsoil) |
---|
39 | season=.true. |
---|
40 | CALL getin('season',season) |
---|
41 | diurnal=.true. |
---|
42 | CALL getin('diurnal',diurnal) |
---|
43 | lverbose=.false. |
---|
44 | CALL getin('lverbose',lverbose) |
---|
45 | period_sort=1. |
---|
46 | CALL getin('period_sort',period_sort) |
---|
47 | ! ptimestep=dt |
---|
48 | ! CALL getin('ptimestep',ptimestep) |
---|
49 | |
---|
50 | print*,'Activation de la physique:' |
---|
51 | print*,' Rayonnement ',callrad |
---|
52 | print*,' Diffusion verticale turbulente ', calldifv |
---|
53 | print*,' Ajustement convectif ',calladj |
---|
54 | print*,' Sol ',callsoil |
---|
55 | print*,' Cycle diurne ',diurnal |
---|
56 | ! choice of the frequency of the computation of radiations |
---|
57 | IF(diurnal) THEN |
---|
58 | iradia=NINT(daysec/(20.*dt)) |
---|
59 | ELSE |
---|
60 | iradia=NINT(daysec/(4.*dt)) |
---|
61 | ENDIF |
---|
62 | iradia=1 |
---|
63 | |
---|
64 | ngridmx=iim*jjm ; nlayermx=llm |
---|
65 | offset=halo |
---|
66 | |
---|
67 | ALLOCATE(albedo(ngridmx));ALLOCATE(emissiv(ngridmx)) |
---|
68 | ALLOCATE(inertie(ngridmx));ALLOCATE(z0(ngridmx)) |
---|
69 | ALLOCATE(rnatur(ngridmx));ALLOCATE(tsurf(ngridmx)) |
---|
70 | ALLOCATE(tsoil(ngridmx,nlayermx));ALLOCATE(fluxgrd(ngridmx)) |
---|
71 | ALLOCATE(fluxrad(ngridmx));ALLOCATE(dtrad(ngridmx,llm+1)) |
---|
72 | ALLOCATE(q2(ngridmx,llm+1));ALLOCATE(q2l(ngridmx,llm+1)) |
---|
73 | ALLOCATE(capcal(ngridmx)) |
---|
74 | |
---|
75 | CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit) |
---|
76 | |
---|
77 | PRINT*,'unjours',daysec |
---|
78 | PRINT*,'The radiative transfer is computed each ', iradia,' physical time-step or each ', & |
---|
79 | iradia*dt,' seconds' |
---|
80 | END SUBROUTINE init_physics_dry |
---|
81 | |
---|
82 | |
---|
83 | SUBROUTINE physics_dry( it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) |
---|
84 | USE icosa |
---|
85 | IMPLICIT NONE |
---|
86 | INTEGER,INTENT(IN) :: it |
---|
87 | REAL(rstd),INTENT(IN) :: jD_cur,jH_cur |
---|
88 | TYPE(t_field),POINTER :: f_phis(:) |
---|
89 | TYPE(t_field),POINTER :: f_ps(:) |
---|
90 | TYPE(t_field),POINTER :: f_theta_rhodz(:) |
---|
91 | TYPE(t_field),POINTER :: f_ue(:) |
---|
92 | TYPE(t_field),POINTER :: f_q(:) |
---|
93 | |
---|
94 | REAL(rstd),POINTER :: phis(:) |
---|
95 | REAL(rstd),POINTER :: ps(:) |
---|
96 | REAL(rstd),POINTER :: theta_rhodz(:,:) |
---|
97 | REAL(rstd),POINTER :: ue(:,:) |
---|
98 | REAL(rstd),POINTER :: q(:,:,:) |
---|
99 | ! REAL(rstd),POINTER :: precl(:) |
---|
100 | INTEGER :: ind |
---|
101 | ! LOGICAL:: firstcall,lastcall |
---|
102 | |
---|
103 | CALL transfert_request(f_ue,req_e1_vect) |
---|
104 | CALL transfert_request(f_theta_rhodz,req_i1) |
---|
105 | |
---|
106 | DO ind=1,ndomain |
---|
107 | CALL swap_dimensions(ind) |
---|
108 | CALL swap_geometry(ind) |
---|
109 | phis=f_phis(ind) |
---|
110 | ps=f_ps(ind) |
---|
111 | theta_rhodz=f_theta_rhodz(ind) |
---|
112 | ue=f_ue(ind) |
---|
113 | q=f_q(ind) |
---|
114 | ! out_i=f_out_i(ind) |
---|
115 | ! precl=f_precl(ind) |
---|
116 | ! print*,"====================================ind",ind,"----------it",it |
---|
117 | CALL compute_physics_dry(it,jD_cur,jH_cur,phis, ps, theta_rhodz, ue, q(:,:,1)) |
---|
118 | ENDDO |
---|
119 | |
---|
120 | ! CALL writefield("out_i",f_out_i) |
---|
121 | |
---|
122 | ! IF (mod(it,itau_out)==0 ) THEN |
---|
123 | ! CALL writefield("precl",f_precl) |
---|
124 | ! ENDIF |
---|
125 | |
---|
126 | END SUBROUTINE physics_dry |
---|
127 | |
---|
128 | SUBROUTINE compute_physics_dry(it,jD_cur,jH_cur,phis, ps, theta_rhodz, ue, q) |
---|
129 | USE icosa |
---|
130 | USE pression_mod |
---|
131 | USE exner_mod |
---|
132 | USE theta2theta_rhodz_mod |
---|
133 | USE geopotential_mod |
---|
134 | USE wind_mod |
---|
135 | USE PHY |
---|
136 | |
---|
137 | IMPLICIT NONE |
---|
138 | INTEGER::it |
---|
139 | REAL(rstd) :: jD_cur |
---|
140 | REAL(rstd) :: jH_cur |
---|
141 | REAL(rstd) :: phis(iim*jjm) |
---|
142 | REAL(rstd) :: ps(iim*jjm) |
---|
143 | REAL(rstd) :: theta_rhodz(iim*jjm,llm) |
---|
144 | REAL(rstd) :: ue(3*iim*jjm,llm) |
---|
145 | REAL(rstd) :: q(iim*jjm,llm) |
---|
146 | ! REAL(rstd) :: precl(iim*jjm) |
---|
147 | |
---|
148 | REAL(rstd) :: p(iim*jjm,llm+1) |
---|
149 | REAL(rstd) :: pks(iim*jjm) |
---|
150 | REAL(rstd) :: pk(iim*jjm,llm) |
---|
151 | REAL(rstd) :: phi(iim*jjm,llm) |
---|
152 | REAL(rstd) :: T(iim*jjm,llm) |
---|
153 | REAL(rstd) :: Tfi(iim*jjm,llm) |
---|
154 | REAL(rstd) :: theta(iim*jjm,llm) |
---|
155 | |
---|
156 | REAL(rstd) :: uc(iim*jjm,3,llm) |
---|
157 | REAL(rstd) :: u(iim*jjm,llm) |
---|
158 | REAL(rstd) :: v(iim*jjm,llm) |
---|
159 | REAL(rstd) :: ufi(iim*jjm,llm) |
---|
160 | REAL(rstd) :: vfi(iim*jjm,llm) |
---|
161 | REAL(rstd) :: qfi(iim*jjm,llm) |
---|
162 | REAL(rstd) :: utemp(iim*jjm,llm) |
---|
163 | REAL(rstd) :: vtemp(iim*jjm,llm) |
---|
164 | REAL(rstd) :: lat(iim*jjm) |
---|
165 | REAL(rstd) :: lon(iim*jjm) |
---|
166 | REAL(rstd) :: pmid(iim*jjm,llm) |
---|
167 | REAL(rstd) :: pint(iim*jjm,llm+1) |
---|
168 | REAL(rstd) :: pdel(iim*jjm,llm) |
---|
169 | REAL(rstd) :: plev(iim*jjm,llm+1),play(iim*jjm,llm) |
---|
170 | REAL(rstd) :: pkbycp |
---|
171 | INTEGER :: i,j,l,ij,ig |
---|
172 | |
---|
173 | !------------------- |
---|
174 | ! LOGICAL:: firstcall,lastcall |
---|
175 | REAL(rstd) :: dufi(iim*jjm,llm) |
---|
176 | REAL(rstd) :: dvfi(iim*jjm,llm) |
---|
177 | REAL(rstd) :: dTfi(iim*jjm,llm) |
---|
178 | REAL(rstd) :: dpsfi(iim*jjm) |
---|
179 | REAL(rstd) :: dqfi(iim*jjm,llm) |
---|
180 | ! PRINT *,'Entering in LMD SIMPLE physics' |
---|
181 | |
---|
182 | |
---|
183 | offset=halo |
---|
184 | CALL compute_pression(ps,p,halo) |
---|
185 | CALL compute_exner(ps,p,pks,pk,halo) |
---|
186 | CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,halo) |
---|
187 | CALL compute_geopotential(phis,pks,pk,theta,phi,halo) |
---|
188 | CALL compute_theta_rhodz2temperature(ps,theta_rhodz,T,halo) |
---|
189 | CALL compute_wind_centered(ue,uc) |
---|
190 | CALL compute_wind_centered_lonlat_compound(uc, u, v) |
---|
191 | |
---|
192 | DO j=jj_begin-offset,jj_end+offset |
---|
193 | DO i=ii_begin-offset,ii_end+offset |
---|
194 | ij=(j-1)*iim+i |
---|
195 | CALL xyz2lonlat(xyz_i(ij,:),lon(ij),lat(ij)) |
---|
196 | ENDDO |
---|
197 | ENDDO |
---|
198 | |
---|
199 | DO l=1,llm |
---|
200 | DO j=jj_begin-offset,jj_end+offset |
---|
201 | DO i=ii_begin-offset,ii_end+offset |
---|
202 | ij=(j-1)*iim+i |
---|
203 | ! Tfi(ij,l)=T(ij,l) |
---|
204 | ! ufi(ij,l)=u(ij,l) |
---|
205 | ! vfi(ij,l)=v(ij,l) |
---|
206 | ! qfi(ij,l)=q(ij,l) |
---|
207 | dTfi(ij,l)=0.0 |
---|
208 | dufi(ij,l)=0.0 |
---|
209 | dvfi(ij,l)=0.0 |
---|
210 | dqfi(ij,l)=0.0 |
---|
211 | ENDDO |
---|
212 | ENDDO |
---|
213 | ENDDO |
---|
214 | plev(:,:) = p(:,:) |
---|
215 | dpsfi=0.0 |
---|
216 | |
---|
217 | DO l=1,llm |
---|
218 | DO j=jj_begin-offset,jj_end+offset |
---|
219 | DO i=ii_begin-offset,ii_end+offset |
---|
220 | ij=(j-1)*iim+i |
---|
221 | pkbycp=pk(ij,l)/cpp |
---|
222 | play(ij,l)=preff*pkbycp**(1./kappa) |
---|
223 | ENDDO |
---|
224 | ENDDO |
---|
225 | ENDDO |
---|
226 | |
---|
227 | |
---|
228 | CALL phyparam_lmd(it,iim*jjm,llm,1,dt,lat,lon,jD_cur,jH_cur, & |
---|
229 | plev,play,phi,phis,u,v,T,q,dufi,dvfi,dTfi,dqfi,dpsfi) |
---|
230 | |
---|
231 | CALL ADDFI(u,v,T,q,ps,dufi,dvfi,dTfi,dqfi,dpsfi) |
---|
232 | |
---|
233 | ! CALL SARCHECKF(llm) |
---|
234 | ! print*,"plev",(maxval(plev(:,l)),l=1,llm+1) |
---|
235 | |
---|
236 | ! CALL phyparam_lmd(it,iim*jjm,llm,1,dt,lat,lon,jD_cur,jH_cur, & |
---|
237 | ! plev,play,phi,phis,ufi,vfi,Tfi,qfi,dufi,dvfi,dTfi,dqfi,dpsfi) |
---|
238 | |
---|
239 | ! Print*,"going ADD FI",it |
---|
240 | ! CALL ADDFI(ufi,vfi,Tfi,qfi,ps,dufi,dvfi,dTfi,dqfi,dpsfi) |
---|
241 | |
---|
242 | ! WRITE(11,*)"ducovfi",maxval(dufi),minval(dufi),it |
---|
243 | ! WRITE(11,*)"ucovfi",maxval(ufi),minval(ufi) |
---|
244 | ! WRITE(11,*)"dtetafi",maxval(dTfi),minval(dTfi) |
---|
245 | |
---|
246 | !============================================= |
---|
247 | ! go to 1234 |
---|
248 | DO l=1,llm |
---|
249 | DO j=jj_begin-offset,jj_end+offset |
---|
250 | DO i=ii_begin-offset,ii_end+offset |
---|
251 | ij=(j-1)*iim+i |
---|
252 | uc(ij,:,l)=(dufi(ij,l)*elon_i(ij,:)+dvfi(ij,l)*elat_i(ij,:))*dt |
---|
253 | ENDDO |
---|
254 | ENDDO |
---|
255 | ENDDO |
---|
256 | |
---|
257 | |
---|
258 | DO l=1,llm |
---|
259 | DO j=jj_begin-offset,jj_end+offset |
---|
260 | DO i=ii_begin-offset,ii_end+offset |
---|
261 | ij=(j-1)*iim+i |
---|
262 | ue(ij+u_right,l)=ue(ij+u_right,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:) ) |
---|
263 | ue(ij+u_lup,l)=ue(ij+u_lup,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) ) |
---|
264 | ue(ij+u_ldown,l)=ue(ij+u_ldown,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) ) |
---|
265 | ENDDO |
---|
266 | ENDDO |
---|
267 | ENDDO |
---|
268 | !1234 continue |
---|
269 | |
---|
270 | ! CALL compute_temperature2theta_rhodz(ps,Tfi,theta_rhodz,halo) |
---|
271 | CALL compute_temperature2theta_rhodz(ps,T,theta_rhodz,halo) |
---|
272 | |
---|
273 | ! WRITE(13,*)"tetafi",maxval(theta_rhodz),minval(theta_rhodz) |
---|
274 | RETURN |
---|
275 | END SUBROUTINE compute_physics_dry |
---|
276 | |
---|
277 | SUBROUTINE addfi(ufi,vfi,Tfi,qfi,ps,dufi,dvfi,dTfi,dqfi,dpsfi) |
---|
278 | USE ICOSA |
---|
279 | IMPLICIT NONE |
---|
280 | REAL(rstd) :: dufi(iim*jjm,llm) |
---|
281 | REAL(rstd) :: dvfi(iim*jjm,llm) |
---|
282 | REAL(rstd) :: dTfi(iim*jjm,llm) |
---|
283 | REAL(rstd) :: dpsfi(iim*jjm) |
---|
284 | REAL(rstd) :: dqfi(iim*jjm,llm) |
---|
285 | REAL(rstd) :: ufi(iim*jjm,llm) |
---|
286 | REAL(rstd) :: vfi(iim*jjm,llm) |
---|
287 | REAL(rstd) :: qfi(iim*jjm,llm) |
---|
288 | REAL(rstd) :: ps(iim*jjm) |
---|
289 | REAL(rstd) :: Tfi(iim*jjm,llm) |
---|
290 | INTEGER::i,j,l,ij,offset |
---|
291 | offset=halo |
---|
292 | |
---|
293 | DO l=1,llm |
---|
294 | DO j=jj_begin-offset,jj_end+offset |
---|
295 | DO i=ii_begin-offset,ii_end+offset |
---|
296 | ij=(j-1)*iim+i |
---|
297 | Tfi(ij,l)=Tfi(ij,l)+dTfi(ij,l)*dt |
---|
298 | ufi(ij,l)=ufi(ij,l)+dufi(ij,l)*dt |
---|
299 | vfi(ij,l)=vfi(ij,l)+dvfi(ij,l)*dt |
---|
300 | qfi(ij,l)=qfi(ij,l)+dqfi(ij,l)*dt |
---|
301 | END DO |
---|
302 | END DO |
---|
303 | END DO |
---|
304 | ps(:)=ps(:) + dpsfi(:)*dt |
---|
305 | END SUBROUTINE addfi |
---|
306 | |
---|
307 | END MODULE physics_dry_mod |
---|