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

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

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

revision 1.2 by molod, Mon Jun 7 18:11:38 2004 UTC revision 1.3 by molod, Thu Jun 10 21:50:33 2004 UTC
# Line 44  C Compute pressures on physics grid Line 44  C Compute pressures on physics grid
44          do j = 1,sNy          do j = 1,sNy
45          do i = 1,sNx          do i = 1,sNx
46           pephy(i,j,1,bi,bj)=Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)           pephy(i,j,1,bi,bj)=Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)
 c        do L = 1,Nr  
 c         pephy(i,j,1,bi,bj)=pephy(i,j,1,bi,bj) -  
 c    .                                  (1.-hfacC(i,j,L,bi,bj))*drF(L)  
 c        enddo  
47           do L = 2,Nrphys+1           do L = 2,Nrphys+1
48            pephy(i,j,L,bi,bj)=pephy(i,j,L-1,bi,bj)-dpphys(i,j,L-1,bi,bj)            pephy(i,j,L,bi,bj)=pephy(i,j,L-1,bi,bj)-dpphys(i,j,L-1,bi,bj)
49           enddo           enddo
# Line 57  c Do not use a zero field as the top edg Line 53  c Do not use a zero field as the top edg
53          enddo          enddo
54          enddo          enddo
55    
56    call time-bound
57    call interp_time
58  call interp chemistry  call interp chemistry
59  c reminder - lats are in yC and lons in xC in GRID.h  c reminder - lats are in yC and lons in xC in GRID.h
60    
# Line 65  c reminder - lats are in yC and lons in Line 63  c reminder - lats are in yC and lons in
63    
64         return         return
65         end         end
66    
67          subroutine interp_chemistry (stratq,nwatlevs,nwatlats,watlevs,
68         . watlats,ozone,nozolevs,nozolats,ozolevs,ozolats,
69         . qz,plz,ptop,xlat,im,jm,lm,ozrad,qzrad)
70    
71          implicit none
72    
73    c Input Variables
74    c ---------------
75          integer nwatlevs,nwatlats,nozolevs,nozolats
76          real stratq(nwatlats,nwatlevs),ozone(nozlats,nozlevs)
77          integer watlevs(nwatlevs),watlats(nwatlats)
78          integer ozlevs(nozlevs),ozlats(nozlats)
79          real qz(im,jm,lm),plz(im,jm,lm)
80          real ptop, xlat(im,jm)
81          integer im,jm,lm
82          real ozrad(im,jm,lm)
83          real qzrad(im,jm,lm)
84    
85    c Local Variables
86    c ---------------
87          integer   i,j,L
88          real      pi,fjeq,pi180
89    
90    C **********************************************************************
91    C ****           Get Ozone and Stratospheric Moisture Data          ****
92    C **********************************************************************
93    
94          call interp_qz (stratq,nwatlevs,nwatlats,watlevs,watlats,im*jm,
95         .                                             xlat,lm,plz,qz,qzrad)
96          call interp_oz (ozone ,nozolevs,nozolats,ozolevs,ozolats,im*jm,
97         .                                             xlat,lm,plz,   ozrad)
98          return
99          end
100    
101          subroutine interp_qz(stratq,nwatlevs,nwatlats,watlevs,watlats,
102         .                               irun,xlat,nlevs,pres,qz_in,qz_out )
103    C***********************************************************************
104    C  Purpose
105    C     To Interpolate Chemistry Moisture from Chemistry Grid to Physics Grid
106    C
107    C  INPUT Argument Description
108    C     stratq .... Climatological SAGE Stratospheric Moisture
109    C     irun ...... Number of Columns to be filled
110    C     xlat ...... Latitude in Degrees
111    C     nlevs ..... Vertical   Dimension
112    C     pres ...... PRES (IM,JM,nlevs) Three-dimensional array of pressures
113    C     qz_in ..... Model Moisture (kg/kg mass mixing radtio)
114    C     qz_out .... Combination of Chemistry Moisture and Model Moisture (kg/kg mass mixing ratio)
115    C
116    C***********************************************************************
117    C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *
118    C***********************************************************************
119    
120    c Declare Modules and Data Structures
121    c -----------------------------------
122          implicit none
123          integer nwatlevs,nwatlats
124          real stratq ( nwatlats,nwatlevs )
125          real watlats (nwatlats)
126          real watlevs (nwatlevs)
127    
128          integer irun,nlevs
129          real xlat  (irun)
130          real pres  (irun,nlevs)
131          real qz_in (irun,nlevs)
132          real qz_out(irun,nlevs)
133    
134    c Local Variables
135    c ---------------
136          integer     pqu,pql,dpq
137          parameter ( pqu = 100.    )
138          parameter ( pql = 300.    )
139          parameter ( dpq = pql-pqu )
140    
141          integer i,k,L1,L2,LM,LP
142          real h2o_time_lat (irun,nwatlevs)
143          real       qz_clim(irun,nlevs)
144    
145          real  qpr1(irun), qpr2(irun), slope(irun)
146          real   pr1(irun),  pr2(irun)
147    
148          integer  jlat,jlatm,jlatp
149    
150    C **********************************************************************
151    C ****         Interpolate Moisture data to model latitudes          ***
152    C **********************************************************************
153    
154          DO 32 k = 1, nwatlevs
155            DO 34   i = 1,irun
156    
157            DO 36 jlat = 1, nwatlats
158               IF( watlats(jlat).gt.xlat(i) ) THEN
159                  IF( jlat.EQ.1 ) THEN
160                      jlatm    = 1
161                      jlatp    = 1
162                      slope(i) = 0
163                        ELSE
164                      jlatm    = jlat -1
165                      jlatp    = jlat
166                      slope(i) = ( xlat(i)        -watlats(jlat-1) )
167         .                     / ( watlats(jlat)-watlats(jlat-1) )
168                  ENDIF
169                  GOTO 37
170               ENDIF
171       36   CONTINUE
172            jlatm    = nwatlats
173            jlatp    = nwatlats
174            slope(i) =  1
175       37   CONTINUE
176            QPR1(i) = stratq(jlatm,k)
177            QPR2(i) = stratq(jlatp,k)
178       34   CONTINUE
179    
180            do  i = 1,irun
181            h2o_time_lat(i,k) = qpr1(i) + slope(i)*(qpr2(i)-qpr1(i))
182            enddo
183    
184       32 CONTINUE
185    
186    C **********************************************************************
187    C ****     Interpolate Latitude Moisture data to model pressures     ***
188    C **********************************************************************
189    
190          DO 40 L2 = 1,nlevs
191    
192            DO 44 i= 1, irun
193            DO 46 L1 = 1,nwatlevs
194               IF( watlevs(L1).GT.pres(i,L2) ) THEN
195                 IF( L1.EQ.1 ) THEN
196                     LM = 1
197                     LP = 2
198                   ELSE
199                     LM = L1-1
200                     LP = L1
201                 ENDIF
202                 GOTO 47
203               ENDIF
204       46   CONTINUE
205            LM = nwatlevs-1
206            LP = nwatlevs
207       47   CONTINUE
208             PR1(i) =     watlevs (LM)
209             PR2(i) =     watlevs (LP)
210            QPR1(i) = h2o_time_lat(i,LM)
211            QPR2(i) = h2o_time_lat(i,LP)
212       44   CONTINUE
213    
214          do i= 1, irun
215               slope(i) =(QPR1(i)-QPR2(i)) / (PR1(i)-PR2(i))
216          qz_clim(i,L2) = QPR2(i) + (pres(i,L2)-PR2(i))*SLOPE(i)
217          enddo
218    
219       40 CONTINUE
220    
221    c
222    c ... Above 100 mb, using climatological  water data set ...................
223    c ... Below 300 mb, using model predicted water data set ...................
224    c ... In between, using linear interpolation ...............................
225    c
226          do k= 1, nlevs
227          do i= 1, irun
228               if( pres(i,k).ge.pqu  .and. pres(i,k).le. pql) then
229                 qz_out(i,k) = qz_clim(i,k)+(qz_in(i,k)-
230         1                     qz_clim(i,k))*(pres(i,k)-pqu)/dpq
231          else if( pres(i,k) .gt. pql ) then
232                 qz_out(i,k) = qz_in  (i,k)
233          else
234                 qz_out(i,k) = qz_clim(i,k)
235               endif
236          enddo
237          enddo
238    
239          return
240          end
241    
242          subroutine interp_oz (ozone,nozolevs,nozolats,ozolevs,ozolats,
243         .                                      irun,xlat,nlevs,plevs,ozrad)
244    C***********************************************************************
245    C  Purpose
246    C     To Interpolate Chemistry Ozone from Chemistry Grid to Physics Grid
247    C
248    C  INPUT Argument Description
249    C     ozone ..... Climatological Ozone
250    C     chemistry .. Chemistry State Data Structure
251    C     irun ....... Number of Columns to be filled
252    C     xlat ....... Latitude in Degrees
253    C     nlevs ...... Vertical   Dimension
254    C     pres ....... Three-dimensional array of pressures
255    C     ozrad ...... Ozone on Physics Grid (kg/kg mass mixing radtio)
256    C
257    C***********************************************************************
258    C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *
259    C***********************************************************************
260    
261    c Declare Modules and Data Structures
262    c -----------------------------------
263          implicit none
264          real     ozone ( nozolats,nozolevs )
265    
266          integer irun,nlevs
267          real xlat  (irun)
268          real plevs (irun,nlevs)
269          real ozrad (irun,nlevs)
270    
271    c Local Variables
272    c ---------------
273          real zero,one,o3min,voltomas
274          PARAMETER ( ZERO     = 0.0 )
275          PARAMETER ( ONE      = 1.0 )
276          PARAMETER ( O3MIN    = 1.0E-10  )
277          PARAMETER ( VOLTOMAS = 1.655E-6 )
278    
279          integer  i,k,L1,L2,LM,LP
280          integer  jlat,jlatm,jlatp
281          real  O3INT1(IRUN,nozolevs)
282          real    QPR1(IRUN), QPR2(IRUN), SLOPE(IRUN)
283          real     PR1(IRUN),  PR2(IRUN)
284    
285    C **********************************************************************
286    C ****           INTERPOLATE ozone data to model latitudes           ***
287    C **********************************************************************
288    
289          DO 32 K=1,nozolevs
290          DO 34 I=1,IRUN
291    
292          DO 36 jlat = 1,nozolats
293          IF( ozolats(jlat).gt.xlat(i) ) THEN
294          IF( jlat.EQ.1 ) THEN
295          jlatm    = 1
296          jlatp    = 1
297          slope(i) = zero
298            ELSE
299          jlatm    = jlat-1
300          jlatp    = jlat
301          slope(i) = ( XLAT(I)        -ozolats(jlat-1) )
302         .         / ( ozolats(jlat)-ozolats(jlat-1) )
303          ENDIF
304          GOTO 37
305          ENDIF
306       36 CONTINUE
307          jlatm    = nozolats
308          jlatp    = nozolats
309          slope(i) = one
310       37 CONTINUE
311          QPR1(I) = ozone(jlatm,k)
312          QPR2(I) = ozone(jlatp,k)
313       34 CONTINUE
314    
315          DO 38 I=1,IRUN
316          o3int1(i,k) = qpr1(i) + slope(i)*( qpr2(i)-qpr1(i) )
317       38 CONTINUE
318    
319       32 CONTINUE
320    
321    C **********************************************************************
322    C ****     INTERPOLATE latitude ozone data to model pressures        ***
323    C **********************************************************************
324    
325          DO 40 L2 = 1,NLEVS
326    
327          DO 44 I  = 1,IRUN
328          DO 46 L1 = 1,nozolevs
329          IF( ozolevs(L1).GT.PLEVS(I,L2) ) THEN
330          IF( L1.EQ.1 ) THEN
331              LM = 1
332              LP = 2
333            ELSE
334              LM = L1-1
335              LP = L1
336          ENDIF
337          GOTO 47
338          ENDIF
339       46 CONTINUE
340                LM = nozolevs-1
341                LP = nozolevs
342       47 CONTINUE
343           PR1(I) = ozolevs (LM)
344           PR2(I) = ozolevs (LP)
345          QPR1(I) =   O3INT1(I,LM)
346          QPR2(I) =   O3INT1(I,LP)
347       44 CONTINUE
348    
349          DO 48 I=1,IRUN
350             SLOPE(I) = ( QPR1(I)-QPR2(I) )
351         .            / (  PR1(I)- PR2(I) )
352          ozrad(I,L2) =   QPR2(I) + ( PLEVS(I,L2)-PR2(I) )*SLOPE(I)
353    
354          if( ozrad(i,l2).lt.o3min ) then
355              ozrad(i,l2) =  o3min
356          endif
357    
358       48 CONTINUE
359       40 CONTINUE
360    
361    C **********************************************************************
362    C ****     CONVERT FROM VOLUME MIXING RATIO TO MASS MIXING RATIO     ***
363    C **********************************************************************
364    
365          DO 60 I=1,IRUN*NLEVS
366          ozrad (I,1) = ozrad(I,1) * VOLTOMAS
367      60  CONTINUE
368    
369          RETURN
370          END
371    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22