52 integer :: ix,jy,kz,i,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
54 real :: ylat,gridarea,ylatp,ylatm,hzone,cosfactm,cosfactp
55 real :: xlon,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
56 real,
parameter :: eps=nxmax/3.e5
63 ylat=outlat0+(
real(jy)+0.5)*dyout
66 if ((ylatm.lt.0).and.(ylatp.gt.0.))
then
67 hzone=dyout*r_earth*pi180
74 cosfactp=cos(ylatp*pi180)
75 cosfactm=cos(ylatm*pi180)
76 if (cosfactp.lt.cosfactm)
then
77 hzone=sqrt(1-cosfactp**2)- &
81 hzone=sqrt(1-cosfactm**2)- &
90 gridarea=2.*pi*r_earth*hzone*dxout/360.
98 volume(ix,jy,1)=area(ix,jy)*outheight(1)
99 areaeast(ix,jy,1)=dyout*r_earth*pi180*outheight(1)
100 areanorth(ix,jy,1)=cos(ylat*pi180)*dxout*r_earth*pi180* &
103 areaeast(ix,jy,kz)=dyout*r_earth*pi180* &
104 (outheight(kz)-outheight(kz-1))
105 areanorth(ix,jy,kz)=cos(ylat*pi180)*dxout*r_earth*pi180* &
106 (outheight(kz)-outheight(kz-1))
107 volume(ix,jy,kz)=area(ix,jy)*(outheight(kz)-outheight(kz-1))
130 ylat=outlat0+(
real(jjy)+
real(j1)/10.-0.05)*dyout
133 xlon=outlon0+(
real(iix)+
real(i1)/10.-0.05)*dxout
141 if ((xl.gt.xln(j)+eps).and.(xl.lt.xrn(j)-eps).and. &
142 (yl.gt.yln(j)+eps).and.(yl.lt.yrn(j)-eps))
then
153 xtn=(xl-xln(ngrid))*xresoln(ngrid)
154 ytn=(yl-yln(ngrid))*yresoln(ngrid)
175 oroh=oroh+p1*oron(ix ,jy ,ngrid) &
176 + p2*oron(ixp,jy ,ngrid) &
177 + p3*oron(ix ,jyp,ngrid) &
178 + p4*oron(ixp,jyp,ngrid)
180 oroh=oroh+p1*oro(ix ,jy) &
191 oroout(iix,jjy)=oroh/100.
197 allocate(flux(6,0:numxgrid-1,0:numygrid-1,numzgrid, &
198 1:nspec,1:maxpointspec_act,1:nageclass),stat=stat)
199 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate flux array '
203 if (ohrea.eqv..true.)
then
205 allocate(oh_field(12,0:maxxoh-1,0:maxyoh-1,maxzoh) &
207 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate OH array '
208 allocate(oh_field_height(7) &
210 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate OH array '
213 allocate(gridunc(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
214 maxpointspec_act,nclassunc,maxageclass),stat=stat)
215 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
216 if (ldirect.gt.0)
then
217 allocate(wetgridunc(0:numxgrid-1,0:numygrid-1,maxspec, &
218 maxpointspec_act,nclassunc,maxageclass),stat=stat)
219 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
220 allocate(drygridunc(0:numxgrid-1,0:numygrid-1,maxspec, &
221 maxpointspec_act,nclassunc,maxageclass),stat=stat)
222 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
227 write (*,*)
' Allocating fields for nested and global output (x,y): ', &
228 max(numxgrid,numxgridn),max(numygrid,numygridn)
233 allocate(gridsigma(0:max(numxgrid,numxgridn)-1, &
234 0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
235 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
236 allocate(grid(0:max(numxgrid,numxgridn)-1, &
237 0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
238 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
239 allocate(densityoutgrid(0:max(numxgrid,numxgridn)-1, &
240 0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
241 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
243 allocate(factor3d(0:max(numxgrid,numxgridn)-1, &
244 0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
245 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
246 allocate(sparse_dump_r(max(numxgrid,numxgridn)* &
247 max(numygrid,numygridn)*numzgrid),stat=stat)
248 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
249 allocate(sparse_dump_i(max(numxgrid,numxgridn)* &
250 max(numygrid,numygridn)*numzgrid),stat=stat)
251 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
254 if (ldirect.gt.0)
then
255 allocate(wetgridsigma(0:max(numxgrid,numxgridn)-1, &
256 0:max(numygrid,numygridn)-1),stat=stat)
257 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
258 allocate(drygridsigma(0:max(numxgrid,numxgridn)-1, &
259 0:max(numygrid,numygridn)-1),stat=stat)
260 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
261 allocate(wetgrid(0:max(numxgrid,numxgridn)-1, &
262 0:max(numygrid,numygridn)-1),stat=stat)
263 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
264 allocate(drygrid(0:max(numxgrid,numxgridn)-1, &
265 0:max(numygrid,numygridn)-1),stat=stat)
266 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate gridunc'
271 if (linit_cond.gt.0)
then
272 allocate(init_cond(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
273 maxpointspec_act),stat=stat)
274 if (stat.ne.0)
write(*,*)
'ERROR: could not allocate init_cond'
282 do kp=1,maxpointspec_act
292 if (ldirect.gt.0)
then
293 wetgridunc(ix,jy,ks,kp,l,nage)=0.
294 drygridunc(ix,jy,ks,kp,l,nage)=0.
300 flux(i,ix,jy,kz,ks,kp,nage)=0.
304 if ((l.eq.1).and.(nage.eq.1).and.(linit_cond.gt.0)) &
305 init_cond(ix,jy,kz,ks,kp)=0.
307 gridunc(ix,jy,kz,ks,kp,l,nage)=0.