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 |
|
|
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 |
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) |
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 |
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 |
|
|
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 |
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 |
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 |
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' |
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. |
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. |
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. |
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: |
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, |
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. |
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 |
! |
! |
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 |
|
|
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, |
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 |
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. |