/[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.3 by jscott, Wed Sep 13 15:23:04 2006 UTC revision 1.12 by jscott, Thu Sep 17 15:48:38 2009 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "ctrparam.h"  #include "ctrparam.h"
5    
# Line 88  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 108  c     character *8 buf1 Line 110  c     character *8 buf1
110        logical odifcarbon        logical odifcarbon
111    
112  #if ( defined CLM )  #if ( defined CLM )
113  #include "CLM.COM"  #  include "CLM.h"
114  !#include "TEM.COM"  #  if ( defined CPL_TEM )      
 #if ( defined CPL_TEM )        
115  C  For TEM  C  For TEM
116  #include "TEM.COM"  #    include "TEM.h"
117  #endif  #  endif
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)
125        common/Garydiff/depthml(jm0),edzon(jm0),dzg(lmo),dzog(lmo-1),        common/Garydiff/depthml(jm0),edzcar(jm0),dzg(lmo),dzog(lmo-1),
126       &Rco2(jm0,lmo),edohd(lmo),zg(lmo),focean(jm0)       &Rco2(jm0,lmo),edohd(lmo),zg(lmo),focean(jm0)
127        common /Garychem/Hg(jm0)        common /Garychem/Hg(jm0)
128        common/qfl/QFLUX(JM0,0:13),ZOAV(JM0),QFLUXT(JM0)        common/qfl/QFLUX(JM0,0:13),ZOAV(JM0),QFLUXT(JM0)
129        common /Garyvdif/iyearocm,vdfocm,acvdfc        common /Garyvdif/iyearocm,vdfocm,acvdfc
130         common /Garyvlog/odifcarbon        common /Garyvlog/odifcarbon,ocarcont
131          common /Garykvct/cfkvct,edzcart(jm0)
132  # endif  # endif
133  #endif  #endif
134    
135        INTEGER dtatm, mndriver   !routine arguments        INTEGER dtatm, mndriver   !routine arguments jrs
136    
137  #if ( defined OCEAN_3D || defined ML_2D )  #if ( defined OCEAN_3D || defined ML_2D )
138  #include "AGRID.h"  #include "AGRID.h"
139  C#include "HRD4OCN.COM"  Cjrs elimated COM file/moved elsewhere#include "HRD4OCN.COM"
140          dimension oimeltt(jm0),dhdtav(jm0),devdtav(jm0)          dimension oimeltt(jm0),dhdtav(jm0),devdtav(jm0)
141  #endif  #endif
142    
143  C **** CLEAR SKY  C **** CLEAR SKY
144        common/clrsk/CLEAR(JM0),NCLR(JM0),AJCLR(JM0,12),BJCLR(JM0,12),        common/clrsk/CLEAR(JM0),NCLR(JM0),AJCLR(JM0,12),BJCLR(JM0,12),
145       * CJCLR(JM0,12)       * CJCLR(JM0,12)
146        common/TSUR/TSURFC(JM0,0:13),TSURFT(JM0),TSURFD(JM0),DTSURF(JM0)  !     common/TSUR/TSURFC(JM0,0:13),TSURFT(JM0),TSURFD(JM0),DTSURF(JM0)
147        real TSURFW(JM0)  #include "TSRF.COM"
148          real TSURFW(JM0),TLANDW(JM0)
149        integer CLEAR        integer CLEAR
150    
151        common /ATCO2/atm_co2(jm0)        common /ATCO2/atm_co2(jm0)
# Line 205  c     CALL HARMO(36,1,24,ACO,BSI,CCO,DSI Line 209  c     CALL HARMO(36,1,24,ACO,BSI,CCO,DSI
209        IPFLAG=0                                                            15.          IPFLAG=0                                                            15.  
210  C     CALL ENQJOB                                                         16.    C     CALL ENQJOB                                                         16.  
211        CALL INPUT                                                          17.          CALL INPUT                                                          17.  
        print *,"After input"  
        print *,"TSURFD"  
        print *,TSURFD  
        print *,"TSURFT"  
        print *,TSURFT  
212                
213  #if ( defined CPL_CHEM )  #if ( defined CPL_CHEM )
214  !  !
# Line 217  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 237  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 257  c       LHORDIF=.false. Line 246  c       LHORDIF=.false.
246  #if ( defined CPL_OCEANCO2 && defined ML_2D )  #if ( defined CPL_OCEANCO2 && defined ML_2D )
247        odifcarbon=.true.        odifcarbon=.true.
248        wind_amp=1.        wind_amp=1.
249          dtco2=3600.*24.
250  c     ncallgary=0  c     ncallgary=0
251        do j=1,jm        do j=1,jm
252          areaml(j)=dxyp(j)*(1-FDATA(1,J,2))          areaml(j)=dxyp(j)*(1-FDATA(1,J,2))
# Line 264  c     ncallgary=0 Line 254  c     ncallgary=0
254          DEPTHML(j)=ZOAV(j)          DEPTHML(j)=ZOAV(j)
255        end do    !       j        end do    !       j
256          print *,' RCO2'          print *,' RCO2'
257          print 5001,((Rco2(j,k),j=1,jm),k=1,LMO)  !       print 5001,((Rco2(j,k),j=1,jm),k=1,LMO)
258            print 5001,((Rco2(j,k)*1.e2,j=1,jm),k=1,LMO)
259          dzog(1)=10./SQRT(1.7010587)          dzog(1)=10./SQRT(1.7010587)
260          dzg(2)=10.          dzg(2)=10.
261          do l=2,lmo-1          do l=2,lmo-1
# 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
362        do 458 j=1,JM  !     do 458 j=1,JM
363         TSURFD(j)=0.  !      TSURFD(j)=0.
364         TSURFT(j)=0.  !      TSURFT(j)=0.
365    458 continue  ! 458 continue
366        endif  !     endif
367        if(JDATE.eq.100)then        if(JDATE.eq.100)then
368         print *,JDATE,JMONTH,JYEAR         print *,JDATE,JMONTH,JYEAR
369         print *,' main before daily0'         print *,' main before daily0'
# Line 388  C**** INITIALIZE TIME PARAMETERS Line 378  C**** INITIALIZE TIME PARAMETERS
378        endif        endif
379        CALL DAILY_NEW0                                                         34.          CALL DAILY_NEW0                                                         34.  
380        print *,' Main after DAILYNEW0 JYEAR=',JYEAR        print *,' Main after DAILYNEW0 JYEAR=',JYEAR
381         print *,"DTSURF"         print *,"DT2MGL"
382         print *,DTSURF         print *,DT2MGL
383           print *,"DT2MLD"
384           print *,DT2MLD
385  #if( !defined OCEAN_3D&& !defined ML_2D )  #if( !defined OCEAN_3D&& !defined ML_2D )
386        CALL DAILY_OCEAN        CALL DAILY_OCEAN
387        print *,' AFTER DAILY_OCEAN IDAY=',IDAY,' IYEAR=',IYEAR        print *,' AFTER DAILY_OCEAN IDAY=',IDAY,' IYEAR=',IYEAR
# Line 438  c Line 430  c
430        JDATEATM=JDATE        JDATEATM=JDATE
431        JYEARATM=JYEAR        JYEARATM=JYEAR
432  C  C
433    #if ( defined  CPL_OCEANCO2 )
434           do j=1,jm
435            fluxco2(j)=0.0
436           enddo
437    #endif
438  #if ( defined CPL_CHEM) && ( defined CPL_TEM )  #if ( defined CPL_CHEM) && ( defined CPL_TEM )
439  C  For TEM  C  For TEM
440        if(ISTRT1.eq.0) then        if(ISTRT1.eq.0) then
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
457  !  
458         aduptd=adupt/(365.*JM)         aduptd=adupt/(365.*JM)
459         temnepgl=0.0         temnepgl=0.0
460          do j=1,jm          do j=1,jm
# Line 473  c      Reading from last_nep Line 471  c      Reading from last_nep
471         elseif(LMO.eq.12) then         elseif(LMO.eq.12) then
472           call ODIFS12           call ODIFS12
473         else         else
474           Print *,' Wromng LMO',LMO           Print *,' Wrong LMO',LMO
475           stop           stop
476         endif         endif
477        endif        endif
478  #endif  #endif
479  #if (defined PREDICTED_GASES)  !#if (defined PREDICTED_GASES)
480  #if (defined CPL_TEM || defined CPL_OCEANCO2 )  #if (defined CPL_TEM || defined CPL_OCEANCO2 )
481        if(OBSFOR) then        if(OBSFOR) then
482         call obsco2(iyear,imontha)         call obsco2(iyear,imontha)
483         mnobco2=imonth         mnobco2=imonth
484        endif        endif
485  #endif  #endif
486  #endif  !#endif
487    CJRS removed below from ocean_3d
488  #ifdef ML_2D  #ifdef ML_2D
489           do j=1,jm           do j=1,jm
490             do i=1,io             do i=1,io
# Line 524  c      Reading from last_nep Line 523  c      Reading from last_nep
523          enddo          enddo
524        endif        endif
525  #endif  #endif
526    #if (defined CPL_TEM || defined CPL_OCEANCO2 )
527          print *,'ATM_CO2'          print *,'ATM_CO2'
528          print *,atm_co2          print *,atm_co2
529    #endif
530        JDAYLAST=-1        JDAYLAST=-1
531        ncallclm=0        ncallclm=0
532        NOCLM=.true.        NOCLM=.true.
# Line 533  c      Reading from last_nep Line 534  c      Reading from last_nep
534        NOCLM=.false.        NOCLM=.false.
535  #endif  #endif
536        print *,' atmosphere DTATM=',DTATM        print *,' atmosphere DTATM=',DTATM
537          print *,' It is running'
538        print *,'End of atmospheric model initialization'        print *,'End of atmospheric model initialization'
539        print *,'  '        print *,'  '
540        print *,'  '        print *,'  '
# Line 550  cprint *,' atmosphere TAU=',tau Line 552  cprint *,' atmosphere TAU=',tau
552  c     HPRNT=TAU.ge.17520.0.and.TAU.lt.17545.0  c     HPRNT=TAU.ge.17520.0.and.TAU.lt.17545.0
553  c     print *,' TAUE=',TAUE  c     print *,' TAUE=',TAUE
554  #if ( defined OCEAN_3D || defined ML_2D)  #if ( defined OCEAN_3D || defined ML_2D)
 C         print *,'TAU,DTATM,TAUE: ', TAU,DTATM,TAUE  
          CALL OCEAN4ATM  
555           do j=1,jm0           do j=1,jm0
556             tauu(j)=0.             tauu(j)=0.
557             tauv(j)=0.             tauv(j)=0.
# Line 569  C         print *,'TAU,DTATM,TAUE: ', TA Line 569  C         print *,'TAU,DTATM,TAUE: ', TA
569             dhfidtgeq(j)=0.             dhfidtgeq(j)=0.
570             devidtgeq(j)=0.             devidtgeq(j)=0.
571             tempr(j)=0.             tempr(j)=0.
572    cjrs change var name to arunoff
573             arunoff(j)=0.             arunoff(j)=0.
574             solarinc_ice(j)=0.             solarinc_ice(j)=0.
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           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 588  c Line 589  c
589  c  c
590           enddo           enddo
591  #endif  #endif
592    #ifdef OCEAN_3D
593    C get data from atm-ocean common block
594           do j=1,jm0
595             ODATA(1,j,1)=mmsst(j)
596             ODATA(1,j,2)=mmfice(j)
597             GDATA(1,j,3)=mmtice(j)
598             GDATA(1,j,1)=mmsnowm(j)
599             ODATA(1,j,3)=mmicem(j)
600             GDATA(1,j,7)=0.5*(mmtice2(j)+mmtice1(j))
601    #  ifdef CPL_OCEANCO2
602             fluxco2(j)=fluxco2(j) + dtatm*3600.*mmco2flux(j)
603    #  endif
604           enddo
605    #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.  
 C      print *,' atmosphere TAU=',tau  
609  c     HPRNT=TAU.ge.17520.00  c     HPRNT=TAU.ge.17520.00
610        NSTEP1=NSTEP                                                        46.5          NSTEP1=NSTEP                                                        46.5  
611  C**** WRITE RESTART INFORMATION ONTO DISK                                 47.    C**** WRITE RESTART INFORMATION ONTO DISK                                 47.  
# Line 614  C**** WRITE RESTART INFORMATION ONTO DIS Line 628  C**** WRITE RESTART INFORMATION ONTO DIS
628        if(TRANSR)then        if(TRANSR)then
629        WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,BLDATA,  50.        WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,BLDATA,  50.
630       *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2    51.       *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2    51.
631       *  ,MRCHT,TRSURF,SRSURF,TSURFT,TSURFW,DWAV0       *  ,MRCHT,TRSURF,SRSURF,TLANDW,TSURFW,DWAV0
632       *  ,TG3M,RTGO,STG3,DTG3       *  ,TG3M,RTGO,STG3,DTG3
633        print *,' STG3'        print *,' STG3'
634        print 5001,(STG3(1,j),j=1,JM0)        print 5001,(STG3(1,j),j=1,JM0)
# Line 627  C**** WRITE RESTART INFORMATION ONTO DIS Line 641  C**** WRITE RESTART INFORMATION ONTO DIS
641        else        else
642        WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,BLDATA,  50.          WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,BLDATA,  50.  
643       *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2    51.         *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2    51.  
644       *  ,MRCHT,TRSURF,SRSURF,TSURFT,TSURFW,DWAV0       *  ,MRCHT,TRSURF,SRSURF,TLANDW,TSURFW,DWAV0
645        endif        endif
646        REWIND KDISK0                                                       52.          REWIND KDISK0                                                       52.  
647        end if    ! ISTART.eq.2        end if    ! ISTART.eq.2
# Line 637  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 902  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 1030  C**** RADIATION, SOLAR AND THERMAL Line 1042  C**** RADIATION, SOLAR AND THERMAL
1042           CALL RADIA                             CALL RADIA                  
1043        endif        endif
1044  #endif  #endif
   
1045        if(HPRNT)then        if(HPRNT)then
1046        print *,' main after radia',' TAU=',TAU        print *,' main after radia',' TAU=',TAU
1047  #include "PRNT.COM"  #include "PRNT.COM"
# Line 1061  C**** SURFACE INTERACTION AND GROUND CAL Line 1072  C**** SURFACE INTERACTION AND GROUND CAL
1072        print *,' main after surf4clm',' TAU=',TAU        print *,' main after surf4clm',' TAU=',TAU
1073  #include "PRNT.COM"  #include "PRNT.COM"
1074        endif        endif
1075          i=1
1076        do j=1,jm        do j=1,jm
1077           pcpl4clm(j)=pcpl4clm(j)*prlnd2total(j,mndriver)           pcpl4clm(i,j)=pcpl4clm(i,j)*prlnd2total(j,mndriver)
1078           pcpc4clm(j)=pcpc4clm(j)*prlnd2total(j,mndriver)       &     *3600./(NDYN*DT)
1079             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 1100  c       print *,'before clm4mit2d ncallc Line 1114  c       print *,'before clm4mit2d ncallc
1114        endif        endif
1115    
1116  c     if(JYEAR.gt.20)then  c     if(JYEAR.gt.20)then
1117  c      write (934),tau,tsoiclm,snwdclm,snwcclm,  !      write (934),tau,tsoiclm,snwdclm,snwcclm,
1118  c    & lwuclm,tref2mclm,tflxclm,tgndclm,  !    & lwuclm,tref2mclm,tflxclm,tgndclm,
1119  c    & lhfclm,shfclm,tauxclm,tauyclm,  !    & lhfclm,shfclm,tauxclm,tauyclm,
1120  c    & asdirclm,aldirclm,asdifclm,aldifclm,  !    & asdirclm,aldirclm,asdifclm,aldifclm,
1121  c    & sroclm,ssrclm,glrclm  !    & sroclm,ssrclm,glrclm
1122  c    &,h2olclm,h2oiclm  !    &,h2olclm,h2oiclm
1123  c     endif  c     endif
1124  !     print *,' main after clm4mit2d',' TAU=',TAU  !     print *,' main after clm4mit2d',' TAU=',TAU
1125  !       print  ('2(12f7.2,/,11f7.2,/)'),tsoiclm,snwdclm,snwcclm,  !       print  ('2(12f7.2,/,11f7.2,/)'),tsoiclm,snwdclm,snwcclm,
# Line 1231  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 1239  C**** Line 1254  C****
1254  C                                                                        196.    C                                                                        196.  
1255        do J=1,JM0        do J=1,JM0
1256          TSURFW(J)=TSURFD(J)          TSURFW(J)=TSURFD(J)
1257            TLANDW(J)=TLANDD(J)
1258        enddo        enddo
1259    
1260        JDATECLM=JDATE        JDATECLM=JDATE
# Line 1363  c Line 1379  c
1379          pC_atm(j)=zco2(1,j,1)          pC_atm(j)=zco2(1,j,1)
1380       &           *28.97296245/44.0*1.e-9               &           *28.97296245/44.0*1.e-9        
1381                          !ppb(m) to kg per volume base                          !ppb(m) to kg per volume base
1382    
1383              atm_co2(j)=pC_atm(j)*1.e6
1384    
1385        enddo    !       j        enddo    !       j
1386  c  c
1387  c -------  c -------
# Line 1401  c     print *,'tem=',tggary(27) Line 1420  c     print *,'tem=',tggary(27)
1420  c     print '12f7.1,/,2(11f7.1,/,),12f7.1',(pC_atm(j)*1.e6,j=1,jm)  c     print '12f7.1,/,2(11f7.1,/,),12f7.1',(pC_atm(j)*1.e6,j=1,jm)
1421  c     print '12f7.1,/,2(11f7.1,/,),12f7.1',(rco2(j,1),j=1,jm)  c     print '12f7.1,/,2(11f7.1,/,),12f7.1',(rco2(j,1),j=1,jm)
1422  c     ncallgary=ncallgary+1  c     ncallgary=ncallgary+1
1423        call carb_mxdlyr_chem(focean)  !     10/28/06
1424        call carb_airsea_flx  !     call carb_mxdlyr_chem(focean)
1425    !     call carb_airsea_flx
1426    !
1427    !     3D ocean chemistry
1428          call carb_chem_ocmip(focean)
1429          call carb_airsea_flx(dtco2)
1430    !     3D ocean chemistry
1431    !     10/28/06
1432  c     print *,'FCO2 ncallgary=',ncallgary  c     print *,'FCO2 ncallgary=',ncallgary
1433  c     print '12f7.1,/,2(11f7.1,/,),12f7.1',  c     print '12f7.1,/,2(11f7.1,/,),12f7.1',
1434  c    &       (fluxco2(j)*12.e-15*365.,j=1,jm)  c    &       (fluxco2(j)*12.e-15*365.,j=1,jm)
1435  #endif  #endif
1436    
 # if ( defined OCEAN_3D)  
        SECDAY=24.*3600.  
 c      print *,'CO2F form ocean'  
 c      print *,mmco2flux  
 Cjrs       fluxco2(1)=SECDAY*mmco2flux(1)  
        fluxco2(1)=SECDAY*mmco2flux(2)    
        do j=2,jm-1  
         fluxco2(j)=SECDAY*mmco2flux(j-1)  
        enddo  
        fluxco2(JM)=SECDAY*mmco2flux(JM-1)  
 Cjrs       fluxco2(JM)=SECDAY*mmco2flux(JMOCEAN)  
 # endif  
   
1437  C    For ocean carbon model  C    For ocean carbon model
1438  c  Annual oceanic CO2 uptake  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  c     print *,' OCUPT=',OCUPT*12.e-15  !      print *,' OCUPT=',OCUPT*12.e-15
1443    
1444  #if ( defined CPL_CHEM )  #if ( defined CPL_CHEM )
1445  !  !
# Line 1440  c     print *,' OCUPT=',OCUPT*12.e-15 Line 1453  c     print *,' OCUPT=',OCUPT*12.e-15
1453  !  !
1454  #endif  #endif
1455    
1456           do j=1,jm
1457            fluxco2(j)=0.0
1458           enddo
1459  #endif  #endif
1460    
1461  #if ( defined CPL_TEM )  #if ( defined CPL_TEM )
# Line 1484  c Line 1500  c
1500  #if ( defined CPL_OCEANCO2 && defined ML_2D )  #if ( defined CPL_OCEANCO2 && defined ML_2D )
1501  C    For OCM  C    For OCM
1502    
1503          dtco2=3600.*24.  !       dtco2=3600.*24.
1504          call diffusco2(lmo,jm,dtco2,0.5,edzon,depthml,focean,  !       cfkvct=1.0
1505    !       if (JYEAR.ge.1991) then begin
1506    !        if (JYEAR.le.2100) then begin
1507    !         cfkvct=(1.0*(2100-JYEAR)+0.25*(JYEAR-1990))/110.
1508    !        esle
1509    !         cfkvct=0.25
1510    !        endif
1511    !       endif
1512    !       do j=1,jm
1513    !        edzcatr(j)=cfkvct*edzcar(j)
1514    !       enddo
1515            call diffusco2(lmo,jm,dtco2,0.5,edzcart,depthml,focean,
1516       &                dzg,dzog,rco2)       &                dzg,dzog,rco2)
1517          call hdocean(rco2,focean,dxv,dyv,DXYP,depthml,edohd,dtco2)          call hdocean(rco2,focean,dxv,dyv,DXYP,depthml,edohd,dtco2)
1518          call avegary          call avegary
# Line 1552  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 1564  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 1724  c     print *,(RTGOAV(J,1),j=1,jm) Line 1749  c     print *,(RTGOAV(J,1),j=1,jm)
1749  c      do 5287 j=1,JM+3  c      do 5287 j=1,JM+3
1750  c       GBUDG(j,38,1)=GBUDG(j,37,1)*1013./GBUDG(jm+3,37,1)  c       GBUDG(j,38,1)=GBUDG(j,37,1)*1013./GBUDG(jm+3,37,1)
1751  c5287 continue  c5287 continue
1752         print *,'FRMDICE'  !      print *,'FRMDICE'
1753         print '6(1PE12.4)',FRMDICE  !      print '6(1PE12.4)',FRMDICE
1754         ENKE=0.0         ENKE=0.0
1755         ENPT=0.0         ENPT=0.0
1756        do ii=1,4        do ii=1,4
# Line 1776  C     Data for possible restart for OCM Line 1801  C     Data for possible restart for OCM
1801          WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,          WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,
1802       *   BLDATA,       *   BLDATA,
1803       *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2       *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2
1804       *  ,MRCHT,TRSURF,SRSURF,TSURFT,TSURFW,DWAV0       *  ,MRCHT,TRSURF,SRSURF,TLANDW,TSURFW,DWAV0
1805       *  ,TG3M,RTGO,STG3,DTG3       *  ,TG3M,RTGO,STG3,DTG3
1806         else         else
1807          WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,          WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,
1808       *   BLDATA,       *   BLDATA,
1809       *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2       *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2
1810       *  ,MRCHT,TRSURF,SRSURF,TSURFT,TSURFW,DWAV0       *  ,MRCHT,TRSURF,SRSURF,TLANDW,TSURFW,DWAV0
1811  c       print *,' TSURFT'  c       print *,' TSURFT'
1812  c       print 5001,TSURFT  c       print 5001,TSURFT
1813  c       print *,' TSURFW'  c       print *,' TSURFW'
# Line 1803  C**** WRITE A COPY OF THE FINAL RESTART Line 1828  C**** WRITE A COPY OF THE FINAL RESTART
1828           IF(TAU.GT.TAUX+3240.) GO TO 683                                 287.             IF(TAU.GT.TAUX+3240.) GO TO 683                                 287.  
1829    685    WRITE (KCOPY) TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,BLDATA,   287.5      685    WRITE (KCOPY) TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,BLDATA,   287.5  
1830       *   RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN              288.         *   RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN              288.  
1831       *   ,WMGE,TPRIM2,MRCHT,TRSURF,SRSURF,TSURFT,TSURFW,DWAV0       *   ,WMGE,TPRIM2,MRCHT,TRSURF,SRSURF,TLANDW,TSURFW,DWAV0
1832       *   ,TG3M,RTGO,STG3,DTG3       *   ,TG3M,RTGO,STG3,DTG3
1833           REWIND KCOPY                                                    288.5             REWIND KCOPY                                                    288.5  
1834  C  690 changed to 691 02/21/2003  C  690 changed to 691 02/21/2003
# Line 1830  C**** RUN TERMINATED BECAUSE SENSE SWITC Line 1855  C**** RUN TERMINATED BECAUSE SENSE SWITC
1855        REWIND KDISK0                                                      303.          REWIND KDISK0                                                      303.  
1856        WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,BLDATA, 304.          WRITE(KDISK0) AEXP,TAU,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA,GDATA,BLDATA, 304.  
1857       *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2   305.         *  RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAU,TSSFC,CKS,CKN,WMGE,TPRIM2   305.  
1858       *  ,MRCHT,TRSURF,SRSURF,TSURFT,TSURFW,DWAV0       *  ,MRCHT,TRSURF,SRSURF,TLANDW,TSURFW,DWAV0
1859        end if        end if
1860  C     WRITE (6,908)                                                      306.    C     WRITE (6,908)                                                      306.  
1861  C**** RUN TERMINATED BECAUSE IT REACHED TAUE (OR SS6 WAS TURNED ON)      307.    C**** RUN TERMINATED BECAUSE IT REACHED TAUE (OR SS6 WAS TURNED ON)      307.  
# Line 1841  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             co24ocean(j)=pC_atm(j)*1.e6  !jrs           ncallatm=ncallatm+1
1872    ! 020107
1873    !          co24ocean(j)=pC_atm(j)*1.e6
1874    ! jrs give CO2 even if ocn carbon off
1875               co24ocean(j)=atm_co2(j)
1876    #  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
1882             rseaice(j)=ODATA(1,J,2)             rseaice(j)=ODATA(1,J,2)
1883  #endif  #endif
1884             tauu(j)=tauu(j)/(NSURF*DTATM)             tauu(j)=tauu(j)/(NSURF*DTATM)
# Line 1858  C     precip and evap in mm/day or kg/m* Line 1890  C     precip and evap in mm/day or kg/m*
1890             precip(j)=precip(j)*(1.-fland*prlnd2total(j,mndriver))             precip(j)=precip(j)*(1.-fland*prlnd2total(j,mndriver))
1891       &      /(1.-fland)       &      /(1.-fland)
1892             endif             endif
1893  Cjrs           surfpr(j)=surfpr(j)/(DTATM/24.)  Cjrs            surfpr(j)=surfpr(j)/(DTATM/24.)
1894  c  c
1895             if(naveo(j).gt.0)then             if(naveo(j).gt.0)then
1896               hfluxo(j)=NSURF*hfluxo(j)/(NDYN*DT*naveo(j))               hfluxo(j)=NSURF*hfluxo(j)/(NDYN*DT*naveo(j))
# Line 1896  C Line 1928  C
1928             endif             endif
1929  c          Runoff is a flux of water from land in mm/day  c          Runoff is a flux of water from land in mm/day
1930  c          not for m**2  c          not for m**2
1931    cjrs change runoff to new name arunoff
1932             arunoff(j)=arunoff(j)/(DTATM/24.)*FDATA(1,j,2)             arunoff(j)=arunoff(j)/(DTATM/24.)*FDATA(1,j,2)
1933       &          *DXYP(J)       &          *DXYP(J)
1934             if(NWMGEA(J).gt.0)then             if(NWMGEA(J).gt.0)then
# Line 1925  c Line 1958  c
1958             CLAT=20.*TWOPI/360.             CLAT=20.*TWOPI/360.
1959             do j=1,jm             do j=1,jm
1960               SLAND=SLAND+FDATA(1,j,2)*DXYP(J)               SLAND=SLAND+FDATA(1,j,2)*DXYP(J)
1961    c jrs runoff->arunoff
1962               rungl=rungl+arunoff(j)               rungl=rungl+arunoff(j)
1963               if(LAT(J).lt.-CLAT)then               if(LAT(J).lt.-CLAT)then
1964                 runs=runs+arunoff(j)                 runs=runs+arunoff(j)
# Line 1938  c          print *,'RUNOFF TOFDAY=',TOFD Line 1972  c          print *,'RUNOFF TOFDAY=',TOFD
1972  c          print *,rungl/SLAND,rungl,runs,runt,runn  c          print *,rungl/SLAND,rungl,runs,runt,runn
1973  c       nmonth=JMNTH0  c       nmonth=JMNTH0
1974  #ifdef ML_2D  #ifdef ML_2D
1975    c jrs only ML_2D
1976          nmonth=AMONTH(mndriver)          nmonth=AMONTH(mndriver)
1977  #endif  #endif
1978          jdatefl=jdate-1          jdatefl=jdate-1
# Line 1986  c       write(893),nmonth,jdatefl,tempr, Line 2021  c       write(893),nmonth,jdatefl,tempr,
2021  c    &  evai,hfluxo,dhfodtg,devodtg,hfluxi,dhfidtg,devidtg,  c    &  evai,hfluxo,dhfodtg,devodtg,hfluxi,dhfidtg,devidtg,
2022  c    &  solarinc_ice,solarnet_ice,rseaice  c    &  solarinc_ice,solarnet_ice,rseaice
2023  #ifdef ML_2D  #ifdef ML_2D
2024    c jrs only ML_2D
2025           do j=1,jm           do j=1,jm
2026             osst(j)=ODATA(1,j,1)             osst(j)=ODATA(1,j,1)
2027             aoice(j)=ODATA(1,j,3)             aoice(j)=ODATA(1,j,3)
# Line 2008  c Line 2044  c
2044        JYEARATM=JYEAR        JYEARATM=JYEAR
2045  C  C
2046  #ifdef ML_2D  #ifdef ML_2D
2047    Cjrs change this block to only ML_2D
2048           IDAYM=IDAY           IDAYM=IDAY
2049           JDAYM=JDAY           JDAYM=JDAY
2050           JDATEM=JDATE           JDATEM=JDATE
# Line 2023  c      print *,'co24ocean=',co24ocean(jm Line 2060  c      print *,'co24ocean=',co24ocean(jm
2060  c      WRITE (6,905) TOFDAY,JDATE,JMONTH,JYEAR  c      WRITE (6,905) TOFDAY,JDATE,JMONTH,JYEAR
2061         WRITE (6,905) TOFDAYPR,JDATEPR,JMONTHPR,JYEARPR         WRITE (6,905) TOFDAYPR,JDATEPR,JMONTHPR,JYEARPR
2062          endif          endif
2063  c        print *,'ncallclm=',ncallclm  cjrs        print *,'ncallclm=',ncallclm
2064         JDAYLAST=JDAY         JDAYLAST=JDAY
2065  c      if(ncallclm.gt.6) stop  c      if(ncallclm.gt.6) stop
2066  c      stop  c      stop
# Line 2031  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.3  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22