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

Contents of /MITgcm_contrib/jscott/igsm/src/forset4ipcc.F

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


Revision 1.1 - (show annotations) (download)
Fri Aug 11 19:35:30 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
atm2d package

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 IF(KTREND.GE.21.and.KTREND.LE.29)
61 & 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 PPMV58(2)=XREF(1) 9106.1
66 PPMV58(6)=XREF(2) 9106.2
67 PPMV58(7)=XREF(3) 9106.3
68 PPMV58(8)=XREF(4)/1000.0 9106.4
69 PPMV58(9)=XREF(5)/1000.0 9106.5
70 C 9106.6
71 IF(KWRITE.NE.1) GO TO 120 9106.7
72 DO 110 I=1,NGAS 9106.8
73 110 XDAT(I)=XREF(I) 9106.9
74 IF(KTREND.EQ.1) WRITE(6,6001) 9107.
75 IF(KTREND.EQ.2) WRITE(6,6002) 9107.1
76 IF(KTREND.EQ.3) WRITE(6,6003) 9107.2
77 IF(KTREND.EQ.4) WRITE(6,6004)
78 IF(KTREND.EQ.5) then
79 print *,'after GTREND'
80 print *,PPMV58
81 endif
82 IF(KTREND.EQ.6) then
83 print *,'after BMTRNDMG'
84 print *,PPMV58
85 endif
86 WRITE(6,6100) 9107.3
87 120 CONTINUE 9107.4
88 6001 FORMAT(1H1,5X,'(OUTPUT DATA) GCM RAD EXPECTED TEMPERATURES' 9107.5
89 + ,T55,'PRESENT TREND FORSET INPUT DATA TO GCM' 9107.6
90 + ,T96,'RATE OF CHANGE/YR OF TRACE GAS AMOUNTS') 9107.7
91 6002 FORMAT(1H1,5X,'(OUTPUT DATA) GCM RAD EXPECTED TEMPERATURES' 9107.8
92 + ,T55,'REDUCED TREND FORSET INPUT DATA TO GCM' 9107.9
93 + ,T96,'RATE OF CHANGE/YR OF TRACE GAS AMOUNTS') 9108.
94 6003 FORMAT(1H1,5X,'(OUTPUT DATA) GCM RAD EXPECTED TEMPERATURES' 9108.1
95 + ,T55,'CURTAIL TREND FORSET INPUT DATA TO GCM' 9108.2
96 + ,T96,'RATE OF CHANGE/YR OF TRACE GAS AMOUNTS') 9108.3
97 6004 FORMAT(1H1,5X,' TREND FROM BOX MODEL')
98 6100 FORMAT(6X,6('-'),'(* 3-D)',32('-'),3X,38('-'),3X,38('-') 9108.4
99 + /1X,'YEAR DTSUM *DTCO2 DTN2O DTCH4 DTF11 DTF12' 9108.5
100 + , ' PPMCO2 PPMN20 PPMCH4 PPTF11 PPTF12' 9108.6
101 + , ' RATCO2 RATN2O RATCH4 RATF11 RATF12') 9108.7
102 C 9108.8
103 RETURN 9108.9
104 C 9109.
105 C------------------------------ 9109.1
106 ENTRY FORGET(TNOW,KTREN,KWRITE)
107 C------------------------------ 9109.3
108 C 9109.4
109 IF(KTREN.EQ.1) CALL ATREND(XNOW,TNOW,NGAS) 9109.5
110 IF(KTREN.EQ.2) CALL BTREND(XNOW,TNOW,NGAS) 9109.6
111 IF(KTREN.EQ.3) CALL CTREND(XNOW,TNOW,NGAS) 9109.7
112 IF(KTREN.EQ.5) CALL GTREND(XNOW,TNOW,NGAS)
113 IF(KTREN.EQ.4) CALL BMTRND(XNOW,TNOW,NGAS)
114 IF(KTREN.EQ.6) CALL BMTRNDMG(XNOW,TNOW,NGAS)
115 IF(KTREN.GE.21.and.KTREN.LE.29)
116 & CALL STBTRND(XNOW,TNOW,NGAS,KTREN)
117 if(KTREN.LE.20)then
118 CALL DTDX1D(XNOW,XREF,XDT0,SDT0,KFOR,NGAS) 9109.8
119 CALL DTDX3D(XNOW,XREF,XDT0,SDT0,KFOR,1) 9109.9
120 CALL DXDT3D(XNOW,XREF,XDT0,SDT0,KFOR,NGAS) 9110.
121 endif
122 FULGAS(2)=XNOW(1)/XREF(1) 9110.1
123 FULGAS(6)=XNOW(2)/XREF(2) 9110.2
124 FULGAS(7)=XNOW(3)/XREF(3) 9110.3
125 FULGAS(8)=XNOW(4)/XREF(4) 9110.4
126 FULGAS(9)=XNOW(5)/XREF(5) 9110.5
127 if(.not.OBSFOR)then
128 IF(KWRITE.EQ.1) then
129 print *,'From forset XNOW(1)=',XNOW(1)
130 ENDIF
131 do j=1,nlat
132 atm_co2(j)=XNOW(1)
133 enddo
134 endif
135 C 9110.6
136 IF(KWRITE.NE.1) GO TO 220 9110.7
137 SDT0=0.0 9110.8
138 DO 210 I=1,NGAS 9110.9
139 SDT0=SDT0+XDT0(I) 9111.
140 XRAT(I)=(XNOW(I)-XDAT(I))/(1.E-10+XDAT(I)) 9111.1
141 210 XDAT(I)=XNOW(I) 9111.2
142 IYEAR=TNOW 9111.3
143 WRITE(6,6200) IYEAR,SDT0,(XDT0(I),I=1,5),(XNOW(I),I=1,5) 9111.4
144 + ,(XRAT(I),I=1,5) 9111.5
145 6200 FORMAT(1X,I4,F6.3,5F8.4,1X,F8.2,4F8.4,1X,5F8.4) 9111.6
146 NSPACE=IYEAR-(IYEAR/10)*10 9111.7
147 IF(NSPACE.EQ.0) WRITE(6,6010) 9111.8
148 6010 FORMAT(1H ) 9111.9
149 220 CONTINUE 9112.
150 C 9112.1
151 RETURN 9112.2
152 END 9112.3

  ViewVC Help
Powered by ViewVC 1.1.22