/[MITgcm]/MITgcm/pkg/fizhi/update_chemistry_exports.F
ViewVC logotype

Annotation of /MITgcm/pkg/fizhi/update_chemistry_exports.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.5 - (hide annotations) (download)
Mon Jun 14 20:34:50 2004 UTC (20 years ago) by molod
Branch: MAIN
Changes since 1.4: +7 -8 lines
Reconcile bottom up (model) and top down (fizhi) level counting

1 molod 1.5 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/update_chemistry_exports.F,v 1.4 2004/06/11 18:50:04 molod Exp $
2 molod 1.1 C $Name: $
3    
4     subroutine update_chemistry_exports (myTime, myIter, myThid)
5     c----------------------------------------------------------------------
6     c Subroutine update_chemistry_exports - 'Wrapper' routine to update
7     c the fields related to the earth's chemistry that are needed
8     c by fizhi.
9     c Also: Set up "bi, bj loop" and some timers and clocks here.
10     c
11     c Call: interp_chemistry
12     c-----------------------------------------------------------------------
13     implicit none
14     #include "CPP_OPTIONS.h"
15     #include "SIZE.h"
16     #include "fizhi_SIZE.h"
17     #include "GRID.h"
18     #include "DYNVARS.h"
19 molod 1.2 #include "fizhi_chemistry_coms.h"
20 molod 1.4 #include "fizhi_coms.h"
21 molod 1.1 #include "gridalt_mapping.h"
22     #include "EEPARAMS.h"
23 molod 1.4 #include "chronos.h"
24 molod 1.1
25 molod 1.4 integer myTime, myIter, myThid
26 molod 1.1
27     c pe on physics grid refers to bottom edge
28 molod 1.4 _RL pephy(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)
29     _RL pphy(sNx,sNy,Nrphys,nSx,nSy)
30     _RL oz1(nlatsoz,nlevsoz), strq1(nlatsq,nlevsq)
31     _RL waterin(sNx,sNy,Nrphys), xlat(sNx,sNy)
32    
33 molod 1.5 integer i, j, L, LL, bi, bj
34 molod 1.4 integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
35     integer nhms1,nymd1,nhms2,nymd2,imns,ipls
36     _RL facm, facp
37    
38     im1 = 1-OLx
39     im2 = sNx+OLx
40     jm1 = 1-OLy
41     jm2 = sNy+OLy
42     idim1 = 1
43     idim2 = sNx
44     jdim1 = 1
45     jdim2 = sNy
46    
47     if( alarm('radsw').or.alarm('radlw') ) then
48 molod 1.1
49     do bj = myByLo(myThid), myByHi(myThid)
50     do bi = myBxLo(myThid), myBxHi(myThid)
51    
52 molod 1.5 c Construct the physics grid pressures - count pephy levels top down
53     c (even though dpphy counted bottom up)
54 molod 1.1 do j = 1,sNy
55     do i = 1,sNx
56 molod 1.5 pephy(i,j,Nrphys+1,bi,bj)=(Ro_surf(i,j,bi,bj)+etaH(i,j,bi,bj))/
57 molod 1.4 . rstarExpC(i,j,bi,bj)
58 molod 1.1 do L = 2,Nrphys+1
59 molod 1.5 LL = Nrphys+2-L
60     pephy(i,j,LL,bi,bj)=pephy(i,j,LL+1,bi,bj)-dpphys(i,j,L-1,bi,bj)
61 molod 1.1 enddo
62     enddo
63     enddo
64 molod 1.4 do j = 1,sNy
65     do i = 1,sNx
66     do L = 1,Nrphys
67     pphy(i,j,L,bi,bj)=(pephy(i,j,L+1,bi,bj)+pephy(i,j,L,bi,bj))/2.
68     enddo
69     enddo
70     enddo
71 molod 1.1
72 molod 1.4 do j = 1,sNy
73     do i = 1,sNx
74     xlat(i,j) = yC(i,j,bi,bj)
75     do L = 1,Nrphys
76     waterin(i,j,L) = sphy(i,j,L,bi,bj)
77     enddo
78     enddo
79     enddo
80    
81     call time_bound(nymd,nhms,nymd1,nhms1,nymd2,nhms2,imns,ipls)
82     call interp_time(nymd,nhms,nymd1,nhms1,nymd2,nhms2,facm,facp)
83    
84     do L = 1,nlevsoz
85     do j = 1,nlatsoz
86     oz1(j,L) = ozone(j,L,imns)*facm + ozone(j,L,ipls)*facp
87     enddo
88     enddo
89    
90     do L = 1,nlevsq
91     do j = 1,nlatsq
92     strq1(j,L) = stratq(j,L,imns)*facm + stratq(j,L,ipls)*facp
93     enddo
94     enddo
95    
96     call interp_chemistry(strq1,nlevsq,nlatsq,levsq,latsq,
97     . oz1,nlevsoz,nlatsoz,levsoz,latsoz,waterin,pphy,xlat,
98     . im2,jm2,Nrphys,nSx,nSy,bi,bj,o3,qstr)
99 molod 1.1
100     enddo
101     enddo
102    
103 molod 1.4 endif
104    
105     return
106     end
107 molod 1.3
108     subroutine interp_chemistry (stratq,nwatlevs,nwatlats,watlevs,
109     . watlats,ozone,nozolevs,nozolats,ozolevs,ozolats,
110 molod 1.4 . qz,plz,ptop,xlat,im,jm,lm,nSx,nSy,bi,bj,ozrad,qzrad)
111 molod 1.3
112     implicit none
113    
114     c Input Variables
115     c ---------------
116 molod 1.4 integer nwatlevs,nwatlats,nozolevs,nozolats,nSx,nSy,bi,bj
117 molod 1.3 real stratq(nwatlats,nwatlevs),ozone(nozlats,nozlevs)
118     integer watlevs(nwatlevs),watlats(nwatlats)
119     integer ozlevs(nozlevs),ozlats(nozlats)
120     real qz(im,jm,lm),plz(im,jm,lm)
121     real ptop, xlat(im,jm)
122     integer im,jm,lm
123 molod 1.4 real ozrad(im,jm,lm,nSx,nSy)
124     real qzrad(im,jm,lm,nSx,nSy)
125 molod 1.3
126     c Local Variables
127     c ---------------
128     integer i,j,L
129     real pi,fjeq,pi180
130    
131     C **********************************************************************
132     C **** Get Ozone and Stratospheric Moisture Data ****
133     C **********************************************************************
134    
135     call interp_qz (stratq,nwatlevs,nwatlats,watlevs,watlats,im*jm,
136 molod 1.4 . xlat,lm,plz,qz,qzrad(1,1,1,bi,bj))
137 molod 1.3 call interp_oz (ozone ,nozolevs,nozolats,ozolevs,ozolats,im*jm,
138 molod 1.4 . xlat,lm,plz,ozrad(1,1,1,bi,bj))
139 molod 1.3 return
140     end
141    
142     subroutine interp_qz(stratq,nwatlevs,nwatlats,watlevs,watlats,
143     . irun,xlat,nlevs,pres,qz_in,qz_out )
144     C***********************************************************************
145     C Purpose
146     C To Interpolate Chemistry Moisture from Chemistry Grid to Physics Grid
147     C
148     C INPUT Argument Description
149     C stratq .... Climatological SAGE Stratospheric Moisture
150     C irun ...... Number of Columns to be filled
151     C xlat ...... Latitude in Degrees
152     C nlevs ..... Vertical Dimension
153     C pres ...... PRES (IM,JM,nlevs) Three-dimensional array of pressures
154     C qz_in ..... Model Moisture (kg/kg mass mixing radtio)
155     C qz_out .... Combination of Chemistry Moisture and Model Moisture (kg/kg mass mixing ratio)
156     C
157     C***********************************************************************
158     C* GODDARD LABORATORY FOR ATMOSPHERES *
159     C***********************************************************************
160    
161     c Declare Modules and Data Structures
162     c -----------------------------------
163     implicit none
164     integer nwatlevs,nwatlats
165     real stratq ( nwatlats,nwatlevs )
166     real watlats (nwatlats)
167     real watlevs (nwatlevs)
168    
169     integer irun,nlevs
170     real xlat (irun)
171     real pres (irun,nlevs)
172     real qz_in (irun,nlevs)
173     real qz_out(irun,nlevs)
174    
175     c Local Variables
176     c ---------------
177     integer pqu,pql,dpq
178     parameter ( pqu = 100. )
179     parameter ( pql = 300. )
180     parameter ( dpq = pql-pqu )
181    
182     integer i,k,L1,L2,LM,LP
183     real h2o_time_lat (irun,nwatlevs)
184     real qz_clim(irun,nlevs)
185    
186     real qpr1(irun), qpr2(irun), slope(irun)
187     real pr1(irun), pr2(irun)
188    
189     integer jlat,jlatm,jlatp
190    
191     C **********************************************************************
192     C **** Interpolate Moisture data to model latitudes ***
193     C **********************************************************************
194    
195     DO 32 k = 1, nwatlevs
196     DO 34 i = 1,irun
197    
198     DO 36 jlat = 1, nwatlats
199     IF( watlats(jlat).gt.xlat(i) ) THEN
200     IF( jlat.EQ.1 ) THEN
201     jlatm = 1
202     jlatp = 1
203     slope(i) = 0
204     ELSE
205     jlatm = jlat -1
206     jlatp = jlat
207     slope(i) = ( xlat(i) -watlats(jlat-1) )
208     . / ( watlats(jlat)-watlats(jlat-1) )
209     ENDIF
210     GOTO 37
211     ENDIF
212     36 CONTINUE
213     jlatm = nwatlats
214     jlatp = nwatlats
215     slope(i) = 1
216     37 CONTINUE
217     QPR1(i) = stratq(jlatm,k)
218     QPR2(i) = stratq(jlatp,k)
219     34 CONTINUE
220    
221     do i = 1,irun
222     h2o_time_lat(i,k) = qpr1(i) + slope(i)*(qpr2(i)-qpr1(i))
223     enddo
224    
225     32 CONTINUE
226    
227     C **********************************************************************
228     C **** Interpolate Latitude Moisture data to model pressures ***
229     C **********************************************************************
230    
231     DO 40 L2 = 1,nlevs
232    
233     DO 44 i= 1, irun
234     DO 46 L1 = 1,nwatlevs
235     IF( watlevs(L1).GT.pres(i,L2) ) THEN
236     IF( L1.EQ.1 ) THEN
237     LM = 1
238     LP = 2
239     ELSE
240     LM = L1-1
241     LP = L1
242     ENDIF
243     GOTO 47
244     ENDIF
245     46 CONTINUE
246     LM = nwatlevs-1
247     LP = nwatlevs
248     47 CONTINUE
249     PR1(i) = watlevs (LM)
250     PR2(i) = watlevs (LP)
251     QPR1(i) = h2o_time_lat(i,LM)
252     QPR2(i) = h2o_time_lat(i,LP)
253     44 CONTINUE
254    
255     do i= 1, irun
256     slope(i) =(QPR1(i)-QPR2(i)) / (PR1(i)-PR2(i))
257     qz_clim(i,L2) = QPR2(i) + (pres(i,L2)-PR2(i))*SLOPE(i)
258     enddo
259    
260     40 CONTINUE
261    
262     c
263     c ... Above 100 mb, using climatological water data set ...................
264     c ... Below 300 mb, using model predicted water data set ...................
265     c ... In between, using linear interpolation ...............................
266     c
267     do k= 1, nlevs
268     do i= 1, irun
269     if( pres(i,k).ge.pqu .and. pres(i,k).le. pql) then
270     qz_out(i,k) = qz_clim(i,k)+(qz_in(i,k)-
271     1 qz_clim(i,k))*(pres(i,k)-pqu)/dpq
272     else if( pres(i,k) .gt. pql ) then
273     qz_out(i,k) = qz_in (i,k)
274     else
275     qz_out(i,k) = qz_clim(i,k)
276     endif
277     enddo
278     enddo
279    
280     return
281     end
282    
283     subroutine interp_oz (ozone,nozolevs,nozolats,ozolevs,ozolats,
284     . irun,xlat,nlevs,plevs,ozrad)
285     C***********************************************************************
286     C Purpose
287     C To Interpolate Chemistry Ozone from Chemistry Grid to Physics Grid
288     C
289     C INPUT Argument Description
290     C ozone ..... Climatological Ozone
291     C chemistry .. Chemistry State Data Structure
292     C irun ....... Number of Columns to be filled
293     C xlat ....... Latitude in Degrees
294     C nlevs ...... Vertical Dimension
295     C pres ....... Three-dimensional array of pressures
296     C ozrad ...... Ozone on Physics Grid (kg/kg mass mixing radtio)
297     C
298     C***********************************************************************
299     C* GODDARD LABORATORY FOR ATMOSPHERES *
300     C***********************************************************************
301    
302     c Declare Modules and Data Structures
303     c -----------------------------------
304     implicit none
305     real ozone ( nozolats,nozolevs )
306    
307     integer irun,nlevs
308     real xlat (irun)
309     real plevs (irun,nlevs)
310     real ozrad (irun,nlevs)
311    
312     c Local Variables
313     c ---------------
314     real zero,one,o3min,voltomas
315     PARAMETER ( ZERO = 0.0 )
316     PARAMETER ( ONE = 1.0 )
317     PARAMETER ( O3MIN = 1.0E-10 )
318     PARAMETER ( VOLTOMAS = 1.655E-6 )
319    
320     integer i,k,L1,L2,LM,LP
321     integer jlat,jlatm,jlatp
322     real O3INT1(IRUN,nozolevs)
323     real QPR1(IRUN), QPR2(IRUN), SLOPE(IRUN)
324     real PR1(IRUN), PR2(IRUN)
325    
326     C **********************************************************************
327     C **** INTERPOLATE ozone data to model latitudes ***
328     C **********************************************************************
329    
330     DO 32 K=1,nozolevs
331     DO 34 I=1,IRUN
332    
333     DO 36 jlat = 1,nozolats
334     IF( ozolats(jlat).gt.xlat(i) ) THEN
335     IF( jlat.EQ.1 ) THEN
336     jlatm = 1
337     jlatp = 1
338     slope(i) = zero
339     ELSE
340     jlatm = jlat-1
341     jlatp = jlat
342     slope(i) = ( XLAT(I) -ozolats(jlat-1) )
343     . / ( ozolats(jlat)-ozolats(jlat-1) )
344     ENDIF
345     GOTO 37
346     ENDIF
347     36 CONTINUE
348     jlatm = nozolats
349     jlatp = nozolats
350     slope(i) = one
351     37 CONTINUE
352     QPR1(I) = ozone(jlatm,k)
353     QPR2(I) = ozone(jlatp,k)
354     34 CONTINUE
355    
356     DO 38 I=1,IRUN
357     o3int1(i,k) = qpr1(i) + slope(i)*( qpr2(i)-qpr1(i) )
358     38 CONTINUE
359    
360     32 CONTINUE
361    
362     C **********************************************************************
363     C **** INTERPOLATE latitude ozone data to model pressures ***
364     C **********************************************************************
365    
366     DO 40 L2 = 1,NLEVS
367    
368     DO 44 I = 1,IRUN
369     DO 46 L1 = 1,nozolevs
370     IF( ozolevs(L1).GT.PLEVS(I,L2) ) THEN
371     IF( L1.EQ.1 ) THEN
372     LM = 1
373     LP = 2
374     ELSE
375     LM = L1-1
376     LP = L1
377     ENDIF
378     GOTO 47
379     ENDIF
380     46 CONTINUE
381     LM = nozolevs-1
382     LP = nozolevs
383     47 CONTINUE
384     PR1(I) = ozolevs (LM)
385     PR2(I) = ozolevs (LP)
386     QPR1(I) = O3INT1(I,LM)
387     QPR2(I) = O3INT1(I,LP)
388     44 CONTINUE
389    
390     DO 48 I=1,IRUN
391     SLOPE(I) = ( QPR1(I)-QPR2(I) )
392     . / ( PR1(I)- PR2(I) )
393     ozrad(I,L2) = QPR2(I) + ( PLEVS(I,L2)-PR2(I) )*SLOPE(I)
394    
395     if( ozrad(i,l2).lt.o3min ) then
396     ozrad(i,l2) = o3min
397     endif
398    
399     48 CONTINUE
400     40 CONTINUE
401    
402     C **********************************************************************
403     C **** CONVERT FROM VOLUME MIXING RATIO TO MASS MIXING RATIO ***
404     C **********************************************************************
405    
406     DO 60 I=1,IRUN*NLEVS
407     ozrad (I,1) = ozrad(I,1) * VOLTOMAS
408     60 CONTINUE
409    
410     RETURN
411     END
412    

  ViewVC Help
Powered by ViewVC 1.1.22