File: C:\NOAA\NEMS_11731\src\chem\gocart\src\Components\GOCART_GridComp\O3_GridComp\O3_GridCompMod.F90

1     #ifdef GEOS5
2     #include "MAPL_Generic.h"
3     #endif
4     
5     !-------------------------------------------------------------------------
6     !NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1, GEOS/DAS!
7     !-------------------------------------------------------------------------
8     !BOP
9     !
10     ! !MODULE:  O3_GridCompMod
11     !
12     ! Grid Component class for parameterized Chemistry for 7 species:
13     !
14     !  O3      Ozone
15     !  Ox      Odd oxygen
16     !  N2O     Nitrous oxide
17     !  CFC11   CFC-11 (CCl3F)
18     !  CFC12   CFC-12 (CCl2F2)
19     !  CH4     Methane
20     !  HCFC22  HCFC-22 (CHClF2)
21     !  
22     !
23     ! !INTERFACE:
24     !
25     
26        MODULE  O3_GridCompMod
27     
28     ! !USES:
29     
30     #ifdef GEOS5
31        USE ESMF_Mod
32        USE MAPL_Mod
33     #endif
34     
35        USE Chem_Mod 	     ! Chemistry Base Class
36        USE Chem_StateMod	     ! Chemistry State
37        USE Chem_UtilMod          ! Utilities
38        USE m_inpak90	     ! Resource file management
39        USE m_ioutil, only: luavail  
40     
41        IMPLICIT NONE
42     
43     ! !PUBLIC TYPES:
44     !
45        PRIVATE
46        PUBLIC  O3_GridComp       ! The O3 object 
47     
48     !
49     ! !PUBLIC MEMBER FUNCTIONS:
50     !
51     
52        PUBLIC  O3_GridCompInitialize
53        PUBLIC  O3_GridCompRun
54        PUBLIC  O3_GridCompFinalize
55     
56     !
57     ! !DESCRIPTION:
58     !
59     !  This module implements a parameterized chemistry for several radiatively
60     !  active species: Ox, N2O, CFC11, CFC12, CH4, and HCFC22.
61     !  
62     !  WARNING: This routine is tested only with SC_GridComp turned OFF.
63     !
64     ! !REVISION HISTORY:
65     !
66     !       2000 Nielsen   Initial coding
67     !   4Mar2005 Nielsen   Implementation of parameterized ozone chemistry
68     !  16Sep2005 da Silva  1) No longer gets nForO3/Ox from RC file - retrieves it
69     !                      from chem registry instead; 2) no longer enforces 
70     !                      1D decomp; only fills export if associated
71     !  20Sep2005 Nielsen   Added N2O, CFC-11, CFC-12, CH4, HCFC-22.
72     !
73     !EOP
74     !-------------------------------------------------------------------------
75     
76       TYPE O3_GridComp
77     
78       CHARACTER(LEN=255) :: name = "Parameterized ozone chemistry"
79     
80     !  Items in O3_GridComp.rc
81     
82     !  Diagnostic print outs
83     
84             LOGICAL :: verbose
85     
86     ! Ozone is derived from parameterized odd-oxygen. Ox must transported.
87     ! gcO3%nForO3 specifies position in q [w_c%qa(nForOx)%data3d(:,:,:)] for Ox.
88     
89             INTEGER :: nForOx
90     
91     ! If gcO3%nForO3 is less than or equal to zero, then the ozone climatology 
92     ! that is specified in ccmrun.namelist is used in the radiative transfer
93     ! scheme.  If gcO3%nForO3 is greater than zero, then the model will replace
94     ! the ozone climatology with the species [hopefully ozone!] that resides 
95     ! in q(:,:,:,gcO3%nForO3).
96     
97             INTEGER :: nForO3
98     
99     ! There may be more than one active grid component module doing ozone 
100     ! chemistry.  So, when gcO3%nForO3 is greater than zero the model must 
101     ! determine which module will be allowed to award its modifications to
102     ! q(:,:,:,gcO3%nForO3).  Each module doing ozone chemistry has its own
103     ! linkO3 switch.  The user chooses the module that supplies the desired 
104     ! ozone by setting the linkO3 switch to 1 in that module's .rc file.  
105     ! To avoid ambiguity, one and only one linkO3 can be turned on.
106     
107             LOGICAL :: linkO3
108     
109     ! Is ozone that is passed to the physics driver [w_c%qa(nForO3)%data3d(:,:,:)] 
110     ! in parts per million by volume?  Note: The radiative transfer scheme
111     ! requires ozone to be in volume mixing ratio (mole fraction).
112     
113             LOGICAL :: O3inPPMV
114     
115     ! Time step length
116     
117             REAL :: cdt
118     
119       END TYPE O3_GridComp
120     
121     CONTAINS
122     
123     !-------------------------------------------------------------------------
124     !NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1, GEOS/DAS!
125     !-------------------------------------------------------------------------
126     !BOP
127     !
128     ! !IROUTINE:  O3_GridCompInitialize --- Initialize O3_GridComp
129     !
130     ! !INTERFACE:
131     !
132     
133        SUBROUTINE O3_GridCompInitialize ( gcO3, w_c, impChem, expChem, &
134                                           nymd, nhms, tdt, rc )
135     
136     ! !USES:
137     
138     !  ----------------------------------------------------------
139     !  This is not thread safe. Please fix it as soon as possible.
140     !  ------------------------------
141        USE O3_data, ONLY : prod, loss
142     !  ----------------------------------------------------------
143     
144       IMPLICIT none
145     
146     ! !INPUT PARAMETERS:
147     
148        TYPE(Chem_Bundle), INTENT(in) :: w_c     ! Chemical tracer fields, delp, +
149        INTEGER, INTENT(in) :: nymd, nhms	    ! time
150        REAL,    INTENT(in) :: tdt		    ! chemistry time step (secs)
151     
152     
153     ! !OUTPUT PARAMETERS:
154     
155        TYPE(O3_GridComp), INTENT(inout) :: gcO3     ! Grid Component
156        TYPE(ESMF_State), INTENT(inout)  :: impChem  ! Import State
157        TYPE(ESMF_State), INTENT(inout)  :: expChem  ! Export State
158        INTEGER, INTENT(out) ::  rc                  ! Error return code:
159                                                     !  0 - all is well
160                                                     !  1 - 
161     
162     ! !DESCRIPTION: Initializes the O3 Grid Component. It primarily sets
163     !               the import state for each active constituent package.
164     !
165     ! !REVISION HISTORY:
166     !
167     !  18Sep2003 da Silva  First crack.
168     !   4Mar2005 Nielsen   Implementation of parameterized ozone chemistry
169     !  20Sep2005 Nielsen   Added N2O, CFC-11, CFC-12, CH4, HCFC-22.
170     !
171     !EOP
172     !-------------------------------------------------------------------------
173     
174        CHARACTER(LEN=*), PARAMETER :: myname = 'O3_GridCompInitialize'
175     
176        CHARACTER(LEN=255) :: rcfilen = 'O3_GridComp.rc'
177     
178        CHARACTER(LEN=255) :: filename
179     
180        INTEGER :: ios, n
181        INTEGER, ALLOCATABLE :: ier(:)
182        INTEGER :: i, i1, i2, im, j1, j2, jm, km
183     
184        gcO3%name = 'Four-species parameterized chemistry'
185     
186     !  Initialize local variables
187     !  --------------------------
188        rc = 0
189        i1 = w_c%grid%i1
190        i2 = w_c%grid%i2
191        im = w_c%grid%im
192        
193        j1 = w_c%grid%j1
194        j2 = w_c%grid%j2
195        jm = w_c%grid%jm
196        
197        km = w_c%grid%km
198     
199        CALL init_()
200        IF ( rc /= 0 ) RETURN
201        
202        ier(:)=0
203     
204     !  Load resource file
205     !  ------------------
206        CALL I90_loadf ( TRIM(rcfilen), ier(1) )
207        IF ( ier(1) .NE. 0 ) THEN
208           CALL final_(10)
209           RETURN
210        END IF
211        ier(:)=0
212     
213     !  Parse resource file
214     !  -------------------   
215        CALL I90_label ( 'verbose:', ier(2) )
216        i = I90_gint( ier(3) )
217        IF(i == 0) THEN
218         gcO3%verbose = .FALSE.
219        ELSE
220         gcO3%verbose = .TRUE.
221        END IF
222     
223        CALL I90_label ( 'O3inPPMV:', ier(4) )
224        i = I90_gint( ier(5) )
225        IF(i == 0) THEN
226         gcO3%O3inPPMV = .FALSE.
227        ELSE
228         gcO3%O3inPPMV = .TRUE.
229        END IF
230     
231        CALL I90_label ( 'linkO3:', ier(6) )
232        i = I90_gint( ier(7) )
233        IF(i == 0) THEN
234         gcO3%linkO3 = .FALSE.
235        ELSE
236         gcO3%linkO3 = .TRUE.
237        END IF
238     
239     #ifdef VERY_DANGEROUS
240     
241     ! ------------------------------------------------------------------------------
242     ! Yes, dangerous, but ...
243     !
244     ! Parsing nForO3 from O3GridComp.rc instead of from Chem_Registry.rc
245     ! was implemented in GEOS-4 to enable the running of more than one
246     ! chemistry grid component with an ozone.  In GEOS-4's fvgcm.F a rather
247     ! cumbersome logic was implemented that allows the user to choose which of
248     ! the O3s will be used in the radiative transfer.  Read the comments in
249     ! O3_GridCompInitialize (above) to gain insight.
250     !
251     ! This can (should?) be changed, but it would destroy backward compatability.
252     ! On the other hand, it is not probable that multiple O3-containing grid 
253     ! components will ever be run in the same experiment.  
254     ! ------------------------------------------------------------------------------
255     
256        CALL I90_Label ( 'nForO3:', ier(8) )
257        gcO3%nForO3 = I90_Gint( ier(9) )
258     
259        CALL I90_Label ( 'nForOx:', ier(10) )
260        gcO3%nForOx = I90_Gint( ier(11) )
261     
262     #else
263     
264        gcO3%nForO3     = w_c%reg%i_O3
265        gcO3%nForOx     = w_c%reg%i_O3 + 1
266     
267     #endif
268     
269        CALL I90_label ( 'PandLFile:', ier(12) )
270        CALL I90_Gtoken( filename, ier(13) )
271     
272        IF( ANY( ier(1:128) /= 0 ) ) THEN
273         CALL final_(11)
274         RETURN
275        END IF
276        ier(:)=0
277     
278     #ifndef GEOS5
279     !\/--- cut --- --- cut --- --- cut --- --- cut --- --- cut --- --- cut ---\/ 
280     
281     ! Select fields to be produced in the export state.
282     ! -------------------------------------------------
283        CALL Chem_StateSetNeeded ( expChem, iO3PARAM, .TRUE., ier( 1) )
284        CALL Chem_StateSetNeeded ( expChem, iOX     , .TRUE., ier( 2) )
285     
286     !/\--- cut --- --- cut --- --- cut --- --- cut --- --- cut --- --- cut---/\
287     
288     #endif
289     
290     ! Allocate space for production rates and loss frequencies
291     ! --------------------------------------------------------
292        n = w_c%reg%n_O3 -1 !!!!- w_c%reg%j_O3 - 2
293        ALLOCATE( prod(jm,km,n,12), stat=ier( 3) )
294        ALLOCATE( loss(jm,km,n,12), stat=ier( 4) )
295     
296        IF( ANY( ier(1:128) /= 0 ) ) THEN
297         CALL final_(12)
298         RETURN
299        END IF
300        ier(:)=0
301     
302     !  Determine time step length (seconds)
303     !  ------------------------------------
304        gcO3%cdt = tdt
305     
306     !  Read the production rates and loss frequencies
307     !  ----------------------------------------------
308        IF(gcO3%linkO3) CALL rd_pl6(jm,km,filename,gcO3)
309     
310        RETURN
311     
312     CONTAINS
313     
314        SUBROUTINE init_()
315        INTEGER :: ios, n
316        n=128
317        ios=0
318        ALLOCATE ( ier(n), stat=ios )
319        IF ( ios /= 0 ) rc = 100
320        END SUBROUTINE init_
321     
322        SUBROUTINE final_(ierr)
323        INTEGER :: ios, ierr
324        DEALLOCATE ( ier, stat=ios )
325        CALL I90_release()
326        rc = ierr
327        END SUBROUTINE final_
328     
329        SUBROUTINE rd_pl6(jm,km,filename,gcO3)
330     ! ----------------------------------------------------------------------
331     !  Read the parameterized chemistry photochemical production rates and 
332     !  loss frequencies for the following six species in the given order:
333     !  Ox, N2O, CFC-11, CFC-12, CH4, and HCFC-22.
334     ! ----------------------------------------------------------------------
335     
336     !ALT this is very bad style. We need to store prod in an internal state!!!!
337        USE O3_data, ONLY : prod, loss
338     
339        IMPLICIT NONE
340     
341        INTEGER, INTENT(IN) :: jm,km
342        TYPE(O3_GridComp), INTENT(IN) :: gcO3     ! Grid Component
343        CHARACTER(LEN=255), INTENT(IN) :: filename
344     
345        INTEGER :: iuchem,jnp,m,nl,nspecies,s,status,iunit
346        REAL(KIND=4), ALLOCATABLE :: lat(:),prs(:),buffer(:,:)
347     
348     ! Find an available logical unit 
349     ! ------------------------------
350        iunit = luavail()
351     
352     ! Open the file for reading
353     ! -------------------------
354        OPEN(UNIT=iunit,FILE=TRIM(filename),STATUS='old', &
355             FORM='unformatted',ACTION='read',ACCESS='sequential')
356     
357     ! Read number of latitudes, number of layers, and
358     ! number of species that are contained in the file
359     ! ------------------------------------------------
360        READ(iunit) jnp,nl,nspecies
361        
362        ALLOCATE(lat(jnp),STAT=status)
363        ALLOCATE(prs( nl),STAT=status)
364        ALLOCATE(buffer(jnp,nl),STAT=status)
365     
366     !ALT should check return status
367        ALLOCATE(prod(jm,km,nspecies,12), stat=status)
368        ALLOCATE(loss(jm,km,nspecies,12), stat=status)
369     
370     ! Read the latitudes and pressures for
371     ! the production rates and loss frequencies
372     ! -----------------------------------------
373        READ(iunit) lat
374        READ(iunit) prs
375     
376     ! For each month and species, read (1) monthly mean volume mixing
377     ! ratio, (2) the production rates, and (3) the loss frequencies
378     ! ---------------------------------------------------------------
379        DO m=1,12
380         DO s=1,nspecies
381          READ(iunit) buffer
382          READ(iunit) buffer
383          prod(1:jm,1:km,s,m)=buffer(1:jm,1:km)
384          READ(iunit) buffer
385          loss(1:jm,1:km,s,m)=buffer(1:jm,1:km)
386         END DO
387        END DO
388     
389     ! Clean up
390     ! --------   
391        CLOSE(UNIT=iunit)
392     
393        DEALLOCATE(lat,STAT=status)
394        DEALLOCATE(prs,STAT=status)
395        DEALLOCATE(buffer,STAT=status)
396     
397        RETURN
398        END SUBROUTINE rd_pl6
399     
400       END SUBROUTINE O3_GridCompInitialize
401     
402     !-------------------------------------------------------------------------
403     !NASA/GSFC, Global Modeling and Assimilation Office, Code 900.3, GEOS/DAS!
404     !-------------------------------------------------------------------------
405     !BOP
406     !
407     ! !IROUTINE:  O3_GridCompRun --- The Chem Driver 
408     !
409     ! !INTERFACE:
410     !
411     
412        SUBROUTINE O3_GridCompRun ( gcO3, w_c, impChem, expChem, &
413                                    nymd, nhms, tdt, rc )
414     
415     ! !USES:
416     
417       IMPLICIT none
418     
419     ! !INPUT/OUTPUT PARAMETERS:
420     
421        TYPE(O3_GridComp), INTENT(IN)    :: gcO3   ! Grid Component
422        TYPE(Chem_Bundle), INTENT(INOUT) :: w_c    ! Chemical tracer fields   
423     
424     ! !INPUT PARAMETERS:
425     
426        TYPE(ESMF_State), INTENT(IN) :: impChem    ! Import State
427        INTEGER, INTENT(IN) :: nymd, nhms	      ! time
428        REAL,    INTENT(IN) :: tdt		      ! chemical timestep (secs)
429     
430     
431     ! !OUTPUT PARAMETERS:
432     
433        TYPE(ESMF_State), INTENT(INOUT) :: expChem   ! Export State
434        INTEGER, INTENT(OUT) ::  rc                  ! Error return code:
435                                                     !  0 - all is well
436                                                     !  1 -
437      
438     ! !DESCRIPTION: This routine implements a parameterized chemistry for
439     !               ozone. 
440     !
441     ! !REVISION HISTORY:
442     !
443     !  18Sep2003 da Silva  First crack.
444     !   4Mar2005 Nielsen   Implementation of parameterized ozone chemistry
445     !  20Sep2005 Nielsen   Added N2O, CFC-11, CFC-12, CH4, HCFC-22.
446     !
447     !EOP
448     !-------------------------------------------------------------------------
449     
450        CHARACTER(LEN=*), PARAMETER :: myname = 'O3_GridCompRun'
451     
452     !  Quantities to be exported
453     !  -------------------------
454        REAL, POINTER, DIMENSION(:,:,:) :: O3PARAM => null()
455        REAL, POINTER, DIMENSION(:,:,:) :: OX      => null()
456     
457     !  Local
458     !  -----
459        INTEGER :: i1, i2, im, ier(8)
460        INTEGER :: j1, j2, jm, km
461     
462        ier(:)=0
463     
464     !  Grid specs from Chem_Bundle%grid
465     !  --------------------------------
466        rc = 0
467        i1 = w_c%grid%i1
468        i2 = w_c%grid%i2
469        im = w_c%grid%im
470        
471        j1 = w_c%grid%j1
472        j2 = w_c%grid%j2
473        jm = w_c%grid%jm
474        
475        km = w_c%grid%km
476     
477        IF( ANY(ier(:) /= 0) ) THEN
478         rc = 31 
479         RETURN
480        END IF
481        ier(:)=0
482     
483     #ifndef GEOS5
484     !\/--- cut --- --- cut --- --- cut --- --- cut --- --- cut --- --- cut ---\/ 
485     
486     !  Assign pointers to 3D arrays for the export state
487     !  -------------------------------------------------
488         CALL Chem_StateGetArray3D( expChem, iO3PARAM, O3PARAM, ier( 1) )
489         CALL Chem_StateGetArray3D( expChem, iOX     , OX     , ier( 2) )
490     
491     !/\--- cut --- --- cut --- --- cut --- --- cut --- --- cut --- --- cut ---/\
492     
493     #endif
494     
495     !  Update the species with parameterized chemistry.
496     !  ------------------------------------------------
497        CALL pc6(i1,i2,im,j1,j2,km,nhms,nymd,gcO3,w_c)
498     
499     !  Fill the export state with updated mixing ratios
500     !  ------------------------------------------------
501        if(associated(O3PARAM)) O3PARAM(i1:i2,j1:j2,:) = w_c%qa(gcO3%nForO3)%data3d(i1:i2,j1:j2,:)
502        if(associated(OX)) OX(i1:i2,j1:j2,:) = w_c%qa(gcO3%nForOx)%data3d(i1:i2,j1:j2,:)
503     
504        RETURN
505     
506     CONTAINS
507     
508     !-------------------------------------------------------------------------
509     !NASA/GSFC, Global Modeling and Assimilation Office, Code 610.1, GEOS/DAS!
510     !-------------------------------------------------------------------------
511     !BOP
512     !
513     ! !SUBROUTINE pc6
514     !
515     !  Run the parameterized chemistry for the six species: Ox, N2O, CFC-11,
516     !  CFC-12, CH4, and HCFC-22.  Ozone is derived from Ox.
517     !
518     ! !INTERFACE:
519     !
520        SUBROUTINE pc6(i1,i2,im,j1,j2,km,nhms,nymd,gcO3,w_c)
521     
522     ! !USES:
523     
524       USE O3_data, ONLY : prod, loss
525     #if defined( SPMD )
526       USE mod_comm, ONLY : gid
527     #endif
528     
529       IMPLICIT NONE
530     
531     ! !DESCRIPTION:
532     !
533     !  This module implements a parameterized chemistry for ozone.  The
534     !  file that contains the production rates and loss frequencies, however,
535     !  has coefficients for 4 species:  Nitrous oxide, methane, odd-oxygen, 
536     !  and sulfur hexaflouride.
537     !
538     !  Advection produces the "intermediate" constituent distribution
539     !  before this routine is called.
540     !  
541     !  Important parameters
542     !
543     !  i1,i2,j1,j2  Latitude, longitude slice limits
544     !	 im,km  Number of longitudes,layers
545     !	  nhms  Time of day, hhmmss
546     !	  nymd  Date, ccyymmdd
547     !	   pPa  Pressures [Pa]
548     !	  loss  Loss frequencies, [1/sec]
549     !	  prod  Production rates, [parts/sec]
550     !         gcO3  O3 grid component
551     !        w_c%q  Constituent array
552     !           Ox  Parameterized odd oxygen
553     !        ro3ox  Ozone-to-odd oxygen ratio
554     !
555     !  USAGE NOTES
556     !
557     !  The coefficients are assumed to be provided once per month. 
558     !  Interpolation to the current day's values is based on using the 
559     !  previous and the current month's values before midmonth, and 
560     !  the current and the next month's values after midmonth.  Setting
561     !  verbose=.TRUE. below allows the user to check the date and time 
562     !  and the weighting.
563     !
564     !  The resulting O3 mole fraction is the product of the Ox mole fraction
565     !  multiplied by the O3-to-Ox ratio, ro3ox. At pressures greater than
566     !  approximately 1 hPa, ro3ox = 1 everywhere.  At pressures less than 
567     !  approximately 0.1 hPa, Ox is mostly O3 at night and ro3ox = 1.  During 
568     !  the day, ro3ox in this region depends to first order on pressure.
569     !
570     !  WAENINGS:
571     !
572     !  Programmed for GEOS-4 with a 1-D decomposition only.  For pressures less 
573     !  than or equal to 1 hPa, the layer mean and layer interface pressures must 
574     !  be isobaric.
575     !
576     ! !REVISION HISTORY:
577     !
578     !       1999 Nielsen   Initial coding for S.-J. Lin and the fvGCM.
579     !   4Mar2005 Nielsen   Adaptation to the O3 grid component module in GEOS4.
580     !  16Sep2005 da Silva  GEOS-5 mods.
581     !  20Sep2005 Nielsen   Added N2O, CFC-11, CFC-12, CH4, HCFC-22.
582     !
583     !EOP
584     !-------------------------------------------------------------------------
585     
586       TYPE(Chem_Bundle), INTENT(INOUT):: w_c      ! Chemical tracer fields	
587       TYPE(O3_GridComp), INTENT(IN) :: gcO3     ! Grid Component
588     
589       INTEGER, INTENT(IN) :: i1,i2,im,j1,j2,km,nymd,nhms
590       
591       INTEGER :: ic,j,k,k100Pa,m,m1,m2,nc,nextmon,nO3,nowday,nOx
592       INTEGER :: nowhrs,nowmin,nowmon,nowsec,nowyrs,pastmon
593       
594       INTEGER :: iflag(km)
595     
596       REAL :: pPa(i1:i2,j1:j2,km),Ox(i1:i2,j1:j2,km)
597       REAL :: cos(i1:i2),cosineZA(i1:i2,j1:j2),ro3ox(i1:i2,j1:j2,km)
598     
599       REAL :: c,calday,deg2rad,doy,dtchem,etyrs,f,fday,latRad
600       REAL :: midmonth,wgt1,wgt2
601       
602       CHARACTER(LEN=3), SAVE :: monthname(12)=(/'Jan','Feb','Mar','Apr', &
603                                                 'May','Jun','Jul','Aug', &
604                                                 'Sep','Oct','Nov','Dec'/)
605       INTEGER, SAVE :: monthdays(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
606     
607     ! Determine current year, month, and day plus time of day and
608     ! fractional day.
609     ! -----------------------------------------------------------
610       nowyrs=nymd/10000
611       nowmon=(nymd-nowyrs*10000)/100
612       nowday=nymd-nowyrs*10000-nowmon*100
613     
614       nowhrs=nhms/10000
615       nowmin=(nhms-nowhrs*10000)/100
616       nowsec=nhms-nowhrs*10000-nowmin*100
617     
618       fday=nowhrs/24.00+nowmin/1440.00+nowsec/86400.00
619       calday=nowday+fday-1.00
620     
621     ! Determine current day of year
622     ! -----------------------------
623       IF(nowmon == 1) THEN
624        doy = calday + 1
625       ELSE
626        doy = calday + 1 + SUM(monthdays(1:nowmon-1))
627       END IF
628     
629     ! Find midpoint in current month
630     ! ------------------------------
631       midmonth=monthdays(nowmon)*0.50
632     
633     ! Find previous and next month numbers
634     ! ------------------------------------
635       pastmon=nowmon-1
636       IF(pastmon .LE. 0) pastmon=12
637     
638       nextmon=nowmon+1
639       IF(nextmon .GE. 12) nextmon=1
640     
641     ! Before midmonth, use past month's data with wgt1 and m1 and
642     ! current month's data with wgt2 and m2.
643     ! After midmonth, use current month's data with wgt1 and m1 and
644     ! next month's data with wgt2 and m2.
645     ! -------------------------------------------------------------
646       IF(calday .LE. midmonth) THEN
647        wgt2=0.50*(1.00+calday/midmonth)
648        wgt1=1.00-wgt2
649        m2=nowmon
650        m1=pastmon
651       ELSE
652        wgt1=1.00-0.50*(calday-midmonth)/(monthdays(nowmon)-midmonth)
653        wgt2=1.00-wgt1
654        m1=nowmon
655        m2=nextmon
656       END IF
657       
658       nc=1
659     
660     ! Apply production and loss to N20, CFC-11, CFC-12, CH4,
661     ! and HCFC-22. Note: There is no P and/or L for O3.
662     ! ------------------------------------------------------
663       DO ic=w_c%reg%i_O3+2,w_c%reg%i_O3+6
664        nc=nc+1
665        DO k=1,km
666          DO j=j1,j2
667           w_c%qa(ic)%data3d(i1:i2,j,k)=w_c%qa(ic)%data3d(i1:i2,j,k)+gcO3%cdt* &
668                               (wgt1*prod(j,k,nc,m1)+wgt2*prod(j,k,nc,m2))
669           w_c%qa(ic)%data3d(i1:i2,j,k)=w_c%qa(ic)%data3d(i1:i2,j,k)/(1.00+gcO3%cdt* &
670             	          (wgt1*loss(j,k,nc,m1)+wgt2*loss(j,k,nc,m2)))
671         END DO
672        END DO
673       END DO
674     
675     ! Apply production and loss to Ox
676     ! -------------------------------
677       nO3=gcO3%nForO3
678       nOx=gcO3%nForOx
679       ic=1
680     
681     ! Convert ozone from ppmv to mole fraction (volume mixing ratio).
682     ! ---------------------------------------------------------------
683       IF(gcO3%O3inPPMV) w_c%qa(nO3)%data3d(i1:i2,j1:j2,:)=w_c%qa(nO3)%data3d(i1:i2,j1:j2,:)*1.00E-06
684      
685     ! Update Ox and O3
686     ! ----------------
687       DO k=1,km
688        DO j=j1,j2
689         Ox(i1:i2,j,k)=w_c%qa(nOx)%data3d(i1:i2,j,k)+gcO3%cdt* &
690                            (wgt1*prod(j,k,ic,m1)+wgt2*prod(j,k,ic,m2))
691         Ox(i1:i2,j,k)= Ox(i1:i2,j,k)/(1.00+gcO3%cdt* &
692             	       (wgt1*loss(j,k,ic,m1)+wgt2*loss(j,k,ic,m2)))
693        END DO
694       END DO
695     
696     ! Define the O3-to-Ox ratio
697     ! -------------------------
698       ro3ox(i1:i2,j1:j2,:)=1.00
699     
700     ! The following section modifies ro3ox based on pressure 
701     ! and zenith angle. It is skipped if ptop > 1 hPa.
702     ! ------------------------------------------------------
703       Mods: IF(w_c%grid%ptop < 100.00) THEN
704     
705     ! Find zenith angle either by GEOS-4 or GEOS-5 
706     ! --------------------------------------------
707        IF(ASSOCIATED(w_c%cosz)) THEN
708         cosineZA = w_c%cosz
709        ELSE
710         deg2rad=0.0174533
711         DO j=j1,j2
712            latRad=(w_c%grid%lat_min+(j-1)*w_c%grid%lat_del)*deg2rad
713            CALL zenith(doy,.FALSE.,latRad,cos)
714            cosineZA(i1:i2,j)=cos(i1:i2)
715         END DO
716        END IF
717     
718     ! Get pressure from delp and ptop
719     ! -------------------------------
720        pPa(i1:i2,j1:j2,1)=w_c%grid%ptop+0.50*w_c%delp(i1:i2,j1:j2,1)
721        DO k=2,km
722         pPa(i1:i2,j1:j2,k) = pPa(i1:i2,j1:j2,k-1)+0.50*w_c%delp(i1:i2,j1:j2,k-1)+ &
723                                                   0.50*w_c%delp(i1:i2,j1:j2,k  )
724        END DO
725     
726     ! Restrict work area to the top k100Pa layers
727     ! -------------------------------------------
728        iflag(:)=0
729        DO k=1,km
730         IF(pPa(i1,j1,k) .LE. 100.00) iflag(k)=1
731        END DO
732        k100Pa=SUM(iflag)
733        
734     ! Modify the O3-to-Ox ratio in the daytime
735     ! ----------------------------------------
736        DO k=1,k100Pa
737         f=EXP(-1.5*(LOG10(0.01*pPa(i1,j1,k)))**2)
738         WHERE(cosineZA(i1:i2,j1:j2) > -0.10) ro3ox(i1:i2,j1:j2,k)=f
739        END DO
740     
741       END IF Mods
742     
743     ! Apply Ox-to-O3 weighting to Ox to generate ozone.
744     ! -------------------------------------------------
745       w_c%qa(nO3)%data3d(i1:i2,j1:j2,:)=ro3ox(i1:i2,j1:j2,:)*Ox(i1:i2,j1:j2,:)
746     
747     ! Convert ozone from mole fraction (volume mixing ratio) to ppmv.
748     ! ---------------------------------------------------------------
749       IF(gcO3%O3inPPMV) w_c%qa(nO3)%data3d(i1:i2,j1:j2,:)=w_c%qa(nO3)%data3d(i1:i2,j1:j2,:)*1.00E+06
750     
751     ! Finally, put Ox back into the bundle.
752     ! -------------------------------------
753       w_c%qa(nOx)%data3d(i1:i2,j1:j2,:)=Ox(i1:i2,j1:j2,:)
754     
755     ! Verify month selection and weighting if verbose is .true.
756     ! ---------------------------------------------------------
757       IF(gcO3%verbose .AND. gid .EQ. 0) THEN
758     
759        ic=3
760        PRINT 101
761        PRINT 102, nowyrs,nowmon,nowday,nowhrs,nowmin,nowsec, &
762                   calday,midmonth,m1,wgt1,m2,wgt2
763       END IF
764     
765       101 FORMAT(/,'PC6: Date and weights:',/, &
766          	    ' Year Month Day Hour Minute Second CalDay Midmonth ', &
767          	    'Month 1 Weight Month 2 Weight',/, &
768          	    ' ---- ----- --- ---- ------ ------ ------ -------- ', &
769          	    '------- ------ ------- ------')
770       102 FORMAT(' ',i4,i6,i4,i5,i7,i7,1x,f6.3,1x,f8.2,2(1x,i7,1x,f6.3))
771     
772       RETURN
773       END SUBROUTINE pc6
774     
775      END SUBROUTINE O3_GridCompRun
776     
777     !-------------------------------------------------------------------------
778     !NASA/GSFC, Global Modeling and Assimilation Office, Code 900.3, GEOS/DAS!
779     !-------------------------------------------------------------------------
780     !BOP
781     !
782     ! !IROUTINE:  O3_GridCompFinalize --- The Chem Driver 
783     !
784     ! !INTERFACE:
785     !
786     
787        SUBROUTINE O3_GridCompFinalize ( gcO3, w_c, impChem, expChem, &
788                                         nymd, nhms, cdt, rc )
789     
790     ! !USES:
791     
792       USE O3_data, ONLY : prod, loss
793     
794       IMPLICIT none
795     
796     ! !INPUT/OUTPUT PARAMETERS:
797     
798        TYPE(O3_GridComp), INTENT(inout) :: gcO3   ! Grid Component
799     
800     ! !INPUT PARAMETERS:
801     
802        TYPE(Chem_Bundle), INTENT(in)  :: w_c      ! Chemical tracer fields   
803        INTEGER, INTENT(in) :: nymd, nhms	      ! time
804        REAL,    INTENT(in) :: cdt  	              ! chemical timestep (secs)
805     
806     
807     ! !OUTPUT PARAMETERS:
808     
809        TYPE(ESMF_State), INTENT(inout) :: impChem	! Import State
810        TYPE(ESMF_State), INTENT(inout) :: expChem	! Import State
811        INTEGER, INTENT(out) ::  rc                  ! Error return code:
812                                                     !  0 - all is well
813                                                     !  1 -
814      
815     ! !DESCRIPTION: This routine finalizes this Grid Component.
816     !
817     ! !REVISION HISTORY:
818     !
819     !  18Sep2003 da Silva  First crack.
820     !   4Mar2005 Nielsen   Added deallocates for Ox P and L
821     !  20Sep2005 Nielsen   Added N2O, CFC-11, CFC-12, CH4, HCFC-22.
822     !
823     !EOP
824     !-------------------------------------------------------------------------
825     
826        CHARACTER(LEN=*), PARAMETER :: myname = 'O3_GridCompFinalize'
827        
828        rc=0
829     
830        DEALLOCATE( prod , stat=rc )
831        DEALLOCATE( loss , stat=rc )
832     
833        RETURN
834     
835      END SUBROUTINE O3_GridCompFinalize
836     
837      END MODULE O3_GridCompMod
838     
839     
840