/[MITgcm]/MITgcm_contrib/jscott/igsm/src/atmosphere.F
ViewVC logotype

Diff of /MITgcm_contrib/jscott/igsm/src/atmosphere.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.4 by jscott, Mon Apr 23 21:20:17 2007 UTC revision 1.12 by jscott, Thu Sep 17 15:48:38 2009 UTC
# Line 1  Line 1 
1  c source sokolov users  76203 Apr  7 12:46 atmosphere.F  C $Header$
2    C $Name$
3    
4  #include "ctrparam.h"  #include "ctrparam.h"
5    
# Line 89  C     COMMON/KEYS/KEYNR(42,50) Line 90  C     COMMON/KEYS/KEYNR(42,50)
90        common/SURRAD/TRSURF(JM0,4),SRSURF(JM0,4)        common/SURRAD/TRSURF(JM0,4),SRSURF(JM0,4)
91        dimension RTGOAV(JM0,lmo)        dimension RTGOAV(JM0,lmo)
92        common/tprmtg/tprmg(JM0),ntprmg(JM0)        common/tprmtg/tprmg(JM0),ntprmg(JM0)
93        common/aexpc/AEXP,ISTRT1,ISTRTCHEM,LYEAREM        common/aexpc/AEXP,ISTRT1,ISTRTCHEM
94        common/mixlr/Z1OAV(JM0),NZ1OAV(JM0)        common/mixlr/Z1OAV(JM0),NZ1OAV(JM0)
95        common/flxio/FLIO(JM0),NFLIO(JM0)        common/flxio/FLIO(JM0),NFLIO(JM0)
96        common/surps/srps(JM0+3),nsrps        common/surps/srps(JM0+3),nsrps
# Line 117  C  For TEM Line 118  C  For TEM
118  #endif  #endif
119    
120  #if ( defined  CPL_OCEANCO2 )  #if ( defined  CPL_OCEANCO2 )
121  #include "OCM.COM"  #include "OCM.h"
122        common /Garyflux/pC_atm(jm0),wind_amp,fluxco2(jm0)        common /Garyflux/pC_atm(jm0),wind_amp,fluxco2(jm0)
123  #  if ( defined ML_2D )  #  if ( defined ML_2D )
124        common/Garyclim/tggary(jm0),wsgary(jm0),areaml(jm0),arsrf(jm0)        common/Garyclim/tggary(jm0),wsgary(jm0),areaml(jm0),arsrf(jm0)
# Line 215  C     CALL ENQJOB Line 216  C     CALL ENQJOB
216  ! --- Set year and month index:  ! --- Set year and month index:
217  !  !
218        myyear  = 1       !year from starting point        myyear  = 1       !year from starting point
219        myyear  = JYEAR-1976       !year from starting point        iyearchem  = 1       !year from starting point
 !     myyear  = JYEAR-1891       !year from starting point  
       print *,'Emissioms for ',nchemyr,' year'  
       myyearlast  = min(LYEAREM-1976,nchemyr)  !last year of emission  
 !     myyearlast  = min(LYEAREM-1891,nchemyr)  !last year of emission  
 !     myyear = min(myyear,nchemyr)  
       myyear = min(myyear,myyearlast)  
220        mymonth = 1       !month        mymonth = 1       !month
221    
222        ihaha = 1        ihaha = 1
# Line 235  C     CALL ENQJOB Line 230  C     CALL ENQJOB
230        do k=1,nlev        do k=1,nlev
231          cfcnsf(k) = 0.0          cfcnsf(k) = 0.0
232        enddo        enddo
       print *,'First year of emissions ', myyear  
 !     print *,'Emission will be fixed at year ',LYEAREM  
       print *,'Emission will be fixed at year ',1976+myyearlast  
 !     print *,'Emission will be fixed at year ',1891+myyearlast  
233  !  !
234  #endif  #endif
235    
# Line 335  C*** Line 326  C***
326            READ (546)              READ (546)  
327    245    continue    245    continue
328        endif        endif
       WRITE(503) OFFSSW                                                   17.1    
       REWIND 503                                                          17.2    
329  c     CALL FRTR0(IO)                                                      18.    c     CALL FRTR0(IO)                                                      18.  
330        KBGN=KINC+1                                                         18.5          KBGN=KINC+1                                                         18.5  
331        KM2=KM*2-1                                                          18.51        KM2=KM*2-1                                                          18.51
# Line 365  C**** INITIALIZE TIME PARAMETERS Line 354  C**** INITIALIZE TIME PARAMETERS
354        NSTEP2=NSTEP                                                        29.6          NSTEP2=NSTEP                                                        29.6  
355        MRCHT=0.                                                            29.7          MRCHT=0.                                                            29.7  
356        ITAU=(NSTEP+NSTEP0)*IDTHR                                           30.          ITAU=(NSTEP+NSTEP0)*IDTHR                                           30.  
357        TAU=FLOAT(ITAU)/XINT                                                31.    cjrs changed to dfloat 8/2/07
358          TAU=DFLOAT(ITAU)/XINT                                               31.  
359        IDAY=1+ITAU/I24                                                     32.          IDAY=1+ITAU/I24                                                     32.  
360        TOFDAY=(ITAU-(IDAY-1)*I24)/XINT                                     33.          TOFDAY=(ITAU-(IDAY-1)*I24)/XINT                                     33.  
361  !     if(ISTART.eq.2.or.ISTRT1.eq.0.and..not.CONTRR)then  !     if(ISTART.eq.2.or.ISTRT1.eq.0.and..not.CONTRR)then
# Line 451  C  For TEM Line 441  C  For TEM
441  c      New run  c      New run
442  c      Reading from flin_nep  c      Reading from flin_nep
443          read(537)adupt,temco2          read(537)adupt,temco2
444         else       &     ,temch4,temn2o
445          else
446  c      Restart of the run  c      Restart of the run
447  c      Reading from last_nep  c      Reading from last_nep
448          read(367)adupt,temco2  cjrs   file previously opened in input.F
449  !    &          ,temch4,temn2o         read(876)adupt,temco2
450          rewind 367       &    ,temch4,temn2o
451         endif  C       CLOSE(876)
452  !         rewind 876
453  !      adupt= 1.459814341652516        endif
454  !      adupt= 0.9078891180588442  
455  !      adupt= 0.25  cjrs next line per Andrei instruction 10/12/07
456  !      adupt= -0.1123070421398009        adupt= 0.0
 !  
 !      adupt= adupt+0.9 ! for vs23  
457    
458         aduptd=adupt/(365.*JM)         aduptd=adupt/(365.*JM)
459         temnepgl=0.0         temnepgl=0.0
# Line 544  CJRS removed below from ocean_3d Line 533  CJRS removed below from ocean_3d
533  #if ( defined CLM )  #if ( defined CLM )
534        NOCLM=.false.        NOCLM=.false.
535  #endif  #endif
       co2mmavd=0.0  
536        print *,' atmosphere DTATM=',DTATM        print *,' atmosphere DTATM=',DTATM
537        print *,' It is running'        print *,' It is running'
538        print *,'End of atmospheric model initialization'        print *,'End of atmospheric model initialization'
# Line 587  cjrs change var name to arunoff Line 575  cjrs change var name to arunoff
575             solarnet_ice(j)=0.             solarnet_ice(j)=0.
576             solarinc_ocean(j)=0.             solarinc_ocean(j)=0.
577             solarnet_ocean(j)=0.             solarnet_ocean(j)=0.
578  Cjrs why?           surfpr(j)=0.  Cjrs not used anymore (?)           surfpr(j)=0.
579             naveo(j)=0.             naveo(j)=0.
580             navei(j)=0.             navei(j)=0.
581             navrad(j)=0.             navrad(j)=0.
# Line 601  c Line 589  c
589  c  c
590           enddo           enddo
591  #endif  #endif
592  #if ( defined OCEAN_3D && defined CPL_OCEANCO2 )  #ifdef OCEAN_3D
593  !      SECDAY=24.*3600.  C get data from atm-ocean common block
594         SECDAY=DTATM*3600.         do j=1,jm0
595         co2mmav=0.0           ODATA(1,j,1)=mmsst(j)
596         do j=1,jmocean           ODATA(1,j,2)=mmfice(j)
597           co2mmav=co2mmav+mmco2flux(j)           GDATA(1,j,3)=mmtice(j)
598         enddo           GDATA(1,j,1)=mmsnowm(j)
599         print *,'CO2F form ocean TAU=',TAU,co2mmav*12.e-15           ODATA(1,j,3)=mmicem(j)
600  Cjrs *** this block needs attention?? ***           GDATA(1,j,7)=0.5*(mmtice2(j)+mmtice1(j))
601  Cjrs       fluxco2(1)=fluxco2(1)+SECDAY*mmco2flux(1)  #  ifdef CPL_OCEANCO2
602         fluxco2(1)=fluxco2(1) + SECDAY*mmco2flux(2)             fluxco2(j)=fluxco2(j) + dtatm*3600.*mmco2flux(j)
603         do j=2,jm-1  #  endif
         fluxco2(j)=fluxco2(j)+SECDAY*mmco2flux(j-1)  
604         enddo         enddo
605  Cjrs       fluxco2(JM)=fluxco2(JM)+SECDAY*mmco2flux(JMOCEAN)  #endif
        fluxco2(JM)=fluxco2(JM) + SECDAY*mmco2flux(JM-1)  
 # endif  
   
606        WLMMAX=0.0        WLMMAX=0.0
607  C  C
608    100 IF(.NOT.EVENT(TAUT)) GO TO 200                                      46.      100 IF(.NOT.EVENT(TAUT)) GO TO 200                                      46.  
# Line 667  C**** WRITE RESTART INFORMATION ONTO DIS Line 651  C**** WRITE RESTART INFORMATION ONTO DIS
651        PERCNT=100.*MELSE/(MSTART-MNOW+1.E-5)                               56.          PERCNT=100.*MELSE/(MSTART-MNOW+1.E-5)                               56.  
652        MLAST=MNOW                                                          59.          MLAST=MNOW                                                          59.  
653  C**** TEST FOR TERMINATION OF RUN                                         60.    C**** TEST FOR TERMINATION OF RUN                                         60.  
654    200 READ (503,END=210) LABSSW                                           61.      200 continue
655  c     HPRNT=TAU.gt.45.0.and.TAU.lt.60.0  c     HPRNT=TAU.gt.45.0.and.TAU.lt.60.0
656  c     HPRNT=TAU.gt.470.0.and.TAU.lt.550.0  c     HPRNT=TAU.gt.470.0.and.TAU.lt.550.0
657        NCOMP=0        NCOMP=0
   210 REWIND 503                                                          61.1    
       IF(LABSSW.EQ.LABEL1) KSS6=1                                         61.2    
       IF(KSS6.EQ.1) GO TO 800                                             62.    
658        IF(TAU+.06125.GE.TAUE) GO TO 820                                    63.          IF(TAU+.06125.GE.TAUE) GO TO 820                                    63.  
659        JDAY00=JDAY        JDAY00=JDAY
660  C**** IF TIME TO ZERO OUT DIAGNOSTIC ACCUMULATING ARRAYS, DO SO           64.    C**** IF TIME TO ZERO OUT DIAGNOSTIC ACCUMULATING ARRAYS, DO SO           64.  
# Line 932  C**** CONDENSTATION, SUPER SATURATION AN Line 913  C**** CONDENSTATION, SUPER SATURATION AN
913    
914          call chemmass66(1.0, 1.0,zco2,zco2mass)          call chemmass66(1.0, 1.0,zco2,zco2mass)
915    
916          call chemmass6(150.0,1.0,xn2o,xn2omass)  !call chemmass6(150.0,1.0,xn2o,xn2omass)
917            call chemmass6(120.0,1.0,xn2o,xn2omass)
918          call chemmass2(1.0,ch4, ch4mass )          call chemmass2(1.0,ch4, ch4mass )
919    
920          ! === if hfc, pfc, and sf6 are included:          ! === if hfc, pfc, and sf6 are included:
# Line 1093  C**** SURFACE INTERACTION AND GROUND CAL Line 1075  C**** SURFACE INTERACTION AND GROUND CAL
1075        i=1        i=1
1076        do j=1,jm        do j=1,jm
1077           pcpl4clm(i,j)=pcpl4clm(i,j)*prlnd2total(j,mndriver)           pcpl4clm(i,j)=pcpl4clm(i,j)*prlnd2total(j,mndriver)
1078         &     *3600./(NDYN*DT)
1079           pcpc4clm(i,j)=pcpc4clm(i,j)*prlnd2total(j,mndriver)           pcpc4clm(i,j)=pcpc4clm(i,j)*prlnd2total(j,mndriver)
1080         &     *3600./(NDYN*DT)
1081        enddo        enddo
1082  !     print *,' main after surf4clm',' TAU=',TAU  !     print *,' main after surf4clm',' TAU=',TAU
1083  !       print  ('2(12f7.2,/,11f7.2,/)'),ps4clm,pcpl4clm,  !       print  ('2(12f7.2,/,11f7.2,/)'),ps4clm,pcpl4clm,
# Line 1261  C**** UPDATE MODEL TIME AND CALL DAILY I Line 1245  C**** UPDATE MODEL TIME AND CALL DAILY I
1245  C****                                                                    189.    C****                                                                    189.  
1246    500 NSTEP=NSTEP+NDYN                                                   190.      500 NSTEP=NSTEP+NDYN                                                   190.  
1247        ITAU=(NSTEP+NSTEP0)*IDTHR                                          191.          ITAU=(NSTEP+NSTEP0)*IDTHR                                          191.  
1248        TAU=FLOAT(ITAU)/XINT                                               192.    cJRS fix to DFLOAT 8/2/07
1249          TAU=DFLOAT(ITAU)/XINT                                               192.  
1250        IDAY=1+ITAU/I24                                                    193.          IDAY=1+ITAU/I24                                                    193.  
1251        TOFDAYPR=TOFDAY+1.00        TOFDAYPR=TOFDAY+1.00
1252        TOFDAY=(ITAU-(IDAY-1)*I24)/XINT                                    194.          TOFDAY=(ITAU-(IDAY-1)*I24)/XINT                                    194.  
# Line 1454  c  Annual oceanic CO2 uptake Line 1439  c  Annual oceanic CO2 uptake
1439         do j=1,jm         do j=1,jm
1440           OCUPT=OCUPT+fluxco2(j)           OCUPT=OCUPT+fluxco2(j)
1441         enddo         enddo
1442        print *,' OCUPT=',OCUPT*12.e-15  !      print *,' OCUPT=',OCUPT*12.e-15
1443    
1444  #if ( defined CPL_CHEM )  #if ( defined CPL_CHEM )
1445  !  !
# Line 1594  cwrite(124)sfc3hro3 Line 1579  cwrite(124)sfc3hro3
1579  !  !
1580        mymonth = mymonth + 1        mymonth = mymonth + 1
1581        if(mymonth.gt.12)then        if(mymonth.gt.12)then
1582          myyear  = myyear +1          iyearchem  = iyearchem +1
 !       myyear = min(myyear,nchemyr)  
         myyear = min(myyear,myyearlast)  
1583          mymonth = 1          mymonth = 1
1584  !     endif ! 27/8/2005  !     endif ! 27/8/2005
1585    
# Line 1606  cwrite(124)sfc3hro3 Line 1589  cwrite(124)sfc3hro3
1589  ! ===   at end of each year: 27/8/2005  ! ===   at end of each year: 27/8/2005
1590  !  !
1591          rewind 178          rewind 178
1592          print *,'For chem restart ',myyear,mymonth          print *,'For chem restart ',iyearchem,mymonth
1593          write(178)myyear,mymonth,airmass,          write(178)iyearchem,mymonth,airmass,
1594       &              cfc11,cfc110,       &              cfc11,cfc110,
1595       &              cfc11m,       &              cfc11m,
1596       &              cfc11sd,       &              cfc11sd,
# Line 1883  c 820 WRITE (6,905) TAU,IDAY,TOFDAY Line 1866  c 820 WRITE (6,905) TAU,IDAY,TOFDAY
1866  C     DTATM time step of atm model in hours  C     DTATM time step of atm model in hours
1867  C     precip and evap in mm/day or kg/m**2/day  C     precip and evap in mm/day or kg/m**2/day
1868           do j=1,jm0           do j=1,jm0
1869  #if ( defined OCEAN_3D && defined CPL_OCEANCO2 )  Cjrs #if ( defined OCEAN_3D && defined CPL_OCEANCO2 )
1870             ncallatm=ncallatm+1  #ifdef OCEAN_3D
1871    !jrs           ncallatm=ncallatm+1
1872  ! 020107  ! 020107
1873  !          co24ocean(j)=pC_atm(j)*1.e6  !          co24ocean(j)=pC_atm(j)*1.e6
1874    ! jrs give CO2 even if ocn carbon off
1875             co24ocean(j)=atm_co2(j)             co24ocean(j)=atm_co2(j)
1876  ! 020107  #  ifdef CPL_OCEANCO2
1877             co24ocnan(j)=co24ocnan(j)+co24ocean(j)             co24ocnan(j)=co24ocnan(j)+co24ocean(j)
1878    #  endif
1879  #endif  #endif
1880  #ifdef ML_2D  #ifdef ML_2D
1881  cjrs block only MD_2D  cjrs block only MD_2D
# Line 2082  c      stop Line 2068  c      stop
2068        return        return
2069  C     CALL ENQJOB                                                        309.    C     CALL ENQJOB                                                        309.  
2070  C     CALL ENQJOB                                                        310.    C     CALL ENQJOB                                                        310.  
       IF(KSS6.EQ.1) STOP 12                                              310.1    
2071        IF(IPFLAG.EQ.0) STOP 13                                            311.          IF(IPFLAG.EQ.0) STOP 13                                            311.  
2072        STOP 1                                                             312.          STOP 1                                                             312.  
2073  C****                                                                    313.    C****                                                                    313.  
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22