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

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

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


Revision 1.1 - (hide 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 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     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