/[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.5 by molod, Mon Jun 14 20:34:50 2004 UTC revision 1.11 by molod, Fri Oct 22 14:52:14 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "FIZHI_OPTIONS.h"
5         subroutine update_chemistry_exports (myTime, myIter, myThid)         subroutine update_chemistry_exports (myTime, myIter, myThid)
6  c----------------------------------------------------------------------  c----------------------------------------------------------------------
7  c  Subroutine update_chemistry_exports - 'Wrapper' routine to update  c  Subroutine update_chemistry_exports - 'Wrapper' routine to update
# Line 11  c Line 12  c
12  c Call:  interp_chemistry  c Call:  interp_chemistry
13  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
14         implicit none         implicit none
 #include "CPP_OPTIONS.h"  
15  #include "SIZE.h"  #include "SIZE.h"
16  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
17    #include "fizhi_land_SIZE.h"
18  #include "GRID.h"  #include "GRID.h"
19  #include "DYNVARS.h"  #include "DYNVARS.h"
20  #include "fizhi_chemistry_coms.h"  #include "fizhi_chemistry_coms.h"
# Line 22  c--------------------------------------- Line 23  c---------------------------------------
23  #include "EEPARAMS.h"  #include "EEPARAMS.h"
24  #include "chronos.h"  #include "chronos.h"
25    
26        integer myTime, myIter, myThid        integer myIter, myThid
27          _RL myTime
28    
29  c pe on physics grid refers to bottom edge  c pe on physics grid refers to bottom edge
30        _RL pephy(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)        _RL pephy(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nrphys+1,nSx,nSy)
# Line 31  c pe on physics grid refers to bottom ed Line 33  c pe on physics grid refers to bottom ed
33        _RL waterin(sNx,sNy,Nrphys), xlat(sNx,sNy)        _RL waterin(sNx,sNy,Nrphys), xlat(sNx,sNy)
34    
35        integer i, j, L, LL, bi, bj        integer i, j, L, LL, bi, bj
36        integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2        integer im1, im2, jm1, jm2
37        integer nhms1,nymd1,nhms2,nymd2,imns,ipls        integer nhms1,nymd1,nhms2,nymd2,imns,ipls
38        _RL facm, facp        _RL facm, facp
39          logical alarm
40          external alarm
41    
42        im1 = 1-OLx        im1 = 1
43        im2 = sNx+OLx        im2 = sNx
44        jm1 = 1-OLy        jm1 = 1
45        jm2 = sNy+OLy        jm2 = sNy
       idim1 = 1  
       idim2 = sNx  
       jdim1 = 1  
       jdim2 = sNy  
46    
47        if( alarm('radsw').or.alarm('radlw') ) then        if( alarm('radsw').or.alarm('radlw') ) then
48    
# Line 53  c  Construct the physics grid pressures Line 53  c  Construct the physics grid pressures
53  c                                         (even though dpphy counted bottom up)  c                                         (even though dpphy counted bottom up)
54          do j = 1,sNy          do j = 1,sNy
55          do i = 1,sNx          do i = 1,sNx
56           pephy(i,j,Nrphys+1,bi,bj)=(Ro_surf(i,j,bi,bj)+etaH(i,j,bi,bj))/           pephy(i,j,Nrphys+1,bi,bj)=(Ro_surf(i,j,bi,bj)+etaH(i,j,bi,bj))
      .                       rstarExpC(i,j,bi,bj)  
57           do L = 2,Nrphys+1           do L = 2,Nrphys+1
58           LL = Nrphys+2-L           LL = Nrphys+2-L
59           pephy(i,j,LL,bi,bj)=pephy(i,j,LL+1,bi,bj)-dpphys(i,j,L-1,bi,bj)           pephy(i,j,LL,bi,bj)=pephy(i,j,LL+1,bi,bj)-dpphys(i,j,L-1,bi,bj)
# Line 64  c Line 63  c
63          do j = 1,sNy          do j = 1,sNy
64          do i = 1,sNx          do i = 1,sNx
65           do L = 1,Nrphys           do L = 1,Nrphys
66            pphy(i,j,L,bi,bj)=(pephy(i,j,L+1,bi,bj)+pephy(i,j,L,bi,bj))/2.            pphy(i,j,L,bi,bj)=(pephy(i,j,L+1,bi,bj)+pephy(i,j,L,bi,bj))
67         .                                              /200.
68           enddo           enddo
69          enddo          enddo
70          enddo          enddo
# Line 106  c Line 106  c
106        end        end
107    
108        subroutine interp_chemistry (stratq,nwatlevs,nwatlats,watlevs,        subroutine interp_chemistry (stratq,nwatlevs,nwatlats,watlevs,
109       . watlats,ozone,nozolevs,nozolats,ozolevs,ozolats,       . watlats,ozone,nozlevs,nozlats,ozlevs,ozlats,
110       . qz,plz,ptop,xlat,im,jm,lm,nSx,nSy,bi,bj,ozrad,qzrad)       . qz,plz,xlat,im,jm,lm,nSx,nSy,bi,bj,ozrad,qzrad)
111    
112        implicit none        implicit none
113    
114  c Input Variables  c Input Variables
115  c ---------------  c ---------------
116        integer nwatlevs,nwatlats,nozolevs,nozolats,nSx,nSy,bi,bj        integer nwatlevs,nwatlats,nozlevs,nozlats,nSx,nSy,bi,bj
117        real stratq(nwatlats,nwatlevs),ozone(nozlats,nozlevs)        _RL stratq(nwatlats,nwatlevs),ozone(nozlats,nozlevs)
118        integer watlevs(nwatlevs),watlats(nwatlats)        _RL watlevs(nwatlevs),watlats(nwatlats)
119        integer ozlevs(nozlevs),ozlats(nozlats)        _RL ozlevs(nozlevs),ozlats(nozlats)
       real qz(im,jm,lm),plz(im,jm,lm)  
       real ptop, xlat(im,jm)  
120        integer im,jm,lm        integer im,jm,lm
121        real ozrad(im,jm,lm,nSx,nSy)        _RL qz(im,jm,lm),plz(im,jm,lm)
122        real qzrad(im,jm,lm,nSx,nSy)        _RL xlat(im,jm)
123          _RL ozrad(im,jm,lm,nSx,nSy)
124  c Local Variables        _RL qzrad(im,jm,lm,nSx,nSy)
 c ---------------  
       integer   i,j,L  
       real      pi,fjeq,pi180  
125    
126  C **********************************************************************  C **********************************************************************
127  C ****           Get Ozone and Stratospheric Moisture Data          ****  C ****           Get Ozone and Stratospheric Moisture Data          ****
128  C **********************************************************************  C **********************************************************************
129    
130        call interp_qz (stratq,nwatlevs,nwatlats,watlevs,watlats,im*jm,        call interp_qz (stratq,nwatlevs,nwatlats,watlevs,watlats,im*jm,
131       .                                xlat,lm,plz,qz,qzrad(1,1,1,bi,bj))       .                         bi,bj, xlat,lm,plz,qz,qzrad(1,1,1,bi,bj))
132        call interp_oz (ozone ,nozolevs,nozolats,ozolevs,ozolats,im*jm,        call interp_oz (ozone ,nozlevs,nozlats,ozlevs,ozlats,im*jm,
133       .                                xlat,lm,plz,ozrad(1,1,1,bi,bj))       .                         bi,bj, xlat,lm,plz,ozrad(1,1,1,bi,bj))
134    
135        return        return
136        end        end
137    
138        subroutine interp_qz(stratq,nwatlevs,nwatlats,watlevs,watlats,        subroutine interp_qz(stratq,nwatlevs,nwatlats,watlevs,watlats,
139       .                               irun,xlat,nlevs,pres,qz_in,qz_out )       .                         irun,bi,bj,xlat,nlevs,pres,qz_in,qz_out )
140  C***********************************************************************  C***********************************************************************
141  C  Purpose  C  Purpose
142  C     To Interpolate Chemistry Moisture from Chemistry Grid to Physics Grid  C     To Interpolate Chemistry Moisture from Chemistry Grid to Physics Grid
# Line 152  C     xlat ...... Latitude in Degrees Line 148  C     xlat ...... Latitude in Degrees
148  C     nlevs ..... Vertical   Dimension  C     nlevs ..... Vertical   Dimension
149  C     pres ...... PRES (IM,JM,nlevs) Three-dimensional array of pressures  C     pres ...... PRES (IM,JM,nlevs) Three-dimensional array of pressures
150  C     qz_in ..... Model Moisture (kg/kg mass mixing radtio)  C     qz_in ..... Model Moisture (kg/kg mass mixing radtio)
151  C     qz_out .... Combination of Chemistry Moisture and Model Moisture (kg/kg mass mixing ratio)  C     qz_out .... Combination of Chemistry Moisture and Model Moisture
152    C                 (kg/kg mass mixing ratio)
153  C  C
154  C***********************************************************************  C***********************************************************************
 C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *  
 C***********************************************************************  
155    
 c Declare Modules and Data Structures  
 c -----------------------------------  
156        implicit none        implicit none
157        integer nwatlevs,nwatlats        integer nwatlevs,nwatlats
158        real stratq ( nwatlats,nwatlevs )        integer bi,bj
159        real watlats (nwatlats)        _RL stratq ( nwatlats,nwatlevs )
160        real watlevs (nwatlevs)        _RL watlats (nwatlats)
161          _RL watlevs (nwatlevs)
162    
163        integer irun,nlevs        integer irun,nlevs
164        real xlat  (irun)        _RL xlat  (irun)
165        real pres  (irun,nlevs)        _RL pres  (irun,nlevs)
166        real qz_in (irun,nlevs)        _RL qz_in (irun,nlevs)
167        real qz_out(irun,nlevs)        _RL qz_out(irun,nlevs)
168    
169  c Local Variables  c Local Variables
170  c ---------------  c ---------------
# Line 180  c --------------- Line 174  c ---------------
174        parameter ( dpq = pql-pqu )        parameter ( dpq = pql-pqu )
175    
176        integer i,k,L1,L2,LM,LP        integer i,k,L1,L2,LM,LP
177        real h2o_time_lat (irun,nwatlevs)        _RL h2o_time_lat (irun,nwatlevs)
178        real       qz_clim(irun,nlevs)        _RL       qz_clim(irun,nlevs)
179    
180        real  qpr1(irun), qpr2(irun), slope(irun)        _RL  qpr1(irun), qpr2(irun), slope(irun)
181        real   pr1(irun),  pr2(irun)        _RL   pr1(irun),  pr2(irun)
182    
183        integer  jlat,jlatm,jlatp        integer  jlat,jlatm,jlatp
184    
# Line 280  c Line 274  c
274        return        return
275        end        end
276    
277        subroutine interp_oz (ozone,nozolevs,nozolats,ozolevs,ozolats,        subroutine interp_oz (ozone,nozlevs,nozlats,ozlevs,ozlats,
278       .                                      irun,xlat,nlevs,plevs,ozrad)       .                            irun,bi,bj,xlat,nlevs,plevs,ozrad)
279  C***********************************************************************  C***********************************************************************
280  C  Purpose  C  Purpose
281  C     To Interpolate Chemistry Ozone from Chemistry Grid to Physics Grid  C     To Interpolate Chemistry Ozone from Chemistry Grid to Physics Grid
# Line 296  C     pres ....... Three-dimensional arr Line 290  C     pres ....... Three-dimensional arr
290  C     ozrad ...... Ozone on Physics Grid (kg/kg mass mixing radtio)  C     ozrad ...... Ozone on Physics Grid (kg/kg mass mixing radtio)
291  C  C
292  C***********************************************************************  C***********************************************************************
 C*                  GODDARD LABORATORY FOR ATMOSPHERES                 *  
 C***********************************************************************  
   
 c Declare Modules and Data Structures  
 c -----------------------------------  
293        implicit none        implicit none
294        real     ozone ( nozolats,nozolevs )        integer nozlevs,nozlats,irun,nlevs
295          integer bi,bj
296        integer irun,nlevs        _RL ozone(nozlats,nozlevs)
297        real xlat  (irun)        _RL xlat(irun)
298        real plevs (irun,nlevs)        _RL plevs(irun,nlevs)
299        real ozrad (irun,nlevs)        _RL ozrad(irun,nlevs)
300          _RL ozlevs(nozlevs),ozlats(nozlats)
301    
302  c Local Variables  c Local Variables
303  c ---------------  c ---------------
304        real zero,one,o3min,voltomas        _RL zero,one,o3min,voltomas
305        PARAMETER ( ZERO     = 0.0 )        PARAMETER ( ZERO     = 0.0 )
306        PARAMETER ( ONE      = 1.0 )        PARAMETER ( ONE      = 1.0 )
307        PARAMETER ( O3MIN    = 1.0E-10  )        PARAMETER ( O3MIN    = 1.0E-10  )
# Line 319  c --------------- Line 309  c ---------------
309    
310        integer  i,k,L1,L2,LM,LP        integer  i,k,L1,L2,LM,LP
311        integer  jlat,jlatm,jlatp        integer  jlat,jlatm,jlatp
312        real  O3INT1(IRUN,nozolevs)        _RL  O3INT1(IRUN,nozlevs)
313        real    QPR1(IRUN), QPR2(IRUN), SLOPE(IRUN)        _RL    QPR1(IRUN), QPR2(IRUN), SLOPE(IRUN)
314        real     PR1(IRUN),  PR2(IRUN)        _RL     PR1(IRUN),  PR2(IRUN)
315    
316  C **********************************************************************  C **********************************************************************
317  C ****           INTERPOLATE ozone data to model latitudes           ***  C ****           INTERPOLATE ozone data to model latitudes           ***
318  C **********************************************************************  C **********************************************************************
319    
320        DO 32 K=1,nozolevs        DO 32 K=1,nozlevs
321        DO 34 I=1,IRUN        DO 34 I=1,IRUN
322    
323        DO 36 jlat = 1,nozolats        DO 36 jlat = 1,nozlats
324        IF( ozolats(jlat).gt.xlat(i) ) THEN        IF( ozlats(jlat).gt.xlat(i) ) THEN
325        IF( jlat.EQ.1 ) THEN        IF( jlat.EQ.1 ) THEN
326        jlatm    = 1        jlatm    = 1
327        jlatp    = 1        jlatp    = 1
# Line 339  C ************************************** Line 329  C **************************************
329          ELSE          ELSE
330        jlatm    = jlat-1        jlatm    = jlat-1
331        jlatp    = jlat        jlatp    = jlat
332        slope(i) = ( XLAT(I)        -ozolats(jlat-1) )        slope(i) = ( XLAT(I)        -ozlats(jlat-1) )
333       .         / ( ozolats(jlat)-ozolats(jlat-1) )       .         / ( ozlats(jlat)-ozlats(jlat-1) )
334        ENDIF        ENDIF
335        GOTO 37        GOTO 37
336        ENDIF        ENDIF
337     36 CONTINUE     36 CONTINUE
338        jlatm    = nozolats        jlatm    = nozlats
339        jlatp    = nozolats        jlatp    = nozlats
340        slope(i) = one        slope(i) = one
341     37 CONTINUE     37 CONTINUE
342        QPR1(I) = ozone(jlatm,k)        QPR1(I) = ozone(jlatm,k)
# Line 366  C ************************************** Line 356  C **************************************
356        DO 40 L2 = 1,NLEVS        DO 40 L2 = 1,NLEVS
357    
358        DO 44 I  = 1,IRUN        DO 44 I  = 1,IRUN
359        DO 46 L1 = 1,nozolevs        DO 46 L1 = 1,nozlevs
360        IF( ozolevs(L1).GT.PLEVS(I,L2) ) THEN        IF( ozlevs(L1).GT.PLEVS(I,L2) ) THEN
361        IF( L1.EQ.1 ) THEN        IF( L1.EQ.1 ) THEN
362            LM = 1            LM = 1
363            LP = 2            LP = 2
# Line 378  C ************************************** Line 368  C **************************************
368        GOTO 47        GOTO 47
369        ENDIF        ENDIF
370     46 CONTINUE     46 CONTINUE
371              LM = nozolevs-1              LM = nozlevs-1
372              LP = nozolevs              LP = nozlevs
373     47 CONTINUE     47 CONTINUE
374         PR1(I) = ozolevs (LM)         PR1(I) = ozlevs (LM)
375         PR2(I) = ozolevs (LP)         PR2(I) = ozlevs (LP)
376        QPR1(I) =   O3INT1(I,LM)        QPR1(I) =   O3INT1(I,LM)
377        QPR2(I) =   O3INT1(I,LP)        QPR2(I) =   O3INT1(I,LP)
378     44 CONTINUE     44 CONTINUE
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22