igsm/src/chemglobal.F


#include "ctrparam.h"

!       ==========================================================
!
!       CHEMGLOBAL.F:   Subroutine for calculating global averaged
!                        vertical profiles of trace gases
!
!       ----------------------------------------------------------
!
!       Author:         Chien Wang
!                       MIT Joint Program on Science and Policy
!                               of Global Change
!
!       ----------------------------------------------------------
! 
!       Revision History:
!       
!       When    Who             What
!       ----    ----------      ------- 
!       080100  Chien Wang      repack based on CliChem3 & add cpp
!
!       ==========================================================

        subroutine chemglobal(p)
!       ========================

#include "chem_para"
#include "chem_com"

        dimension p(nlon,nlat)
!       ----------------------------------------------

        ptotal = 0.0
        do j=1,nlat
          ptotal = ptotal + p(1,j)
        enddo
        xxx = 1./ptotal

        do 1 k=1,nlev

          glbgas(k,1) = 0.0             !CO2
          glbgas(k,2) = 0.0             !N2O
          glbgas(k,3) = 0.0             !CH4
          glbgas(k,4) = 0.0             !F11
          glbgas(k,5) = 0.0             !F12

      do j=1,nlat
        glbgas(k,1) = glbgas(k,1)
     &              + zco2  (1,j,k)
     &                    *p(1,j)
        glbgas(k,2) = glbgas(k,2)
     &              + xn2o  (1,j,k)
     &                    *p(1,j)
        glbgas(k,3) = glbgas(k,3)
     &              + ch4   (1,j,k)
     &                    *p(1,j)
        glbgas(k,4) = glbgas(k,4)
     &              + cfc11 (1,j,k)
     &                    *p(1,j)
        glbgas(k,5) = glbgas(k,5)
     &              + cfc12 (1,j,k)
     &                    *p(1,j)
      enddo
        
        glbgas(k,1) = glbgas(k,1)*xxx
        glbgas(k,2) = glbgas(k,2)*xxx
        glbgas(k,3) = glbgas(k,3)*xxx
        glbgas(k,4) = glbgas(k,4)*xxx
        glbgas(k,5) = glbgas(k,5)*xxx

1       continue

      return
       end

     
1	jscott	1.1
2			#include "ctrparam.h"
3
4			! ==========================================================
5			!
6			! CHEMGLOBAL.F: Subroutine for calculating global averaged
7			! vertical profiles of trace gases
8			!
9			! ----------------------------------------------------------
10			!
11			! Author: Chien Wang
12			! MIT Joint Program on Science and Policy
13			! of Global Change
14			!
15			! ----------------------------------------------------------
16			!
17			! Revision History:
18			!
19			! When Who What
20			! ---- ---------- -------
21			! 080100 Chien Wang repack based on CliChem3 & add cpp
22			!
23			! ==========================================================
24
25			subroutine chemglobal(p)
26			! ========================
27
28			#include "chem_para"
29			#include "chem_com"
30
31			dimension p(nlon,nlat)
32			! ----------------------------------------------
33
34			ptotal = 0.0
35			do j=1,nlat
36			ptotal = ptotal + p(1,j)
37			enddo
38			xxx = 1./ptotal
39
40			do 1 k=1,nlev
41
42			glbgas(k,1) = 0.0 !CO2
43			glbgas(k,2) = 0.0 !N2O
44			glbgas(k,3) = 0.0 !CH4
45			glbgas(k,4) = 0.0 !F11
46			glbgas(k,5) = 0.0 !F12
47
48			do j=1,nlat
49			glbgas(k,1) = glbgas(k,1)
50			& + zco2 (1,j,k)
51			& *p(1,j)
52			glbgas(k,2) = glbgas(k,2)
53			& + xn2o (1,j,k)
54			& *p(1,j)
55			glbgas(k,3) = glbgas(k,3)
56			& + ch4 (1,j,k)
57			& *p(1,j)
58			glbgas(k,4) = glbgas(k,4)
59			& + cfc11 (1,j,k)
60			& *p(1,j)
61			glbgas(k,5) = glbgas(k,5)
62			& + cfc12 (1,j,k)
63			& *p(1,j)
64			enddo
65
66			glbgas(k,1) = glbgas(k,1)*xxx
67			glbgas(k,2) = glbgas(k,2)*xxx
68			glbgas(k,3) = glbgas(k,3)*xxx
69			glbgas(k,4) = glbgas(k,4)*xxx
70			glbgas(k,5) = glbgas(k,5)*xxx
71
72			1 continue
73
74			return
75			end
76
77