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

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

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


Revision 1.4 - (show annotations) (download)
Thu Oct 4 20:40:27 2007 UTC (17 years, 9 months ago) by jscott
Branch: MAIN
Changes since 1.3: +3 -3 lines
comment out TEM.h include -- already done in DRIVER.h

1
2 #include "ctrparam.h"
3
4 ! ==========================================================
5 !
6 ! INPUT.F: THIS SUBROUTINE SETS THE PARAMETERS IN THE
7 ! C ARRAY, READS IN THE INITIAL CONDITIONS,
8 ! AND CALCULATES THE DISTANCE PROJECTION ARRAYS
9 !
10 ! ----------------------------------------------------------
11 !
12 ! Author of Chemistry Modules: Chien Wang
13 !
14 ! ----------------------------------------------------------
15 !
16 ! Revision History:
17 !
18 ! When Who What
19 ! ---- ---------- -------
20 ! 073100 Chien Wang repack based on CliChem3 and add cpp
21 !
22 ! ==========================================================
23
24 SUBROUTINE INPUT 1501.
25 C**** 1502.
26 C**** THIS SUBROUTINE SETS THE PARAMETERS IN THE C ARRAY, READS IN THE 1503.
27 C**** INITIAL CONDITIONS, AND CALCULATES THE DISTANCE PROJECTION ARRAYS 1504.
28 C**** 1505.
29
30 #if ( defined CPL_CHEM )
31 !
32 #include "chem_para"
33 #include "chem_com"
34 !
35 #endif
36
37 #include "ODIFF.COM"
38 #include "BD2G04.COM"
39 #include "RADCOM.COM"
40 #include "run.COM"
41 #include "DRIVER.h"
42
43 #if ( defined OCEAN_3D )
44 #include "AGRID.h"
45 #endif
46
47 cjrs done in driver.h #if ( defined CPL_TEM )
48 cjrs#include "TEM.h"
49 cjrs#endif
50 !
51 ! === Chien Wang 062904
52 !
53 character(100) :: cfname
54 !
55 COMMON/OCN/TG3M(1,JM0,12),RTGO(1,JM0,lmo),STG3(1,JM0),DTG3(1,JM0)
56 COMMON/SPEC2/KM,KINC,COEK,C3LAND(IO0,JM0),C3OICE(IO0,JM0) 1506.1
57 * ,C3LICE(IO0,JM0),WMGE(IO0,JM0),TSSFC(IM0,JM0,4) 1506.2
58 COMMON/EPARA/VTH(JM0,LM0),WTH(JM0,LM0),VU(JM0,LM0),VV(JM0,LM0)
59 & ,DQSDT(JM0,LM0) 1506.3
60 * ,DWV(JM0),PHIT(JM0,LM0),TPRIM2(JM0,LM0),WU(JM0,LM0),CKS,CKN 1506.4
61 * ,WQ(JM0,LM0),VQ(JM0,LM0),MRCHT 1506.5
62 CHARACTER*4 XLABL1 1506.6
63 COMMON U,V,T,P,Q 1507.
64 C COMMON/KEYS/KEYNR(42,50) 1508.
65 c COMMON/RADCOM/VADATA(11,4,3)
66 c CHARACTER*8 RECORD,ANDEND,NLREC*80 1510.
67 CHARACTER*12 RECORD,ANDEND,NLREC*80 1510.
68 CHARACTER*4 C,C1,NAMD60,DISK,RUNID 1510.1
69 CHARACTER*5 TSCNTR
70 DIMENSION RECORD(10) 1510.2
71 DIMENSION JC(100),C(39),RC(161),JC1(100),C1(39),RC1(161) 1511.
72 EQUIVALENCE (JC(1),IM),(C(1),XLABEL(1)),(RC(1),TAU) 1511.1
73 DIMENSION IDAYS0(13),NAMD60(4),SIG0(36),SIGE0(37) 1512.
74 DIMENSION XA(1,JM0),XB(1,JM0),XLABL1(33) 1512.5
75 DIMENSION JDOFM(13),VMASK(JM0)
76 & ,DSIGF(LM0),DSIGH(LM0)
77 character *120 file1,file2,plotfl,nwrfl
78 character * 120 t3file,tsfile,zmfile,qffile,clfile,wrcldf
79 & ,ochemfile,deepco2in
80 & ,oco2file,co2rfile,caruptfile,flrco2av
81 & ,ghg_monthly,ghg_monthly2,co2_data,o3_data
82 & ,bgrghg_data
83 character * 120 sulf1986,sulf2050,sulfamp,SO2_EM,
84 & S0C_data,
85 & dirdat1,dirdat2
86 & ,bc_data
87 character * 120 chemdata,chemout,last_nep,init_4nem,pov_deepo
88 & ,flin_nep,last_clm,emiss_data,SO2ERATIO,SEN_dat
89 & ,fl_init_alkt,fl_init_salt,fl_dic_eq,fnememiss,
90 & chem_init,chem_init2,chemrstfl
91 common/files/file1,file2,plotfl,nwrfl,qffile,clfile,wrcldf
92 *,t3file,tsfile,zmfile,ochemfile,deepco2in
93 character * 120 ghostfile
94 c==== 012201
95 common/nemdata/nemdatdir
96 character *120 nemdatdir
97
98 common /bmtrdata/co2_data
99 common /bghgdata/bgrghg_data
100 common /sulfdata/sulf1986,sulf2050,sulfamp,SO2_EM
101 common /o3data/o3_data
102 common /solardata/S0C_data
103 common/aexpc/AEXP,ISTRT1,ISTRTCHEM,LYEAREM
104 common/qfl/QFLUX(JM0,0:13),ZOAV(JM0),QFLUXT(JM0)
105 common/fixcld/cldssm(JM0,LM0,0:13),cldmcm(JM0,LM0,0:13)
106 & ,CLDSST(JM0,LM0),CLDMCT(JM0,LM0)
107 common/SURRAD/TRSURF(JM0,4),SRSURF(JM0,4)
108 NAMELIST/INPUTZ/IM,JM,LM,LS1,LBLM,LMCM,LSSM,KOCEAN,ISTART,KDISK, 1513.
109 * TAUP,TAUNI,TAUE,TAUT,TAUO,NDYN,NCNDS,NRAD,NSURF,NGRND,NFILTR, 1514.
110 * NDAA,NDA5D,NDA5K,NDA5S,NDA4,NDASF,DT,TAU,XINT,INYEAR, 1515.
111 * LHE,LHM,LHS,RADIUS,GRAV,RGAS,KAPA,OMEGA,RHMAX,ETA,S0X,CO2,SRCOR,1516.
112 * PTOP,PSF,PSL,PTRUNC,DLAT,DLON,AREAG,IRAND,IJRA,MFILTR,NDIFS, 1517.
113 * KACC,KEYCT,SKIPSE,USESLP,USEP,USET,KCOPY,DUMMY1,IDACC,KDIAG, 1518.
114 * NDZERO,NDPRNT,IJD6,NAMD6,SIG,SIGE, 1519.
115 * KM,KINC,COEK,INDAY,IMONTH,LDAY,LMONTH,LYEAR,AEXP, 1519.5
116 * READGHG,wr25,LFR,ISTRT1,PCLOUD,QFCOR,TRANSR,WRCLD,NWRCLD,CONTRR,
117 * ISTWRC,CLDFEED,OBSFOR,ALFFOR,YEARGT,CO2IN,ISTRTCHEM,
118 & LYEAREM,
119 * AERFOR,AERF4BC,
120 * S0RATE,CFS0X,
121 * CFAEROSOL,CFBC,
122 & cfocdif,rkv,diffcar0,ocarcont,ocarindata,
123 ! Kvc=diffcar0+cfocdif*Kvh
124 * file1,file2,plotfl,nwrfl,qffile,clfile,wrcldf,clmsen,cfdif0,
125 * t3file,tsfile,zmfile,ochemfile,deepco2in,
126 & fl_init_alkt,fl_init_salt,fl_dic_eq,
127 * ghg_monthly,ghg_monthly2,co2_data,o3_data,
128 & bgrghg_data,
129 * sulf1986,sulf2050,sulfamp,SO2_EM,
130 & S0C_data,cfvolaer,
131 & dirdat1,dirdat2
132 & ,chemdata,chemout,last_nep,init_4nem,pov_deepo,fnememiss
133 & ,chem_init,chem_init2,chemrstfl
134 & ,oco2file,co2rfile,caruptfile,emiss_data,SO2ERATIO,flrco2av
135 & ,flin_nep,last_clm,SEN_dat,nemdatdir
136 & ,GHSFALB,GHSF,ALBCF,FVOLADD,ghostfile,fl_volaer
137 & ,STRARFOR,GSOEQ,CO2FOR,CO2F,FORSULF,FORBC,S0FOR,FORVOL
138 & ,VEGCH,vegfile,TRVEG
139 & ,fclmlice,fbaresoil,fwmax,fprratio,o3datadir,CLIMO3
140 & ,OCNGEOM,ocngmfile,ocndata4atm
141 & ,bc_data
142 Cjrs & ,dtatm,dtocn
143 #if ( defined IPCC_EMI )
144 & ,init_co2
145 character * 120 init_co2
146 #endif
147 character * 120 ocngmfile,ocndata4atm,fl_volaer
148 character * 120 vegfile
149 & ,fclmlice,fbaresoil,fwmax,fprratio,o3datadir
150 common/wrcom/wr25,TRANSR,CONTRR,OBSFOR
151 c jrs common/TIMESTEPS/dtatm,dtocn
152 LOGICAL LFR,NLFR,wr25,TRANSR,WRCLD,CONTRR,CLDFEED,OBSFOR
153 &,GHSF,VEGCH,TRVEG,GSOEQ,OCNGEOM,GHSFALB,STRARFOR,CO2FOR
154 & ,FORSULF,FORBC,S0FOR,FORVOL
155 common/FORAERSOL/FORSULF,FORBC,FORVOL
156 common/vaerosol/fl_volaer
157 common/eqgso/GSOEQ
158 common/ghstfor/GHSFALB,GHSF,ALBCF,FVOLADD,STRARFOR,S0FOR,CO2FOR,
159 & CO2F,ghostfv(LM0+1),ghostf(LM0+1,JM0)
160 common/veg/TRVEG,IYVEG
161 common/COMCLD/READGHG,PCLOUD,WRCLD,NWRCLD,NWRCL,INYEAR,JNDAY
162 &,CFAEROSOL,ALFA,CFBC,cfvolaer
163 common/ BACKGRGHG/GHGBGR(5)
164 common/CO2EM/emiss_data
165 COMMON/CO2TRND/ALFFOR,CO2TR,YEARGT,CO2IN,INYRAD
166 common/ S0XR/S0RATE,CFS0X
167 common/cldfdb/coefcl(3),CLDFEED,SEN_dat
168 common/diff/cfdiff,rkv
169 common/Dscale/DWAV0(JM0)
170 dimension fland_temp(jm0)
171 common/atmos_lo/fland_atm(jm0) !jrs not sure this does anything
172
173 #if ( defined CLM )
174 cjrs alreadyin DRIVER.h#include "CLM.COM"
175 dimension clmlice(jm0),baresoil(jm0),
176 & w1maxclm(jm0),w2maxclm(jm0),vmaskclm(jm0)
177 character * 120 lineclm
178 #endif
179 #if ( defined CPL_OCEANCO2 && defined ML_2D )
180 common/Garyclim/tggary(jm0),wsgary(jm0),areaml(jm0),arsrf(jm0)
181 ! common/Garydiff/depthml(jm0),edzon(jm0,lmo),dzg(lmo),dzog(lmo-1),
182 ! &Rco2(jm0,lmo),edohd(lmo),zg(lmo),focean(jm0)
183 common/Garydiff/depthml(jm0),edzon(jm0),dzg(lmo),dzog(lmo-1),
184 &Rco2(jm0,lmo),edohd(lmo),zg(lmo),focean(jm0)
185 common /Garychem/Hg(jm0)
186 common /Garyvdif/iyearocm,vdfocm,acvdfc,cfocdif,diffcar0
187 common /Garyvlog/odifcarbon,ocarcont
188 real Rco2in(jm0,lmo),Hgin(jm0)
189 logical odifcarbon,ocarcont,ocarindata
190 #endif
191
192 #if (!defined PREDICTED_GASES)
193 #if (defined CPL_TEM || defined CPL_OCEANCO2 )
194 common /ATCO2/atm_co2(jm0),oco2file,co2rfile
195 #endif
196 #endif
197
198 integer PCLOUD
199 ! common/TSUR/TSURFC(JM0,0:13),TLANDD(JM0),TSURFD(JM0),DTSURF(JM0)
200 ! common/TSLD/TLANDC(JM0,0:13),TLANDT(JM0),TLANDD(JM0),DTLAND(JM0)
201 #include "TSRF.COM"
202 DATA DISK/'DISK'/,ANDEND/' &END '/ 1520.
203 DATA IDAYS0/0,1,32,60,91,121,152,182,213,244,274,305,335/ 1521.
204 DATA NAMD60/'AUSD','MWST','SAHL','EPAC'/ 1522.
205 DATA EDPERD/1./,EDPERY/365./ 1527.
206 DATA JDOFM/0,31,59,90,120,151,181,212,243,273,304,334,365/
207 DATA JDPERY/365/
208 ! dimension GHGBGR1860(5),GHGBGR1958(5),GHGBGR1977(5),
209 ! & GHGBGR1980(5), GHGBGR1765(5),GHGBGR1991(5),GHGBGR2000(5)
210 ! & ,GHGBGR1990(5)
211 ! DATA GHGBGR1765/280.0,0.275,0.791,0.00E-6,00.0E-6/
212 ! DATA GHGBGR1860/286.4,0.276,0.805,0.00E-6,00.0E-6/
213 ! DATA GHGBGR1958/314.9,0.291,1.224,7.60E-6,29.6E-6/
214 ! DATA GHGBGR1977/331.8,0.292,1.613,13.2e-6,25.2e-6/
215 ! DATA GHGBGR1980/337.9,0.301,1.547,166.6e-6,300.0e-6/
216 ! DATA GHGBGR1990/351.0,0.308,1.67,500.6e-6,470.0e-6/
217 c DATA GHGBGR1991/355.7,0.310,1.704,268.6e-6,492.0e-6/
218 C average for years 1990 and 1991 from ghgdata.GISS.modified.dat
219 ! DATA GHGBGR1991/352.7,0.3091,1.681,5.21E-04,4.855E-04/
220 ! average for years 2000 and 2001 from ghgdata.GISS.dat
221 ! DATA GHGBGR2000/368.75,0.316,1.735,5.825E-04,5.35E-04/
222
223
224 C 1527.5
225 C DEFINE THE COMMON BLOCK /SPEC2/ 1527.51
226 C 1527.52
227 KM=1 1527.53
228 KINC=1 1527.54
229 COEK=2. 1527.55
230 C 1527.56
231 C**** SET PARAMETER DEFAULTS 1528.
232 DO 10 K=1,100 1529.
233 10 JC(K)=0 1530.
234 DO 15 K=1,161 1530.1
235 15 RC(K)=0. 1530.2
236 JM=JM0 1531.
237 IM=IM0
238 IO=IO0 1532.5
239 LM=LM0 1533.
240 C LS1 is a lowest stratospheric layer, thus LS1=8 means that
241 C there are 2 layers in the strosphere k=8 and 9 (for LM=9)
242 C and four for LM=11.
243 C and four for LM=11.
244 LS1=8 1534.
245 C
246 LBLM=2 1535.
247 ISTART=10 1536.
248 CONTRR=.false.
249 CLDFEED=.false.
250 CFAEROSOL=1.0
251 CFBC=1.0
252 cfvolaer=1.0
253 ALFFOR=0.
254 S0RATE=0.
255 YEARGT=1958.
256 LYEAREM=2100
257 CO2IN=280.
258 INYRAD=1.
259 coefcl(1)=0.
260 coefcl(2)=0.
261 coefcl(3)=0.
262 cfdiff=1.
263 rkv=1.
264 GHSF=.false.
265 GHSFALB=.false.
266 STRARFOR=.false.
267 FORSULF=.true.
268 FORBC=.false.
269 FORVOL=.false.
270 CO2FOR=.false.
271 S0FOR=.false.
272 CO2F=2.0
273 GSOEQ=.false.
274 VEGCH=.false.
275 TRVEG=.false.
276 OCNGEOM=.false.
277 do L=1,LM+1
278 ghostfv(L)=0.
279 do j=1,jm
280 ghostf(l,j)=0.0
281 enddo
282 enddo
283 cfocdif=0.42
284 cfocdif=1.375
285 cfocdif=0.6
286 cfocdif=3.0
287 diffcar0=2.85
288 diffcar0=1.00
289 cc ALFA = 8.0*1.e3
290 AERF4BC=-0.35
291 TRANSR=.false.
292 WRCLD=.FALSE.
293 clfile = 'undefined'
294 zmfile = 'undefined'
295 t3file = 'undefined'
296 tsfile = 'undefined'
297 qffile = 'undefined'
298 wrcldf = 'undefined'
299 oco2file = 'undefined'
300 co2rfile = 'undefined'
301 fl_volaer = 'undefined'
302 SO2_EM = 'undefined'
303 sulf1986 = 'undefined'
304 sulf2050 = 'undefined'
305 sulfamp = 'undefined'
306 caruptfile = 'undefined'
307 flrco2av = 'undefined'
308 ISTRT1=0
309 ISTRTCHEM=0
310 ISTWRC=0
311 QFCOR=.FALSE.
312 READGHG=0.
313 cjrs dtatm=1
314 cjrs dtocn=1
315 ghg_monthly = 'undefined'
316 ghg_monthly2 = 'undefined'
317 co2_data = 'undefined'
318 bgrghg_data = 'undefined'
319 bc_data = 'undefined'
320 S0C_data = 'undefined'
321 o3_data = 'undefined'
322 ochemfile = 'undefined'
323 deepco2in = 'undefined'
324 fl_init_alkt = 'undefined'
325 fl_init_salt = 'undefined'
326 fl_dic_eq = 'undefined'
327 ocarcont=.true.
328 ocarindata=.false.
329 vegfile = 'undefined'
330 fclmlice = 'undefined'
331 fprratio = 'undefined'
332 fbaresoil = 'undefined'
333 o3datadir = 'undefined'
334 CLIMO3=.false.
335 fwmax = 'undefined'
336 ocngmfile = 'undefined'
337 ocndata4atm = 'undefined'
338 ghostfile = 'undefined'
339 NWRCLD=0
340 TAUNI=0.
341 LFR=.TRUE.
342 wr25=.true.
343 chemout = 'DUMP'
344 chemdata = 'DATA'
345 chem_init = 'init-data_46x11_1991'
346 chem_init2 = 'init-data2_46x11_1991'
347 chemrstfl = 'undefined'
348 nemdatdir = 'TEMDATA'
349 emiss_data='edaily.dat'
350 last_nep = 'undefined'
351 last_clm = 'undefined'
352 flin_nep = 'undefined'
353 init_4nem = 'undefined'
354 fnememiss = 'undefined'
355 pov_deepo = 'undefined'
356 SO2ERATIO= 'undefined'
357 SKIPSE=1.
358 TAUT=6. 1537.
359 TAUT=24.
360 KOCEAN=1 1537.1
361 KDISK=1 1538.
362 DT=900. 1539.
363 DT=1200.
364 XINT=120. 1540.
365 XINT=24.
366 NDYN=4 1541.
367 NDYN=3
368 #if ( defined CLM )
369 NSURF=1
370 #else
371 NSURF=2 1542.
372 #endif
373 ! NSURF=1 ! 07/17/2006
374 NGRND=1 1543.
375 TAUP=-1. 1544.
376 TAUI=-1. 1545.
377 TAUE=1.E30 1546.
378 TAUO=1.E30 1547.
379 IYEAR=1976 1548.
380 TWOPI=8.*atan(1.)
381 TWOPI=6.283185 1549.
382 SDAY=86400. 1550.
383 LHE=2500000. 1551.
384 LHM=334000. 1552.
385 LHS=2834000. 1553.
386 RADIUS=6375000. 1554.
387 GRAV=9.81 1555.
388 RGAS=287. 1556.
389 KAPA=.286 1557.
390 PTOP=10. 1558.
391 PSF=984. 1559.
392 PSL=1000. 1560.
393 PTRUNC=1./8192. 1561.
394 S0X=1. 1561.1
395 CFS0X=1.
396 CO2=1. 1561.2
397 SRCOR=1. 1561.3
398 ED=.1 1562.
399 EDM=.1 1563.
400 ETA=0. 1564.
401 ETA=1.
402 RHMAX=100000. 1565.
403 RHMAX=150000.
404 CDX=1. 1566.
405 IRAND=123456789 1567.
406 IJRA=1 1568.
407 MFILTR=1 1569.
408 MFILTR=2
409 KEYCT=1 1570.
410 CKN=1.00 1570.5
411 CKS=1.00 1570.6
412 DUMMY1(1)=.0005 1571.
413 DUMMY1(2)=.00005 1572.
414 IJD6(1,1)=32 1573.
415 IJD6(2,1)=9 1574.
416 IJD6(1,2)=9 1575.
417 IJD6(2,2)=18 1576.
418 IJD6(1,3)=19 1577.
419 IJD6(2,3)=14 1578.
420 IJD6(1,4)=7 1579.
421 IJD6(2,4)=12 1580.
422 DO 20 KR=1,4 1581.
423 20 NAMD6(KR)=NAMD60(KR) 1582.
424 NDPRNT(1)=-1 1583.
425 DO 30 K=2,13 1584.
426 NDPRNT(K)=IDAYS0(K) 1585.
427 30 NDZERO(K)=IDAYS0(K) 1586.
428 DO 40 K=1,50 1587.
429 40 KEYNR(2,K)=0 1588.
430 DO 45 K=1,12 1589.
431 45 KDIAG(K)=10 1590.
432 KDIAG(1)=0.
433 KDIAG(2)=0.
434 c KDIAG(3)=0.
435 DST=.02053388
436 DSB=1.-.948665
437 if(LM.eq.9)then
438 CALL MESH09(LM,DST,DSB,SIG0,SIGE0,DSIGH,DSIGF)
439 elseif(LM.eq.11)then
440 CALL MESH11(LM,DST,DSB,SIG0,SIGE0,DSIGH,DSIGF)
441 else
442 print *,' wrong LM LM=',LM
443 stop
444 endif
445 DO L=1,LM
446 SIGE(l)=SIGE0(LM+2-l)
447 SIG(l)=SIG0(LM+1-l)
448 ENDDO
449 c DO 50 L=1,LM 1591.
450 c SIG(L)=SIG0(L) 1592.
451 c 50 SIGE(L)=SIGE0(L) 1593.
452 SIGE(LM+1)=0. 1594.
453 WRITE (6,901) 1595.
454 open(535,file='name.dat')
455 READ (535,902) XLABEL 1596.
456 open(514,file='name.tmp')
457 DO 51 I=1,33 1596.1
458 51 XLABL1(I)=XLABEL(I) 1596.2
459 XLABEL(33)=DISK 1597.
460 WRITE (6,903) XLABEL 1598.
461 C**** COPY INPUTZ NAMELIST ONTO CORE TAPE AND TITLE PAGE 1599.
462 60 CONTINUE
463 READ (535,904) RECORD 1600.
464 WRITE (514,904) RECORD 1601.
465 WRITE (6,905) RECORD 1602.
466 IF(RECORD(1).NE.ANDEND) GO TO 60 1603.
467 rewind 514
468 read (UNIT=514,NML=INPUTZ)
469 REWIND 514 1606.
470 C JRS ignore name.dat values, start Jan 1. with couple.nml years
471 inyear = startYear
472 lyear = endYear +1
473 INDAY = 1
474 IMONTH = 1
475 LDAY = 1
476 LMONTH = 1
477 Cjrs dtatmo=dtatm
478 cjrs dtocno=dtocn
479 cb open statments
480 c
481 c File which depend on resolution
482 id2=index(dirdat2," ")
483 c
484 open( unit=519,file=dirdat2(1:id2-1)//'FILE19',
485 * status='OLD',form='unformatted')
486 open( unit=515,file=dirdat2(1:id2-1)//'FILE15',
487 * status='OLD',form='unformatted')
488 open( unit=523,file=dirdat2(1:id2-1)//'FILE23',
489 * status='OLD',form='unformatted')
490 open( unit=526,file=dirdat2(1:id2-1)//'FILE26',
491 * status='OLD',form='unformatted')
492 open( unit=562,file=dirdat2(1:id2-1)//'FILE62',
493 * status='OLD',form='unformatted')
494 c
495 if(VEGCH.or.TRVEG)then
496 close(523)
497 open( unit=523,file=vegfile,
498 & status='OLD',form='unformatted')
499 endif
500 c File which do not depend on resolution
501 id1=index(dirdat1," ")
502 c
503 open( unit=509,file=dirdat1(1:id1-1)//'FILE09',
504 * status='OLD',form='unformatted')
505 open( unit=507,file=dirdat1(1:id1-1)//'FILE07',
506 * status='OLD',form='unformatted')
507 open( unit=516,file=dirdat1(1:id1-1)//'FILE16',
508 * status='OLD',form='unformatted')
509 open( unit=517,file=dirdat1(1:id1-1)//'FILE17',
510 * status='OLD',form='unformatted')
511 open( unit=522,file=dirdat1(1:id1-1)//'FILE22',
512 * status='OLD',form='unformatted')
513 open( unit=521,file=dirdat1(1:id1-1)//'FILE21',
514 * status='OLD',form='unformatted')
515 c
516 if(LMO.eq.12) then
517 open( unit=593,file=dirdat1(1:id1-1)//'FOCEAN_12',
518 * status='OLD',form='unformatted')
519 endif
520 c
521 if(GHSF)then
522 print *,ghostfile
523 open(unit=599,file=ghostfile,
524 & status='OLD',form='unformatted')
525 read(599) ghostf
526 close(599)
527 endif
528 #if ( !defined CPL_CHEM )
529 #if ( defined PREDICTED_BC)
530 if(READGHG.eq.0)then
531 ! data for BC only
532 print *,'Data for black carbon'
533 open(769,file=bc_data,
534 & status='old',form='unformatted')
535 endif
536 #endif
537 #endif
538
539 c
540 #if ( defined CPL_CHEM )
541 !
542 ! --- assign input and output files
543 ! Note: Due to historical reasons, no all files are
544 ! assigned here - in case you want to search
545 ! something use
546 ! grep -i "needed characters" *.F
547 !
548 ! You have my sympathy.
549 !
550 ! Chien 080400
551 !
552 #include "assign.inc"
553 !
554 #endif
555
556 c open file for carbon uptake
557 #if ( defined CPL_TEM || defined CPL_OCEANCO2 )
558 c open(333,file=caruptfile,status='new',form='formatted')
559 open(333,file=caruptfile,form='formatted')
560 #endif
561
562 #if ( defined CPL_OCEANCO2 && defined ML_2D)
563 open(668,file=fl_init_alkt,
564 & form='unformatted',status='old')
565 open(669,file=fl_init_salt,
566 & form='unformatted',status='old')
567 ! open(670,file=fl_dic_eq,
568 ! & form='unformatted',status='old')
569 open(602,file=flrco2av,status='new',form='unformatted')
570 #endif
571
572 ce open statments
573 call bgrghg(YEARGT)
574 #if ( defined IPCC_EMI )
575 ! if(YEARGT.eq.1765)then
576 ! GHGBGR(1)=277.6
577 open (unit=861,file=init_co2,
578 & status='OLD',form='formatted')
579 read (861,*)xco2init
580 CO2=xco2init/GHGBGR(1)
581 print *,'IPCC EMI CO2=',CO2
582 ! else
583 ! print *,' Wrong YEARGT ', YEARGT
584 ! stop
585 ! endif
586 #endif
587 print *,'Background GHGs for year ',YEARGT
588 print '(5E12.4)',GHGBGR
589 if(CLDFEED)then
590 C Calculate coefcl for given clmsen
591 print *,'Climate sensitivity=',abs(clmsen)
592 call senint(abs(clmsen))
593 C NEW
594 if(clmsen.gt.0.0)then
595 print *,'With coefficients of different signs for clouds '
596 print *, ' of diffrent types'
597 coefcl(2)=-coefcl(2)
598 coefcl(3)=-coefcl(3)
599 else
600 C OLD
601 print *,'With the same coefficient for clouds '
602 print *, ' of all types'
603 endif
604 print *,'coefcl=',coefcl
605 else
606 print *,'No additional cloud feedback'
607 print *,'coefcl=',coefcl
608 endif
609 if(TRANSR)then
610 cfdiff=cfdif0/2.5
611 print *,'cfdiff=',cfdiff
612 print *,' Weight for old diffusion coefficeints=',rkv
613 print *,' Weight for new diffusion coefficeints=',1.-rkv
614 else
615 print *,'No diffusion into deep ocean'
616 endif
617 !#if ( defined PREDICTED_AEROSOL )
618 #if ( defined CPL_CHEM )
619 Cold AFBYCF=0.6725
620 Cold SO2EREF=123.57
621 Cigsm1AFBYCF=0.6054
622 Cigsm1SO2EREF=135.272
623 ! AFBYCF=1.101897
624 ! SO2EREF=152.3631
625 ! read(664,'(f10.6)')SO2EM
626 ! SO2ER=SO2EM/SO2EREF
627 ! CFAEROSOL=-AERFOR/(AFBYCF*SO2ER)
628 Cold CFAEROSOL=(-AERFOR/AFBYCF)**1.035/(SO2ER**0.7248)
629 ! CFAEROSOL=(-AERFOR/AFBYCF)**1.035/(SO2ER**1.0391)
630
631
632 SO2EREF=147.375
633 open(664,file=SO2ERATIO,
634 & form='formatted',
635 & status='old')
636 read(664,'(f10.6)')SO2EM
637 SO2ER=SO2EM/SO2EREF
638 ! F90BYF80=0.948
639 ! AERFOR90=AERFOR*F90BYF80
640 ! AFBYCF90=1.04
641 ! print *,'AFBYCF90=',AFBYCF90
642 ! 12/21/2006 (from runs 265x.06)
643 ! Adjustment for BC forcing
644 print *,' AERF4BC=',AERF4BC
645 AERFOR=AERFOR+AERF4BC
646 ! Adjustment for BC forcing
647 AFBYCF=1.05
648 print *,'SO2ER=',SO2ER
649 print *,'AFBYCF=',AFBYCF
650 CFAEROSOL=(-AERFOR/AFBYCF)**1.21
651 CFAEROSOL=CFAEROSOL/(SO2ER**1.01)
652 print *,'AERFOR=',AERFOR,'CFAEROSOL=',CFAEROSOL
653 #if ( defined OCEAN_3D )
654 CFAEROSOL=CFAEROSOL/1.35
655 print *,'CFAEROSOL_3D=',CFAEROSOL
656 #endif
657 #endif
658 #if ( defined SVI_ALBEDO )
659 ALFA=-16.7*AERFOR*1.e3
660 print *,'AERFOR=',AERFOR,' ALFA=',ALFA
661 #endif
662 C**** SET DEPENDENT QUANTITIES 1608.
663 80 DLON=TWOPI/IM 1609.
664 DLAT=.5*TWOPI/(JM-1) 1610.
665 JMM1=JM-1 1611.
666 FIM=IM 1612.
667 FIO=IO 1612.5
668 LMM1=LM-1 1613.
669 LMP1=LM+1 1614.
670 LTM=LS1-1 1615.
671 LSSM=LM 1616.
672 LMCM=LTM 1617.
673 c LMCM=LTM+2
674 NCNDS=NDYN 1618.
675 NRAD=5*NDYN 1619.
676 NFILTR=2*NDYN 1620.
677 NFILTR=0
678 NDAA=3*NDYN+2 1621.
679 NDA5D=NDYN 1622.
680 NDA5K=NDAA 1623.
681 ndaa=3
682 NDA5S=3*NDYN 1624.
683 NDA4=24*NDYN 1625.
684 NDASF=2*NSURF-1 1626.
685 KACC=KACC0
686 IF(SKIPSE.GE.1.) KACC=KACC-IM*JM*LM*3+6 1630.
687 print *,' KACC0=',KACC0,' KACC=',KACC
688 IF(ISTART.GE.4) GO TO 90
689 KACC=JM*80*3 + JM*80 + JM*3 + JM*LM*59 + JM*3*4 + IM*JM*75 1627.
690 * + IM*LM*16 + IM*JM*LM*3 + 20*100 + JM*36 + (IM/2+1)*20*8 + 8*2 1628.
691 * +24*50*4 + 2 1629.
692 IF(SKIPSE.GE.1.) KACC=KACC-IM*JM*LM*3+6 1630.
693 print *,' KACC=',KACC
694 90 continue
695 #if( !defined OCEAN_3D)
696 open( unit=525,file=zmfile,
697 * status='OLD',form='unformatted')
698 #endif
699 if(ISTART.eq.2)then
700 open( unit=501,file=file1,
701 * status='new',form='unformatted')
702 open( unit=502,file=file2,
703 * status='new',form='unformatted')
704 open( unit=546,file=plotfl,
705 * status='new',form='unformatted')
706 open( unit=547,file=nwrfl,
707 * status='new',form='unformatted')
708 elseif(ISTART.eq.10)then
709 open( unit=501,file=file1,
710 * status='OLD',form='unformatted')
711 open( unit=502,file=file2,
712 * status='OLD',form='unformatted')
713 if(ISTRT1.eq.0)then
714 open( unit=546,file=plotfl,
715 * status='new',form='unformatted')
716 open( unit=547,file=nwrfl,
717 * status='new',form='unformatted')
718 #if ( defined CPL_CHEM) && ( defined CPL_TEM )
719 open( unit=537,file=flin_nep,
720 * status='OLD',form='unformatted')
721 #endif
722 #if ( defined CPL_TEM )
723 open (367,file=last_nep,form='unformatted',status='new')
724 open (877,file=last_clm,form='unformatted',status='new')
725 c file last_clm contains data for posible restart of NEM
726 c this file is writen at the end of the run
727 #if ( defined CPL_NEM )
728 open (368,file=init_4nem,form='unformatted',status='old')
729 c file init_4nem contains data for the restart of NEM
730 c from the results of a previous run
731 open (277,file=fnememiss,form='unformatted',status='new')
732 #endif
733 #endif
734 #if ( defined CPL_OCEANCO2 && defined ML_2D )
735 open (369,file=pov_deepo,form='unformatted',status='new')
736 #endif
737 else
738 C For restart of the run
739 open( unit=546,file=plotfl,
740 * status='OLD',form='unformatted')
741 open( unit=547,file=nwrfl,
742 * status='OLD',form='unformatted')
743 #if ( defined CPL_TEM )
744 open (367,file=last_nep,form='unformatted',status='old')
745 open (877,file=last_clm,form='unformatted',status='old')
746 #if ( defined CPL_NEM )
747 open (368,file=init_4nem,form='unformatted',status='old')
748 c file init_4nem contains data for the restart of NEM
749 c from the results of a previous run
750 open (277,file=fnememiss,form='unformatted',status='new')
751 #endif
752 #endif
753 #if ( defined CPL_OCEANCO2 && defined ML_2D )
754 open (369,file=pov_deepo,form='unformatted',status='old')
755 #endif
756 endif
757 endif
758 C**** 1719.
759 C**** RESTART ON DATA SETS 1 OR 2, ISTART=10-13 1720.
760 C**** 1721.
761 C**** CHOOSE DATA SET TO RESTART ON 1722.
762 400 TAU1=-1. 1723.
763 READ (501,ERR=410) AEXPX1,TAU1 1724.
764 410 REWIND 501 1725.
765 TAU2=-1. 1726.
766 READ (502,ERR=420) AEXPX2,TAU2 1727.
767 420 REWIND 502 1728.
768 print *,' TAU1=',TAU1,' TAU2=',TAU2
769 KDISK=1 1729.
770 IF(TAU1+TAU2.LE.-2.) GO TO 850 1730.
771 IF(TAU2.GT.TAU1) KDISK=2 1731.
772 if(KDISK.eq.1)AEXPX=AEXPX1
773 if(KDISK.eq.2)AEXPX=AEXPX2
774 IF(ISTART.GE.13) KDISK=3-KDISK 1732.
775 GO TO 450 1733.
776 440 KDISK=ISTART-10 1734.
777 C**** RESTART ON UNIT KDISK 1735.
778 450 ISTAR0=ISTART 1736.
779 KDISK0=KDISK+500 1737.
780 if(ISTRT1.eq.0) then
781 C *****
782 C FOR ISTRT1 = 0
783 C *******
784 c print *,' Form input '
785 if(.not.CONTRR)then
786 READ (KDISK0,ERR=840)AEXPX,TAUX,JC1,C1,RC1,KEYNR,U,V,T,P,Q,
787 & ODATA,
788 * GDATA,BLDATA,RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAUY,TSSFC,CKS, 1739.
789 * CKN,WMGE,TPRIM2,MRCHT,TRSURF,SRSURF,TLANDD,TSURFD,DWAV0
790 else
791 ! READ (KDISK0,ERR=840)AEXPX,TAUX,JC1,C1,RC1,KEYNR,U,V,T,P,Q,
792 READ (KDISK0,ERR=840)AEXPX,TAUX,JC,C,RC,KEYNR,U,V,T,P,Q,
793 & ODATA,
794 * GDATA,BLDATA,RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAUY,TSSFC,CKS, 1739.
795 * CKN,WMGE,TPRIM2,MRCHT,TRSURF,SRSURF,TLANDD,TSURFD,DWAV0,
796 * TG3M,RTGO,STG3,DTG3
797 endif
798 if(.not.CONTRR)then
799 JC(16)=JC1(16)
800 C(38)=C1(38)
801 C(39)=C1(39)
802 do i=41,50
803 c print *,i,JC1(i)
804 JC(i)=JC1(i)
805 end do
806 end if
807 c print *,' NCNDS=',NCNDS
808 c print *,' WITH DEEP MIXED LAYER'
809 5001 format(24f5.1)
810 print *,' START OF RUN ', AEXP
811 print *,' INDAY=',INDAY,' IMONTH=',IMONTH
812 print *,' INYEAR=',INYEAR
813 print *,'INITIAL CONDITIONs FROM EXP.=',AEXPX
814 print *,'JDAY=',JDAY,' JDATE=',JDATE,' JMONTH=',JMONTH
815 print *,' JYEAR=',JYEAR
816 AEXPX=AEXP
817 TAU=0.
818 JNDAY=INDAY+JDOFM(IMONTH)
819 IYEAR=INYEAR
820 IDAY=INDAY+JDOFM(IMONTH)
821 TAUI=(IDAY-1)*24.
822 TAU=TAUI
823 TAUX=TAU
824 TAUY=TAU
825 JYEAR=INYEAR
826 JYEAR0=INYEAR
827 #if( !defined OCEAN_3D && !defined ML_2D )
828 if(TRANSR.and..not.CONTRR)then
829 open( unit=575,file=t3file,
830 * status='OLD',form='unformatted')
831 read(575)AEXTG3
832 read(575)TG3M
833 print *,' TG3 from ',AEXTG3
834 do 5368 j=1,JM
835 STG3(1,j)=0.
836 DTG3(1,j)=0.
837 do 5368 k=1,lmo
838 RTGO(1,j,k)=0.
839 5368 continue
840 end if
841 #endif
842
843 #if ( defined CPL_OCEANCO2 && defined ML_2D )
844 if(ocarcont) then
845 if(ocarindata)then
846 print *,'Wrong setting of ocarcont and ocarindata'
847 print *,ocarcont,ocarindata
848 stop
849 endif
850 open(116,file=deepco2in,
851 * status='old',form='unformatted')
852 print *,' AFTER OPEN INIT. data for ocean chem.'
853 print *,deepco2in
854 read(116)iyearocm,vdfocm
855 print *,' iyearocm=',iyearocm
856 print *,'Vertical diffusion coefficeint for carbon=',vdfocm
857 if(iyearocm.ne.JYEAR-1) then
858 print *,'Data for ocean carbon for wrong year'
859 print *,' iyearocm=',iyearocm
860 print *,' JYEAR=',JYEAR
861 stop
862 endif
863 read(116)Hgin
864 read(116)Rco2in
865 do k=1,lmo
866 do j=1,jm0
867 if(k.eq.1)Hg(j)=Hgin(j)
868 Rco2(j,k)=Rco2in(j,k)
869 end do
870 end do
871 else
872 if(ocarindata)then
873 print *,' Reading initial data for ocean carbon'
874 open(116,file=deepco2in,
875 * status='old',form='unformatted')
876 read(116)
877 read(116)Hgin
878 read(116)Rco2in
879 print *,(Rco2in(j,1),j=1,jm)
880 do k=1,lmo
881 do j=1,jm0
882 ! if(k.eq.1)Hg(j)=Hgin(j)
883 if(k.eq.1)Hg(j)=1.0e-8
884 Rco2(j,k)=Rco2in(j,k)
885 end do
886 end do
887 close(116)
888 else
889 do k=1,lmo
890 do j=1,jm0
891 if(k.eq.1)Hg(j)=1.0e-8
892 Rco2(j,k)=0.0
893 end do
894 end do
895 endif
896 endif
897 #endif
898
899 else
900 C *****
901 C FOR ISTRT1 = 1
902 C *******
903 if(TRANSR)then
904 READ (KDISK0,ERR=840)AEXPX,TAUX,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA, 1738.
905 * GDATA,BLDATA,RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAUY,TSSFC,CKS, 1739.
906 * CKN,WMGE,TPRIM2,MRCHT,TRSURF,SRSURF,TLANDD,TSURFD,DWAV0,
907 * TG3M,RTGO,STG3,DTG3
908 else
909 READ (KDISK0,ERR=840)AEXPX,TAUX,JC,C,RC,KEYNR,U,V,T,P,Q,ODATA, 1738.
910 * GDATA,BLDATA,RQT,SRHR,TRHR,(AJ(K,1),K=1,KACC),TAUY,TSSFC,CKS, 1739.
911 * CKN,WMGE,TPRIM2,MRCHT,TRSURF,SRSURF,TLANDD,TSURFD,DWAV0
912 endif
913 C
914 if(abs(AEXPX-AEXP).gt.0.05)then
915 print *,' DISAGREEMENT BETWEEN AEXPX AND AEXP '
916 print *,' FILE ',KDISK0
917 print *,' AEXPX=',AEXPX,' AEXP=',AEXP
918 stop
919 else
920 print *,' RESTART OF EXP. ',AEXP
921 print *,'JDAY=',JDAY,' JDATE=',JDATE,' JMONTH=',JMONTH
922 print *,' JYEAR=',JYEAR
923 endif
924
925 #if ( defined CPL_OCEANCO2 && defined ML_2D )
926
927 print *,' AFTER OPEN INIT. data for ocean chem.'
928 read(369)iyearocm,vdfocm
929 print *,' iyearocm=',iyearocm
930 print *,'Vertical diffusion coefficeint for carbon=',vdfocm
931 if(iyearocm.ne.JYEAR-1) then
932 c if(iyearocm.ne.JYEAR) then
933 print *,'Data for ocean carbon for wrong year'
934 print *,' iyearocm=',iyearocm
935 print *,' JYEAR=',JYEAR
936 stop
937 endif
938 read(369)Hgin
939 read(369)Rco2in
940 print *,(Rco2in(j,1),j=1,jm)
941 do k=1,lmo
942 do j=1,jm0
943 if(k.eq.1)Hg(j)=Hgin(j)
944 Rco2(j,k)=Rco2in(j,k)
945 end do
946 end do
947 #endif
948
949 endif ! endif for ISTRT1
950 #if ( defined CPL_OCEANCO2 && defined ML_2D )
951 print *,'Rco2 from input'
952 ! print *,(Rco2(j,1),j=1,jm)
953 print *,Rco2
954 #endif
955
956 if(KOCEAN.eq.1) then
957 print *,' T1 ocean'
958 print 5001,(ODATA(1,j,1),j=1,JM)
959 print *,' T2 ocean'
960 print 5001,(ODATA(1,j,4),j=1,JM)
961 print *,' T3 ocean'
962 print 5001,(ODATA(1,j,5),j=1,JM)
963 endif
964
965 c if(TRANSR)then
966 c print *,' STG3'
967 c print 5001,(STG3(1,j),j=1,JM)
968 c print *,' DTG3/356'
969 c print 5001,(DTG3(1,j)/365.,j=1,JM)
970 c print *,' RTGO'
971 c print 5001,((RTGO(1,j,k),j=1,JM),k=1,lmo)
972 c endif
973 REWIND KDISK0 1740.
974 ISTART=ISTAR0 1741.
975 KDISK=KDISK0-500 1742.
976 IF(TAUX.NE.TAUY) GO TO 860 1743.
977 DO 451 I=1,33 1744.1
978 451 XLABEL(I)=XLABL1(I) 1744.2
979 TAU=TAUX 1745.
980 TAUP=TAUX 1746.
981 C**** UPDATE C ARRAY FROM INPUTZ 1747.
982 500 READ (514,INPUTZ) 1748.
983 ! nrad=NDYN
984 #if ( defined IPCC_EMI )
985 CO2=xco2init/GHGBGR(1)
986 #endif
987 INYRAD=INYEAR
988 JNDAY=INDAY+JDOFM(IMONTH)
989 WRITE (6,907) KDISK,TAUX,AEXP
990 ITAUX=TAUX
991 NHY=24*365
992 c print *,' NHY=',NHY,' ITAUX=',ITAUX,' IYEAR=',IYEAR
993 IYEARX=ITAUX/NHY+IYEAR
994 c print *,' IYEARX=',IYEARX
995 ITAUX=TAUX-(IYEARX-IYEAR)*NHY
996 c print *,' ITAUX=',ITAUX
997 DO 871 IMNTHX=1,12
998 ITM=ITAUX-JDOFM(IMNTHX)*24
999 IT=ITAUX-JDOFM(IMNTHX+1)*24
1000 if(IT.lt.0)go to 872
1001 871 CONTINUE
1002 872 CONTINUE
1003 c print *,' ITAUX=',ITAUX
1004 c print *,' ITM=',ITM,' IT=',IT
1005 NWR10Y=20*365*24/5
1006 c print *,' NWR10Y=',NWR10Y
1007 IDAYX=ITM/24+1
1008 c print *,' IYEARX=',IYEARX,' IMNTHX=',IMNTHX,' IDAYX=',IDAYX
1009 WRCL=((IYEARX-INYEAR)*365.+(JDOFM(IMNTHX)-JDOFM(IMONTH))
1010 * +IDAYX-INDAY)*24./5.
1011 NWRCL=(WRCL+0.99)
1012 INWR=NWRCL/NWR10Y
1013 NWRCL=NWRCL-NWR10Y*INWR
1014 c print *,' NWRCL=',NWRCL
1015 NWRGHG=(IYEARX-INYEAR)*12.+(IMNTHX-IMONTH)
1016 c print *,' NWRGHG=',NWRGHG
1017 if(CLDFEED)then
1018 open( unit=576,file=tsfile,
1019 * status='OLD',form='unformatted')
1020 read(576)EXPTSF,TSCNTR
1021 print *,TSCNTR,' form EXP=',EXPTSF
1022 ! read(576)EXPTSF
1023 ! print *,' TSURF form EXP=',EXPTSF
1024 read(576)TSURFC,TLANDC
1025 ! read(576)TLANDC
1026 endif
1027 CORSR=1.0
1028 if(KOCEAN.eq.0)then
1029 print *,' fixed SST'
1030 elseif(KOCEAN.eq.1)then
1031 print *,' interactive ocean'
1032 #if( !defined OCEAN_3D && !defined ML_2D )
1033 open( unit=527,file=qffile,
1034 * status='OLD',form='unformatted')
1035 READ (527) ANEXPQ,QFLUX,ZOAV
1036 if(QFCOR)READ (527) CORSR,QFLUX
1037 do 475 j=1,JM
1038 QFLUXT(j)=0.
1039 do 476 n=1,12
1040 QFLUXT(j)=QFLUXT(j)+QFLUX(j,n)/12.
1041 476 continue
1042 475 continue
1043 print *,' Q-flux from EXP=',ANEXPQ
1044 print *,(QFLUXT(J),J=1,JM)
1045 #endif
1046 #if( defined CPL_OCEANCO2 && defined ML_2D )
1047 open( unit=527,file=qffile,
1048 * status='OLD',form='unformatted')
1049 READ (527) ZOAV
1050 print *,'ZOAV for OCM'
1051 #endif
1052 else
1053 print *,' value of KOCEAN is wrong'
1054 stop
1055 endif
1056 NLFR=.NOT.LFR
1057 c PRINT *,' NLFR=',NLFR
1058 if(LFR) then
1059 print *,' with LAND fractions'
1060 print *,' with LAND fractions'
1061 else
1062 print *,' without LAND fractions'
1063 print *,' without LAND fractions'
1064 endif
1065 if(READGHG.eq.2)then
1066 open( unit=569,file=ghg_monthly,
1067 * status='OLD',form='unformatted')
1068 open( unit=679,file=ghg_monthly2,
1069 * status='OLD',form='unformatted')
1070 print *,' GHGs from ',ghg_monthly
1071 if(ISTRT1.eq.1)then
1072 do 369 i=1,NWRGHG
1073 do 369 ii=1,13
1074 read(569)
1075 if(ii.le.3)read(679)
1076 369 continue
1077 endif
1078 endif
1079 if(READGHG.eq.1)then
1080 c open( unit=569,file=dirdat1(1:id1-1)//'ghgsm77',
1081 c * status='OLD',form='unformatted')
1082 open( unit=569,file=ghg_monthly,
1083 * status='OLD',form='unformatted')
1084 open( unit=679,file=ghg_monthly2,
1085 * status='OLD',form='unformatted')
1086 print *,' GHGs from ',ghg_monthly
1087 endif
1088 if(PCLOUD.eq.1)then
1089 print *,' prescribed clouds from GISS GCM'
1090 elseif(abs(PCLOUD-3.).lt.1.5)then
1091 open( unit=585,file=clfile,
1092 * status='OLD',form='unformatted')
1093 print *,' fixed clouds from ',clfile,' for each 5 h.'
1094 if(ISTRT1.eq.1)then
1095 do 367 i=1,NWRCL
1096 read(585)
1097 367 continue
1098 endif
1099 if(PCLOUD.eq.2)then
1100 print *,' fixed MC and SS clouds '
1101 elseif(PCLOUD.eq.3)then
1102 print *,' fixed SS clouds '
1103 print *,' interactive MC clouds new scheme'
1104 elseif(PCLOUD.eq.4)then
1105 print *,' fixed MC clouds '
1106 print *,' interactive SS clouds new scheme'
1107 endif
1108 elseif(PCLOUD.eq.0)then
1109 print *,' interactive clouds new scheme'
1110 elseif(PCLOUD.eq.5)then
1111 print *,' interactive clouds old scheme'
1112 elseif(PCLOUD.eq.6)then
1113 open( unit=528,file=clfile,
1114 * status='OLD',form='unformatted')
1115 read (528) EXPCL,cldssm,cldmcm
1116 print *,' fixed clouds form EXP=',EXPCL
1117 else
1118 print *,' CLOUDS ARE NOT ASSIGNED'
1119 stop
1120 endif
1121 if(WRCLD)then
1122 if(ISTWRC.eq.0)then
1123 open( unit=581,file=wrcldf,
1124 * status='new',form='unformatted')
1125 else
1126 open( unit=581,file=wrcldf,
1127 * status='old',form='unformatted')
1128 do 368 i=1,NWRCL
1129 read(581)
1130 368 continue
1131 endif
1132 endif
1133 TAUE=((LYEAR-IYEAR)*365.+(JDOFM(LMONTH)-JDOFM(IMONTH))+
1134 * LDAY-INDAY)*24.+TAUI
1135 if(ISTART.eq.2)then
1136 TAUE=8017.
1137 if(KOCEAN.eq.1)then
1138 print *,' SST is not assined'
1139 stop
1140 endif
1141 endif
1142 REWIND 514 1749.
1143 close (514)
1144 IF (TAU.LT.TAUP-.06125) GO TO 900 1750.
1145 IF(USET.LE.0.) GO TO 600 1751.
1146 C**** REPOSITION THE OUTPUT TAPE ON UNIT 20 FOR RESTARTING 1752.
1147 IF(TAU.LE.TAUO+.06125) GO TO 600 1753.
1148 520 READ (520,ERR=870,END=880) TAUZ 1754.
1149 IF(TAU.GE.TAUZ+USET-.06125) GO TO 520 1755.
1150 WRITE (6,908) TAUZ 1756.
1151 C**** 1757.
1152 C**** CONSTANT ARRAYS TO BE CALCULATED OR READ IN EACH RUN 1758.
1153 C**** 1759.
1154 C**** CALCULATE SPHERICAL GEOMETRY 1760.
1155 600 continue
1156 TWOPI=8.*atan(1.)
1157 TWOPI=6.283185 1549.
1158 DLON=TWOPI/float(IM)
1159 DLAT=.5*TWOPI/float(JM-1)
1160 LAT(1)=-.25*TWOPI 1761.
1161 LAT(JM)=-LAT(1) 1762.
1162 SINP(1)=-1. 1763.
1163 SINP(JM)=1. 1764.
1164 COSP(1)=0. 1765.
1165 COSP(JM)=0. 1766.
1166 DXP(1)=0. 1767.
1167 DXP(JM)=0. 1768.
1168 DO 620 J=2,JMM1 1769.
1169 LAT(J)=LAT(J-1)+DLAT 1770.
1170 SINP(J)=SIN(LAT(J)) 1771.
1171 COSP(J)=COS(LAT(J)) 1772.
1172 620 DXP(J)=RADIUS*DLON*COSP(J) 1773.
1173 c print *,(360./TWOPI*acos(COSP(J)),J=1,JM)
1174 c print *,' COSP'
1175 c print *,(COSP(J),J=1,JM)
1176 DO 640 J=2,JM 1774.
1177 COSV(J)=.5*(COSP(J-1)+COSP(J)) 1775.
1178 DXV(J)=.5*(DXP(J-1)+DXP(J)) 1776.
1179 640 DYV(J)=RADIUS*(LAT(J)-LAT(J-1)) 1777.
1180 c print *,' DXV(JM/2+1)=',DXV(JM/2+1)
1181 COSV(JM/2+1)=1.
1182 DXV(JM/2+1)=RADIUS*DLON
1183 c print *,' DXV(JM/2+1)=',DXV(JM/2+1)
1184 print *,' YV'
1185 print *,(360./TWOPI*acos(COSV(J)),J=2,JM)
1186 print *,' YP'
1187 print *,(360./TWOPI*acos(COSP(J)),J=1,JM)
1188 c print *,' COSV'
1189 c print *,(COSV(J),J=2,JM)
1190 DYP(1)=.5*DYV(2) 1778.
1191 DYP(JM)=.5*DYV(JM) 1779.
1192 DXYP(1)=.5*DXV(2)*DYP(1) 1780.
1193 DXYP(JM)=.5*DXV(JM)*DYP(JM) 1781.
1194 DXYS(1)=0. 1782.
1195 DXYS(JM)=DXYP(JM) 1783.
1196 DXYN(1)=DXYP(1) 1784.
1197 DXYN(JM)=0. 1785.
1198 AREAG=DXYP(1)+DXYP(JM) 1786.
1199 DO 660 J=2,JMM1 1787.
1200 DYP(J)=.5*(DYV(J)+DYV(J+1)) 1788.
1201 DXYP(J)=.5*(DXV(J)+DXV(J+1))*DYP(J) 1789.
1202 DXYS(J)=.5*DXYP(J) 1790.
1203 DXYN(J)=.5*DXYP(J) 1791.
1204 660 AREAG=AREAG+DXYP(J) 1792.
1205 print *,' DXYP'
1206 print *,(DXYP(J),J=1,JM)
1207 SS=0.
1208 SN=0.
1209 do 578 j=1,12
1210 SS=SS+DXYP(j)/(RADIUS**2*DLON*DLAT)
1211 SN=SN+DXYP(j+12)/(RADIUS**2*DLON*DLAT)
1212 578 continue
1213 ATMMASS=(ss+sn)*984.*100./9.81
1214 AREAG=AREAG*FIM 1793.
1215 RAVPS(1)=0. 1794.
1216 RAVPN(JM)=0. 1795.
1217 DO 680 J=2,JM 1796.
1218 DXYV(J)=DXYN(J-1)+DXYS(J) 1797.
1219 RAPVS(J)=.5*DXYS(J)/DXYV(J) 1798.
1220 RAPVN(J-1)=.5*DXYN(J-1)/DXYV(J) 1799.
1221 RAVPS(J)=.5*DXYS(J)/DXYP(J) 1800.
1222 680 RAVPN(J-1)=.5*DXYN(J-1)/DXYP(J-1) 1801.
1223 cprint *,DXP(1),DXP(2),DXV(2)
1224 C**** CALCULATE CORIOLIS PARAMETER 1802.
1225 OMEGA=TWOPI*(EDPERD+EDPERY)/(EDPERD*EDPERY*SDAY) 1803.
1226 F(1)=-RADIUS*OMEGA*.5*COSP(2)*DXV(2) 1804.
1227 F(JM)=-F(1) 1805.
1228 DO 720 J=2,JMM1 1806.
1229 720 F(J)=OMEGA*(DXV(J)*DXV(J)-DXV(J+1)*DXV(J+1))/DLON 1807.
1230 C**** CALCULATE DSIG AND DSIGO 1808.
1231 DO 740 L=1,LM 1809.
1232 740 DSIG(L)=SIGE(L)-SIGE(L+1) 1810.
1233 DO 760 L=1,LMM1 1811.
1234 760 DSIGO(L)=SIG(L)-SIG(L+1) 1812.
1235
1236 #if ( defined CPL_CHEM )
1237 !
1238 ! --- Calculate air mass, First step
1239 ! --- (need to time surface pressure p(i,j) :
1240 !
1241 i=1
1242 do 112 k=1,nlev
1243 do 112 j=1,nlat
1244 airmass0(i,j,k)=dsig(k)*dxyp(j)*100.
1245 & /grav
1246 112 continue
1247
1248 ! open(122,file='airmass0.dat',form='unformatted',
1249 ! & status='unknown')
1250 ! write(122)airmass0
1251 ! stop
1252 !
1253 #endif
1254
1255 C**** READ IN FDATA: PHIS, PLAND AND RLICE 1813.
1256 READ (526) FDATA 1814.
1257 REWIND 526 1815.
1258 print *,' NLFR=',NLFR,' IO=',IO
1259 DO 283 J=1,JM 1815.5
1260 DO 283 I=1,IO 1815.51
1261 FDATA(I,J,1)=0.
1262 #if ( defined ML_2D)
1263 if(FDATA(I,J,2).ge.0.94)then
1264 FDATA(I,J,2)=1.00
1265 endif
1266 #endif
1267 C3LICE(I,J)=FDATA(I,J,2)*FDATA(I,J,3) 1815.52
1268 C3LAND(I,J)=FDATA(I,J,2) 1815.53
1269 if(NLFR)FDATA(I,J,2)=0. 1815.54
1270 283 continue
1271 do 284 J=1,JM
1272 ILAND=0.
1273 IICE=0.
1274 CONT1=0.
1275 CONT2=0.
1276 do 285 I=1,IO
1277 PLAND=FDATA(I,J,2)
1278 PICE=FDATA(I,J,3)
1279 CONT1=CONT1+PLAND
1280 CONT2=CONT2+PICE
1281 ILAND=ILAND+1
1282 IF(PLAND.GT.0.)IICE=IICE+1
1283 285 continue
1284 do 286 I=1,IO
1285 IF(ILAND.GT.0)FDATA(I,J,2)=CONT1/ILAND
1286 c IF(FDATA(I,J,2).LT.0.01)FDATA(I,J,2)=0.
1287 IF(IICE.GT.0)FDATA(I,J,3)=CONT2/IICE
1288 286 continue
1289 fland_temp(j)=FDATA(1,J,2)
1290 284 continue
1291 #if( defined OCEAN_3D)
1292 Cjrs if(jmocean.ne.jm0-2)then
1293 C print *,"Wrong jm or jmocean"
1294 C stop
1295 C endif
1296 OCNGEOM=.false.
1297 print *,'With land/ocean fractions directly from 3D ocean model'
1298 print *,cflan
1299 do i=1,IO
1300 CJRS FDATA(I,1,2)=cflan(1)
1301 C do j=2,jm0-1
1302 C FDATA(I,J,2)=cflan(j-1)
1303 C enddo
1304 do j=1,jm0
1305 FDATA(I,J,2)=cflan(j)
1306 enddo
1307 CJRS FDATA(I,JM0,2)=cflan(jmocean)
1308 enddo
1309 do j=1,jm0
1310 fland_atm(j)=FDATA(1,J,2)
1311 enddo
1312 if(ISTRT1.eq.0)then
1313 open (505,file=ocndata4atm,form='unformatted',
1314 & status='new')
1315 else
1316 open (505,file=ocndata4atm,form='unformatted',
1317 & status='old')
1318 endif
1319 #else
1320 if(OCNGEOM)then
1321 print *,'With land/ocean fractions as in 3D ocean model'
1322 open (626,file=ocngmfile,
1323 & status='old')
1324 do j=1,jm0
1325 read (626,*),iii,fo3d
1326 print *,360./TWOPI*acos(COSP(J)),fo3d
1327 do i=1,IO
1328 FDATA(I,J,2)=1.0-fo3d
1329 enddo
1330 enddo
1331 endif
1332 #endif
1333 #if ( defined CLM )
1334 open (767,file=fclmlice,status='old')
1335 do j=1,jm
1336 read(767,*),clmlice(j)
1337 FDATA(1,J,3)=0.01*clmlice(j)
1338 enddo
1339 close (767)
1340 open (767,file=fbaresoil,status='old')
1341 do j=1,jm
1342 read(767,*),baresoil(j),baresoil(j)
1343 enddo
1344 close (767)
1345 open (767,file=fwmax,status='old')
1346 read (767,*),lineclm
1347 read(767,*),(w1maxclm(j),j=1,jm)
1348 read (767,*),lineclm
1349 read(767,*),(w2maxclm(j),j=1,jm)
1350 read (767,*),lineclm
1351 read(767,*),(vmaskclm(j),j=jm,1,-1)
1352 close (767)
1353 ! open (767,file=fprratio,status='old')
1354 ! do j=1,jm
1355 ! read(767,*),(prlnd2total(j,n),n=1,12)
1356 ! enddo
1357 ! close (767)
1358 #else
1359 ! do j=1,jm
1360 ! do n=1,12
1361 ! prlnd2total(j,n)=1.0
1362 ! enddo
1363 ! enddo
1364 #endif
1365 open (767,file=fprratio,status='old')
1366 do j=1,jm
1367 read(767,*),(prlnd2total(j,n),n=1,12)
1368 enddo
1369 close (767)
1370 print *,'Ratio of land precipitation to total'
1371 do j=1,jm
1372 print('12f7.4'),(prlnd2total(j,n),n=1,12)
1373 enddo
1374 print *,' FDATA(1,J,2)='
1375 print *,(FDATA(1,J,2),J=1,JM)
1376 print *,' FDATA(1,J,3)='
1377 print *,(FDATA(1,J,3),J=1,JM)
1378
1379 #if( !defined OCEAN_3D)
1380 C**** READ IN MAXIMUM MIXED LAYER DEPTHS FOR PREDICTED OCEAN RUNS 1815.6
1381 IF(KOCEAN.NE.1) GO TO 764 1815.61
1382 READ (525) Z12O 1815.62
1383 REWIND 525 1815.63
1384 DO 628 J=1,JM 1815.641
1385 SUM2=0. 1815.643
1386 CONT1=0. 1815.644
1387 DO 626 I=1,IO 1815.645
1388 PWATER=1.-C3LAND(I,J) 1815.647
1389 IF(PWATER.LE.0.) GO TO 626 1815.648
1390 CONT1=CONT1+PWATER 1815.649
1391 SUM2=SUM2+Z12O(I,J)*PWATER 1815.651
1392 626 CONTINUE 1815.652
1393 IF(CONT1.LE.0.) GO TO 628 1815.653
1394 IF(J.EQ.1.OR.J.EQ.JM) GO TO 628 1815.654
1395 SUM2=SUM2/CONT1 1815.656
1396 DO 627 I=1,IO 1815.657
1397 627 Z12O(I,J)=SUM2 1815.659
1398 628 CONTINUE 1815.66
1399 DO 629 J=1,2 1815.661
1400 DO 629 I=1,IO 1815.662
1401 629 Z12O(I,J)=Z12O(I,3) 1815.664
1402 764 CONTINUE
1403 #endif
1404
1405 C**** READ IN EARTH RATIOS FOR THE 8 VEGETATION TYPES AND THE VADATA : 1816.
1406 C VADATA(TYPE,SEASON,1)=GROUND ALBEDO FOR A GIVEN TYPE AND SEASON 1817.
1407 C 1 2 3 4 5 6 7 8 1818.
1408 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF 1819.
1409 C SPRN 0.35, 0.12, 0.16, 0.16, 0.14, 0.18, 0.12, 0.11, 1820.
1410 C SUMR 0.35, 0.12, 0.20, 0.18, 0.14, 0.12, 0.12, 0.11, 1821.
1411 C FALL 0.35, 0.17, 0.20, 0.25, 0.17, 0.15, 0.15, 0.11, 1822.
1412 C WNTR 0.35, 0.15, 0.18, 0.20, 0.12, 0.12, 0.11, 0.11/ 1823.
1413 C 1824.
1414 C VADATA(TYPE,SEASON,2)=RATIO OF NEAR IR ALBEDO TO VIS ALBEDO FOR...1825.
1415 C 1 2 3 4 5 6 7 8 1826.
1416 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF 1827.
1417 C SPRN 1.0, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 1828.
1418 C SUMR 1.0, 3.3, 3.5, 3.0, 3.3, 4.0, 3.0, 3.0, 1829.
1419 C FALL 1.0, 3.5, 4.0, 3.0, 3.5, 5.0, 3.0, 3.0, 1830.
1420 C WNTR 1.0, 3.2, 3.5, 3.0, 3.2, 4.0, 3.0, 3.0/ 1831.
1421 C 1832.
1422 C VADATA(TYPE,1,3)=MASKING DEPTH FOR A GIVEN TYPE 1833.
1423 C 1834.
1424 C 1 2 3 4 5 6 7 8 1835.
1425 C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF 1836.
1426 C 10., 20., 20., 50., 200., 500., 1000., 2500., 1837.
1427 C 1838.
1428 C VADATA(TYPE,1+K,3)=WATER FIELD CAPACITY FOR K-TH GROUND LAYER 1839.
1429 C 1840.
1430 C 1 10., 30., 30., 30., 30., 30., 30., 200., 1841.
1431 C 2 10., 200., 200., 300., 300., 450., 450., 450., 1842.
1432 C (3) 0., 0., 0., 0., 0., 0., 0., 0./ 1843.
1433 C 1844.
1434 #if ( !defined CLM )
1435 if(VEGCH.or.TRVEG)then
1436 READ(523) IYVEG
1437 c if(.not.TRVEG)then
1438 print *,'VDATA for year=',iyveg
1439 c endif
1440 IYVEGIN=IYVEG
1441 endif
1442 READ (523) (((VDATA(I,J,K),I=1,IO),J=1,JM),K=1,8), 1845.
1443 * (((VADATA(I,J,K),I=1,8),J=1,4),K=1,3) 1845.1
1444 print *,'VADATA'
1445 do k=1,3
1446 print *,' K=',k
1447 print '(8f7.2)',((VADATA(I,J,K),I=1,8),J=1,4)
1448 enddo
1449 if(ISTRT1.eq.1.and.TRVEG)then
1450 print *,'Restart with TRVEG'
1451 if(JYEAR.le.1992)then
1452 JYEARV=JYEAR
1453 else
1454 JYEARV=1992
1455 print *,' End of vegfile has been reached'
1456 print *,' VDATA for year 1992 are used for the rest of run'
1457 endif
1458 do ii=IYVEGIN,JYEARV-1
1459 READ(523) IYVEG
1460 READ (523) (((VDATA(I,J,K),I=1,IO),J=1,JM),K=1,8)
1461 enddo
1462 if(IYVEG.ne.JYEARV)then
1463 print *,' Wrong IYVEG'
1464 print *,' IYVEG=',IYVEG,' JYEARV=',JYEARV
1465 stop
1466 endif
1467 print *,'VDATA for year=',JYEARV
1468 endif
1469 c REWIND 523 1846.
1470 C**** MODIFY THE VADATA IF DESIRED 1847.
1471 C NO MODIFICATIONS 1848.
1472 C**** COMPUTE WATER FIELD CAPACITIES FOR GROUND LAYERS 1 AND 2 1849.
1473 IOFF=0 1849.1
1474 IF(VADATA(4,2,3).LT.100.) IOFF=1 1849.2
1475 ERROR=.001 1849.3
1476 DEFLT=24. 1850.
1477 DO 785 L=1,2 1851.
1478 DO 780 J=1,JM 1852.
1479 DO 780 I=1,IO 1853.
1480 WFCIJL=0. 1854.
1481 DO 770 K=1,8 1855.
1482 770 WFCIJL=WFCIJL+VDATA(I,J,K)*VADATA(K,L+IOFF,3) 1856.
1483 IF (WFCIJL.LT.1.) WFCIJL=DEFLT 1857.
1484 IF(ISTART.NE.2) GO TO 780
1485 IF(GDATA(I,J,4*L+1)+GDATA(I,J,4*L+2).LE.WFCIJL) GO TO 780 1858.
1486 X=WFCIJL/(GDATA(I,J,4*L+1)+GDATA(I,J,4*L+2)+1.E-3) 1859.
1487 GDATA(I,J,4*L+1)=GDATA(I,J,4*L+1)*X 1860.
1488 GDATA(I,J,4*L+2)=GDATA(I,J,4*L+2)*X 1861.
1489 780 VDATA(I,J,L+8)=WFCIJL 1862.
1490 DEFLT=60. 1863.
1491 785 CONTINUE 1864.
1492 DO 765 K=1,10 1864.5
1493 DO 765 J=2,JMM1 1864.51
1494 CONT1=0. 1864.52
1495 SUM1=0. 1864.53
1496 DO 766 I=1,IO 1864.54
1497 PEARTH=C3LAND(I,J)-C3LICE(I,J) 1864.55
1498 CONT1=CONT1+PEARTH 1864.56
1499 766 SUM1=SUM1+PEARTH*VDATA(I,J,K) 1864.57
1500 IF (CONT1.LE.0.) GO TO 765 1864.58
1501 SUM1=SUM1/CONT1 1864.59
1502 DO 767 I=1,IO 1864.6
1503 767 VDATA(I,J,K)=SUM1 1864.61
1504 765 CONTINUE 1864.62
1505 c print *,' BEAR LAND'
1506 c print '(12f7.2,/,11f7.2)',(VDATA(1,j,1),j=1,JM)
1507 print *,' INPUT'
1508 print *,' WMAX1'
1509 print '(12f7.2,/,11f7.2)',(VDATA(1,j,9),j=1,JM)
1510 print *,' WMAX2'
1511 print '(12f7.2,/,11f7.2)',(VDATA(1,j,10),j=1,JM)
1512 C *************
1513 print *,'Vadata'
1514 print '(8f7.2)',(VADATA(K,4,3),K=1,8)
1515 DO K=1,8
1516 c VADATA(K,4,3)=0.1*VADATA(K,4,3)
1517 VADATA(K,4,3)=VADATA(K,3,3)
1518 ENDDO
1519 print '(8f7.2)',(VADATA(K,4,3),K=1,8)
1520 DO J=1,JM
1521 CONT1=0.
1522 SUM1=0.
1523 DO I=1,IO
1524 WFCIJL=0.
1525 PEARTH=C3LAND(I,J)-C3LICE(I,J)
1526 CONT1=CONT1+PEARTH
1527 c SUM1=SUM1+PEARTH*WFCIJL
1528 DO K=1,8
1529 WFCIJL=WFCIJL+VDATA(I,J,K)*VADATA(K,4,3)
1530 ENDDO ! K
1531 SUM1=SUM1+PEARTH*WFCIJL
1532 ENDDO ! I
1533 IF (CONT1.LE.0.) GO TO 865
1534 SUM1=SUM1/CONT1
1535 VMASK(J)=SUM1
1536 865 CONTINUE
1537 ENDDO ! J
1538 print *,' VMASK form NP to SP in meters of water'
1539 print '(12f7.2,/11f7.2)',(VMASK(jm-j+1),j=1,JM)
1540 C ************
1541 #else
1542 READ (523) (((VDATA(I,J,K),I=1,IO),J=1,JM),K=1,8), 1845.
1543 * (((VADATA(I,J,K),I=1,8),J=1,4),K=1,3) 1845.1
1544 print *,'VADATA'
1545 do k=1,3
1546 print *,' K=',k
1547 print '(8f7.2)',((VADATA(I,J,K),I=1,8),J=1,4)
1548 enddo
1549 do j=1,jm
1550 VDATA(1,j,1)=0.01*baresoil(j)
1551 VDATA(1,j,2)=1.-0.01*baresoil(j)
1552 do k=3,8
1553 VDATA(1,j,k)=0.0
1554 enddo
1555 VDATA(1,j,9)=w1maxclm(j)
1556 VDATA(1,j,10)=w2maxclm(j)
1557 enddo
1558 print *,'Vadata'
1559 print '(8f7.2)',(VADATA(K,4,3),K=1,8)
1560 DO K=1,8
1561 c VADATA(K,4,3)=0.1*VADATA(K,4,3)
1562 VADATA(K,4,3)=VADATA(K,3,3)
1563 ENDDO
1564 print '(8f7.2)',(VADATA(K,4,3),K=1,8)
1565 #endif
1566
1567 CALL RINIT (IRAND) 1865.
1568 C CALL IJSET (IM,JM,FDATA(1,1,2)) 1866.
1569 WRITE (6,INPUTZ) 1867.
1570 C information for main program
1571 AEXPA=AEXP
1572 INDAYA=INDAY
1573 IMONTHA=IMONTH
1574 INYEARA=INYEAR
1575 LDAYA=LDAY
1576 LMONTHA=LMONTH
1577 LYEARA=LYEAR
1578 IYEARA=JYEAR
1579 IRESTART=ISTRT1
1580 RETURN 1868.
1581 C**** 1869.
1582 C**** TERMINATE BECAUSE OF IMPROPER PICK-UP 1870.
1583 C**** 1871.
1584 800 WRITE (6,910) ISTART 1872.
1585 STOP 3 1873.
1586 810 WRITE (6,911) TAUP,TAUX 1874.
1587 STOP 3 1875.
1588 820 WRITE (6,912) TAUP,TAUX 1876.
1589 STOP 3 1877.
1590 830 WRITE (6,913) 1878.
1591 STOP 3 1879.
1592 840 IF(3-KDISK.EQ.KLAST) GO TO 850 1880.
1593 REWIND KDISK 1881.
1594 KLAST=KDISK 1882.
1595 KDISK=3-KDISK 1883.
1596 WRITE (6,914) KLAST,KDISK 1884.
1597 GO TO 450 1885.
1598 850 WRITE (6,915) 1886.
1599 STOP 3 1887.
1600 860 WRITE (6,916) TAUX,TAUY 1888.
1601 STOP 3 1889.
1602 870 WRITE (6,917) TAUZ,TAU 1890.
1603 STOP 3 1891.
1604 880 WRITE (6,918) TAUZ,TAU 1892.
1605 STOP 3 1893.
1606 890 WRITE (6,919) ISTART 1894.
1607 STOP 3 1895.
1608 900 WRITE (6,920) TAUP,TAU 1896.
1609 STOP 3 1897.
1610 C**** 1898.
1611 901 FORMAT ('0',40X,'GISS N LAYER WEATHER MODEL'/) 1899.
1612 902 FORMAT (20A4/11A4,A2,30X,A4) 1900.
1613 903 FORMAT ('0',31A4,A3,A4/) 1901.
1614 904 FORMAT (10A12) 1902.
1615 905 FORMAT (35X,10A12) 1903.
1616 906 FORMAT ('0ATMOSPHERIC I.C. ISTART,TAUX=',I4,F10.2,3X,20A4) 1904.
1617 907 FORMAT ('0RESTART DISK READ ON UNIT',I2,', TAUX=',F9.2,'AEXP=',
1618 * F9.2,/,3X,20A4,A6) 1905.
1619 908 FORMAT ('0OUTPUT TAPE REPOSITIONED. LAST TAU READ WAS',F9.2) 1906.
1620 910 FORMAT ('0ERROR ENCOUNTERED READING I.C. ON UNIT 9. ISTART=',I4) 1907.
1621 911 FORMAT ('0EOF ON UNIT 9. LATER I.C. NEEDED. TAUP,TAUX=',2F10.2) 1908.
1622 912 FORMAT ('0EARLIER I.C. NEEDED ON UNIT 9. TAUP,TAUX=',2F10.2) 1909.
1623 913 FORMAT ('0ERROR ENCOUNTERED READING GROUND CONDITIONS ON UNIT 7.')1910.
1624 914 FORMAT ('0ERROR ENCOUNTERED READING RESTART TAPE ON UNIT',I3/, 1911.
1625 * ' TRY TO RESTART THE JOB WITH ISTART=3,KDISK=',I1) 1912.
1626 915 FORMAT ('0ERRORS ON BOTH RESTART DATA SETS.') 1913.
1627 916 FORMAT ('0TAUX,TAUY=',2F10.2/'0DISK RESTART FILE DESTROYED, TRY T 1914.
1628 * RESTART THE JOB WITH ISTART=99, OR TERMINATE THE JOB.') 1915.
1629 917 FORMAT ('0ERROR ENCOUNTERED REPOSITIONING TAPE ON UNIT 27. TAUZ,T1916.
1630 *AU=',2F10.2) 1917.
1631 918 FORMAT ('0EOF ON UNIT 20 WHILE REPOSITIONING TAPE. TAUZ,TAU=', 1918.
1632 * 2F10.2) 1919.
1633 919 FORMAT ('0INCORRECT VALUE OF ISTART',I5) 1920.
1634 920 FORMAT ('0PREVIOUS TAUE=',F10.2,' WAS NOT YET REACHED. TAU=', 1921.
1635 * F10.2,' RESUBMIT THE JOB WITH AN EARLIER TAUE CARD') 1922.
1636 END 1923.

  ViewVC Help
Powered by ViewVC 1.1.22