| 1 |
jscott |
1.1 |
|
| 2 |
|
|
#include "ctrparam.h" |
| 3 |
|
|
|
| 4 |
|
|
SUBROUTINE FORSET(TREF,KTREND,KWRITE) 9101. |
| 5 |
|
|
C 9101.1 |
| 6 |
|
|
C RADCOM: CONTROL/INPUT PARAMETERS 9101.2 |
| 7 |
|
|
C 9101.3 |
| 8 |
|
|
COMMON/RADCOM/VADATA(11, 4, 3),DLAT(46),DLON(72),TAUMIN,FULGAS(18)9101.4 |
| 9 |
|
|
A ,FRACSL,RATQSL,FOGTSL,PTLISO,TLGRAD,TKCICE,FGOLDH(18)9101.5 |
| 10 |
|
|
B ,FLONO3,FRAYLE,FCLDTR,FCLDSR,FALGAE,FMARCL,FEMTRA(6) 9101.6 |
| 11 |
|
|
C ,WETTRA,WETSRA,DMOICE,DMLICE,LICETK,NTRACE,FZASRA(6) 9101.7 |
| 12 |
|
|
D ,ID5(5),ITR(4),IMG(2),ILG(2),LAPGAS,KWVCON,NORMS0,NV 9101.8 |
| 13 |
|
|
E ,KEEPRH,KEEPAL,ISOSCT,IHGSCT,KGASSR,KAERSR,KFRACC 9101.9 |
| 14 |
|
|
F ,MARCLD,LAYRAD,NL,NLP,JMLAT ,IMLON ,KFORCE,LASTVC 9102. |
| 15 |
|
|
C 9102.1 |
| 16 |
|
|
C BASIC RADCOM INPUT DATA 9102.2 |
| 17 |
|
|
C 9102.3 |
| 18 |
|
|
G ,PLB(40),HLB(40),TLB(40),TLT(40),TLM(40),U0GAS(40,9) 9102.4 |
| 19 |
|
|
H ,ULGAS(40,9),TRACER(40,4),CLDTAU(40),SHL(40),RHL(40) 9102.5 |
| 20 |
|
|
I ,POCEAN,PEARTH,POICE,PLICE,AGESN,SNOWE,SNOWOI,SNOWLI 9102.6 |
| 21 |
|
|
J ,TGO,TGE,TGOI,TGLI,TSL,WMAG,WEARTH,ZOICE,FSPARE(200) 9102.7 |
| 22 |
|
|
K ,S0,COSZ,PVT(11),BXA(153),SRBXAL(15,2),FRC(5),LUXGAS 9102.8 |
| 23 |
|
|
L ,JYEAR,JDAY,JLAT,ILON,MEANAL,KALVIS,ISPARE(25),PSIG0 9102.9 |
| 24 |
|
|
C 9103. |
| 25 |
|
|
C BASIC RADCOM OUTPUT DATA 9103.1 |
| 26 |
|
|
C 9103.2 |
| 27 |
|
|
M ,TRDFLB(40),TRUFLB(40),TRNFLB(40),TRFCRL(40),TRSLCR 9103.3 |
| 28 |
|
|
N ,SRDFLB(40),SRUFLB(40),SRNFLB(40),SRFHRL(40),SRSLHR 9103.4 |
| 29 |
|
|
O ,SRIVIS,SROVIS,PLAVIS,SRINIR,SRONIR,PLANIR,SRXATM(4) 9103.5 |
| 30 |
|
|
P ,SRDVIS,SRUVIS,ALBVIS,SRDNIR,SRUNIR,ALBNIR,FSRNFG(4) 9103.6 |
| 31 |
|
|
Q ,SRTVIS,SRRVIS,SRAVIS,SRTNIR,SRRNIR,SRANIR,FTRUFG(4) 9103.7 |
| 32 |
|
|
R ,TRDFGW,TRUFGW,TRUFTW,BTEMPW,TRDFSL,TRUFSL,DTRUFG(4) 9103.8 |
| 33 |
|
|
S ,TRSLTS,TRSLTG,TRSLWV,TRSLBS,TTRUFG,LBOTCL,LTOPCL 9103.9 |
| 34 |
|
|
C 9104. |
| 35 |
|
|
C BLOCKD INITIALIZED DEFAULT DATA 9104.1 |
| 36 |
|
|
C 9104.2 |
| 37 |
|
|
COMMON/BLOCKD/AGOLDH(11, 5),BGOLDH(11, 5),CGOLDH(11, 5) 9104.3 |
| 38 |
|
|
T ,TRAQEX(25,11),TRAQSC(25,11),TRACOS(25,11) 9104.4 |
| 39 |
|
|
T ,TRCQEX(25, 2),TRCQSC(25, 2),TRCCOS(25, 2) 9104.5 |
| 40 |
|
|
S ,SRAQEX( 6,11),SRAQSC( 6,11),SRACOS( 6,11) 9104.6 |
| 41 |
|
|
S ,SRCQEX( 6, 2),SRCQSC( 6, 2),SRCCOS( 6, 2) 9104.7 |
| 42 |
|
|
X ,AOCEAN(25 ),AGSIDV(25, 4),CLDALB(25, 2) 9104.8 |
| 43 |
|
|
Y ,CMANO2(42 ),TRACEG(25,16),PPMV58(9),Z0(9),ZH(9) 9104.9 |
| 44 |
|
|
Z ,ASNALB(15),AOIALB(15),ALIALB(15),NAERO,NGOLDH,NKSR 9105. |
| 45 |
|
|
C 9105.1 |
| 46 |
|
|
DIMENSION XNOW(5),XREF(5),XDT0(5),XDAT(5),XRAT(5),KFOR(5) 9105.2 |
| 47 |
|
|
C 9105.3 |
| 48 |
|
|
parameter(nlat=N_LAT) |
| 49 |
|
|
common /ATCO2/atm_co2(nlat) |
| 50 |
|
|
LOGICAL wr25,TRANSR,CONTRR,OBSFOR |
| 51 |
|
|
common/wrcom/wr25,TRANSR,CONTRR,OBSFOR |
| 52 |
|
|
NGAS=5 9105.4 |
| 53 |
|
|
print *,'From FORSET TREF=',TREF,' KTREND=',KTREND |
| 54 |
|
|
IF(KTREND.EQ.1) CALL ATREND(XREF,TREF,NGAS) 9105.5 |
| 55 |
|
|
IF(KTREND.EQ.2) CALL BTREND(XREF,TREF,NGAS) 9105.6 |
| 56 |
|
|
IF(KTREND.EQ.3) CALL CTREND(XREF,TREF,NGAS) 9105.7 |
| 57 |
|
|
IF(KTREND.EQ.5) CALL GTREND(XREF,TREF,NGAS) |
| 58 |
|
|
IF(KTREND.EQ.4) CALL BMTRND(XREF,TREF,NGAS) |
| 59 |
|
|
IF(KTREND.EQ.6) CALL BMTRNDMG(XREF,TREF,NGAS) |
| 60 |
|
|
c IF(KTREND.GE.21.and.KTREND.LE.29) |
| 61 |
|
|
c & CALL STBTRND(XREF,TREF,NGAS,KTREND) |
| 62 |
|
|
DO 100 I=1,NGAS 9105.8 |
| 63 |
|
|
IF(XREF(I).LT.1.E-06) XREF(I)=1.E-06 9105.9 |
| 64 |
|
|
100 KFOR(I)=1 9106. |
| 65 |
|
|
print *,'From FORSET KTREND=',KTREND |
| 66 |
|
|
print *,'XREF' |
| 67 |
|
|
print *,XREF |
| 68 |
|
|
! CFC11 and CFC12 are in ppb to be used in fits |
| 69 |
|
|
! DTDX1D DTDX3D DXDT3D |
| 70 |
|
|
PPMV58(2)=XREF(1) 9106.1 |
| 71 |
|
|
PPMV58(6)=XREF(2) 9106.2 |
| 72 |
|
|
PPMV58(7)=XREF(3) 9106.3 |
| 73 |
|
|
PPMV58(8)=XREF(4)/1000.0 9106.4 |
| 74 |
|
|
PPMV58(9)=XREF(5)/1000.0 9106.5 |
| 75 |
|
|
! CFC11 and CFC12 are in ppm |
| 76 |
|
|
C 9106.6 |
| 77 |
|
|
IF(KWRITE.NE.1) GO TO 120 9106.7 |
| 78 |
|
|
DO 110 I=1,NGAS 9106.8 |
| 79 |
|
|
110 XDAT(I)=XREF(I) 9106.9 |
| 80 |
|
|
IF(KTREND.EQ.1) WRITE(6,6001) 9107. |
| 81 |
|
|
IF(KTREND.EQ.2) WRITE(6,6002) 9107.1 |
| 82 |
|
|
IF(KTREND.EQ.3) WRITE(6,6003) 9107.2 |
| 83 |
|
|
IF(KTREND.EQ.4) WRITE(6,6004) |
| 84 |
|
|
IF(KTREND.EQ.5) then |
| 85 |
|
|
print *,'PPMV58 after GTREND' |
| 86 |
|
|
print *,PPMV58 |
| 87 |
|
|
endif |
| 88 |
|
|
IF(KTREND.EQ.6) then |
| 89 |
|
|
print *,'PPMV58 after BMTRNDMG' |
| 90 |
|
|
print *,PPMV58 |
| 91 |
|
|
endif |
| 92 |
|
|
WRITE(6,6100) 9107.3 |
| 93 |
|
|
120 CONTINUE 9107.4 |
| 94 |
|
|
6001 FORMAT(1H1,5X,'(OUTPUT DATA) GCM RAD EXPECTED TEMPERATURES' 9107.5 |
| 95 |
|
|
+ ,T55,'PRESENT TREND FORSET INPUT DATA TO GCM' 9107.6 |
| 96 |
|
|
+ ,T96,'RATE OF CHANGE/YR OF TRACE GAS AMOUNTS') 9107.7 |
| 97 |
|
|
6002 FORMAT(1H1,5X,'(OUTPUT DATA) GCM RAD EXPECTED TEMPERATURES' 9107.8 |
| 98 |
|
|
+ ,T55,'REDUCED TREND FORSET INPUT DATA TO GCM' 9107.9 |
| 99 |
|
|
+ ,T96,'RATE OF CHANGE/YR OF TRACE GAS AMOUNTS') 9108. |
| 100 |
|
|
6003 FORMAT(1H1,5X,'(OUTPUT DATA) GCM RAD EXPECTED TEMPERATURES' 9108.1 |
| 101 |
|
|
+ ,T55,'CURTAIL TREND FORSET INPUT DATA TO GCM' 9108.2 |
| 102 |
|
|
+ ,T96,'RATE OF CHANGE/YR OF TRACE GAS AMOUNTS') 9108.3 |
| 103 |
|
|
6004 FORMAT(1H1,5X,' TREND FROM BOX MODEL') |
| 104 |
|
|
6100 FORMAT(6X,6('-'),'(* 3-D)',32('-'),3X,38('-'),3X,38('-') 9108.4 |
| 105 |
|
|
+ /1X,'YEAR DTSUM *DTCO2 DTN2O DTCH4 DTF11 DTF12' 9108.5 |
| 106 |
|
|
+ , ' PPMCO2 PPMN20 PPMCH4 PPTF11 PPTF12' 9108.6 |
| 107 |
|
|
+ , ' RATCO2 RATN2O RATCH4 RATF11 RATF12') 9108.7 |
| 108 |
|
|
C 9108.8 |
| 109 |
|
|
RETURN 9108.9 |
| 110 |
|
|
C 9109. |
| 111 |
|
|
C------------------------------ 9109.1 |
| 112 |
|
|
ENTRY FORGET(TNOW,KTREN,KWRITE) |
| 113 |
|
|
C------------------------------ 9109.3 |
| 114 |
|
|
C 9109.4 |
| 115 |
|
|
IF(KTREN.EQ.1) CALL ATREND(XNOW,TNOW,NGAS) 9109.5 |
| 116 |
|
|
IF(KTREN.EQ.2) CALL BTREND(XNOW,TNOW,NGAS) 9109.6 |
| 117 |
|
|
IF(KTREN.EQ.3) CALL CTREND(XNOW,TNOW,NGAS) 9109.7 |
| 118 |
|
|
IF(KTREN.EQ.5) CALL GTREND(XNOW,TNOW,NGAS) |
| 119 |
|
|
IF(KTREN.EQ.4) CALL BMTRND(XNOW,TNOW,NGAS) |
| 120 |
|
|
IF(KTREN.EQ.6) CALL BMTRNDMG(XNOW,TNOW,NGAS) |
| 121 |
|
|
c IF(KTREN.GE.21.and.KTREN.LE.29) |
| 122 |
|
|
c & CALL STBTRND(XNOW,TNOW,NGAS,KTREN) |
| 123 |
|
|
c if(KTREN.LE.5)then |
| 124 |
|
|
CALL DTDX1D(XNOW,XREF,XDT0,SDT0,KFOR,NGAS) 9109.8 |
| 125 |
|
|
CALL DTDX3D(XNOW,XREF,XDT0,SDT0,KFOR,1) 9109.9 |
| 126 |
|
|
CALL DXDT3D(XNOW,XREF,XDT0,SDT0,KFOR,NGAS) 9110. |
| 127 |
|
|
c endif |
| 128 |
|
|
FULGAS(2)=XNOW(1)/XREF(1) 9110.1 |
| 129 |
|
|
FULGAS(6)=XNOW(2)/XREF(2) 9110.2 |
| 130 |
|
|
FULGAS(7)=XNOW(3)/XREF(3) 9110.3 |
| 131 |
|
|
FULGAS(8)=XNOW(4)/XREF(4) 9110.4 |
| 132 |
|
|
FULGAS(9)=XNOW(5)/XREF(5) 9110.5 |
| 133 |
|
|
! IF(KTREND.EQ.6) then |
| 134 |
|
|
! print *,'From forget' |
| 135 |
|
|
! print *,'XNOW' |
| 136 |
|
|
! print *,XNOW |
| 137 |
|
|
! print *,'XREF' |
| 138 |
|
|
! print *,XREF |
| 139 |
|
|
! print *,'FULGAS(8)=',FULGAS(8),FULGAS(8)*PPMV58(8) |
| 140 |
|
|
! endif |
| 141 |
|
|
c print *,'From forset XNOW(1)=',XNOW(1) |
| 142 |
|
|
c print *,'From forset FULGAS(2)=',FULGAS(2),FULGAS(2)*PPMV58(2) |
| 143 |
|
|
if(.not.OBSFOR)then |
| 144 |
|
|
IF(KWRITE.EQ.1) then |
| 145 |
|
|
print *,'From forset XNOW(1)=',XNOW(1) |
| 146 |
|
|
ENDIF |
| 147 |
|
|
do j=1,nlat |
| 148 |
|
|
atm_co2(j)=XNOW(1) |
| 149 |
|
|
enddo |
| 150 |
|
|
endif |
| 151 |
|
|
C 9110.6 |
| 152 |
|
|
IF(KWRITE.NE.1) GO TO 220 9110.7 |
| 153 |
|
|
SDT0=0.0 9110.8 |
| 154 |
|
|
DO 210 I=1,NGAS 9110.9 |
| 155 |
|
|
SDT0=SDT0+XDT0(I) 9111. |
| 156 |
|
|
XRAT(I)=(XNOW(I)-XDAT(I))/(1.E-10+XDAT(I)) 9111.1 |
| 157 |
|
|
210 XDAT(I)=XNOW(I) 9111.2 |
| 158 |
|
|
IYEAR=TNOW 9111.3 |
| 159 |
|
|
WRITE(6,6200) IYEAR,SDT0,(XDT0(I),I=1,5),(XNOW(I),I=1,5) 9111.4 |
| 160 |
|
|
+ ,(XRAT(I),I=1,5) 9111.5 |
| 161 |
|
|
6200 FORMAT(1X,I4,F6.3,5F8.4,1X,F8.2,4F8.4,1X,5F8.4) 9111.6 |
| 162 |
|
|
NSPACE=IYEAR-(IYEAR/10)*10 9111.7 |
| 163 |
|
|
IF(NSPACE.EQ.0) WRITE(6,6010) 9111.8 |
| 164 |
|
|
6010 FORMAT(1H ) 9111.9 |
| 165 |
|
|
220 CONTINUE 9112. |
| 166 |
|
|
C 9112.1 |
| 167 |
|
|
RETURN 9112.2 |
| 168 |
|
|
END 9112.3 |
Parent Directory
| 
Revision Log
| 
Revision Graph