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

Contents of /MITgcm_contrib/jscott/igsm/src/forset.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 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

  ViewVC Help
Powered by ViewVC 1.1.22