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
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