SUBROUTINE LIFETIME

#include "com2d.h"
      DIMENSION CLDEN(16,L$,Z$)
c      print *,' iyr in lifetime=',iyr

       IF(YSLFPRNT)GO TO 200

       DO 350 IJ=1,L$
          DO 350 IK=1,Z$
             CLDEN(1,IJ,IK)=C(11,IJ,IK)
C  C(11)  IS N2O
             CLDEN(2,IJ,IK)=C(34,IJ,IK)
C  C(34)  IS CFCL3 (F11)
             CLDEN(3,IJ,IK)=C(35,IJ,IK)
C  C(35)  IS CF2CL2 (F12)
             CLDEN(4,IJ,IK)=C(36,IJ,IK)
C  C(36)  IS CCL4
             CLDEN(5,IJ,IK)=C(37,IJ,IK)
C  C(37)  IS CH3CL
             CLDEN(6,IJ,IK)=C(18,IJ,IK)
C  C(18)  IS CH4
             CLDEN(7,IJ,IK)=C(40,IJ,IK)
C  C(40)  IS CH3CCL3
             CLDEN(8,IJ,IK)=C(19,IJ,IK)
C  C(19)  IS CO
             CLDEN(9,IJ,IK)=C(17,IJ,IK)
C  C(17)  IS H2
             CLDEN(10,IJ,IK)=C(49,IJ,IK)
C  C(49)  IS CH3BR
             CLDEN(11,IJ,IK)=C(52,IJ,IK)
C  C(52)  IS CHCLF2
             CLDEN(12,IJ,IK)=C(53,IJ,IK)
C  C(53)  IS C2CL3F3
             CLDEN(13,IJ,IK)=C(54,IJ,IK)
C  C(54)  IS C2CL2F4
             CLDEN(14,IJ,IK)=C(55,IJ,IK)
C  C(55)  IS C2CLF5
             CLDEN(15,IJ,IK)=C(51,IJ,IK)
C  C(51)  IS CBRCLF2
             CLDEN(16,IJ,IK)=C(50,IJ,IK)
C  C(50)  IS CBRF3
 350         CONTINUE


      DO 150 IU=1,16
       DO 150 IJ=1,L$
       DO 110 IK1=2,Z$
          IK=Z$+1-IK1

         COLUMN(IU,IJ)=COLUMN(IU,IJ) + 
     C  0.5*(ZKM(IJ,IK+1)-ZKM(IJ,IK))*
     C  (CLDEN(IU,IJ,IK+1)+CLDEN(IU,IJ,IK))*1.E5

         CLOSS(IU,IJ)=CLOSS(IU,IJ) + 
     C  0.5*(ZKM(IJ,IK+1)-ZKM(IJ,IK))*
     C  (RLOSS(IU,IJ,IK+1)*CLDEN(IU,IJ,IK+1)+
     C  RLOSS(IU,IJ,IK)*CLDEN(IU,IJ,IK))*1.E5

C         if(iu.eq.1)print *,' col closs zkm clden rloss ij ik',
C     c  column(iu,ij),closs(iu,ij),zkm(ij,ik+1),zkm(ij,ik),
C     c  rloss(iu,ij,ik+1),rloss

         IF(IK.GE.8 .AND. IK.LE.24)
     C  CLOSSST(IU,IJ)=CLOSSST(IU,IJ) +
     C  0.5*(ZKM(IJ,IK+1)-ZKM(IJ,IK))*
     C  (RLOSS(IU,IJ,IK+1)*CLDEN(IU,IJ,IK+1)+
     C  CLDEN(IU,IJ,IK)*RLOSS(IU,IJ,IK))*1.E5

         IF(IK.LE.7)
     C  CLOSSTR(IU,IJ)=CLOSSTR(IU,IJ) +
     C  0.5*(ZKM(IJ,IK+1)-ZKM(IJ,IK))*
     C  (RLOSS(IU,IJ,IK+1)*CLDEN(IU,IJ,IK+1)+
     C  CLDEN(IU,IJ,IK)*RLOSS(IU,IJ,IK))*1.E5

110       CONTINUE

         COLUMN(IU,IJ)=COLUMN(IU,IJ) + 
     C  ZKM(IJ,1)*CLDEN(IU,IJ,1)*1.E5
C ADD IN THE LAST BIT OF COLUMN

         CLOSS(IU,IJ)=CLOSS(IU,IJ) + 
     C  ZKM(IJ,1)*RLOSS(IU,IJ,1)*CLDEN(IU,IJ,1)*1.E5
C ADD IN THE LAST BIT OF LOSS

         IF(IK.LE.7)
     C  CLOSSTR(IU,IJ)=CLOSSTR(IU,IJ) +
     C  ZKM(IJ,1)*RLOSS(IU,IJ,1)*CLDEN(IU,IJ,1)*1.E5
C ADD IN THE LAST BIT OF LOSS FOR THE TROPOSPHERE

150       CONTINUE

   
       SAVE
       RETURN

200    CONTINUE


       WRITE(51,5339)IYR
5339   FORMAT(//////,' AT YEAR=',I5,/)
       DO 5300 IU=1,16
       COLT=0.0
       CLST=0.0
       CLSTST=0.0
       CLSTTR=0.0
       DO 5100 IJ=1,L$
       COLT=COLT + COLUMN(IU,IJ)*AREA(IJ)/2.
       CLST=CLST + CLOSS(IU,IJ)*AREA(IJ)/2.
       CLSTST=CLSTST + CLOSSST(IU,IJ)*AREA(IJ)/2.
       CLSTTR=CLSTTR + CLOSSTR(IU,IJ)*AREA(IJ)/2.
       CLIFE1=1.E30
       IF(CLOSS(IU,IJ).GT.1.E-30)
     *    CLIFE1=COLUMN(IU,IJ)/CLOSS(IU,IJ)
       CYR1=CLIFE1/3.1536e7
c       if(iu.eq.2)print *,' iu,ij,colt,clst,clstst,clsttr,
c     *  clife1,cyr1=',iu,ij,colt,clst,clstst,clsttr,clife1,cyr1
5100       CONTINUE
       CLIF=COLT/CLST
       CYR=CLIF/3.1536e7
C       print *,' iu,lifechar(iu),cyr=',iu,lifechar(iu),cyr
       WRITE(51,5337)LIFECHAR(IU),CYR
5337       FORMAT(' FOR SPECIES  ',A8,'  LIFETIME(YRS)=',1PE11.3)
        IF(IU.GE.5 .AND. IU.LE.7)THEN
          CLIFST=COLT/CLSTST
          CLIFTR=COLT/CLSTTR
          CLIFST=CLIFST/3.1536e7
          CLIFTR=CLIFTR/3.1536e7
          WRITE(51,5229)CLIFST,CLIFTR
5229      FORMAT(' CLIFST=',1PE11.3,' CLIFTR=',1PE11.3)
        ENDIF
        IF(IU.EQ.10 .OR. IU.EQ.11)THEN
          CLIFST=COLT/CLSTST
          CLIFTR=COLT/CLSTTR
          CLIFST=CLIFST/3.1536e7
          CLIFTR=CLIFTR/3.1536e7
          WRITE(51,5229)CLIFST,CLIFTR
        ENDIF
5300   CONTINUE

       DO 300 IU=1,16
       DO 100 IJ=1,L$
        COLUMN(IU,IJ)=0.0E0
        CLOSS(IU,IJ)=0.0E0
        CLOSSST(IU,IJ)=0.0E0
        CLOSSTR(IU,IJ)=0.0E0
100       CONTINUE
300       CONTINUE

  
       SAVE
       RETURN
      END