/[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.8 - (show annotations) (download)
Thu Sep 17 15:48:38 2009 UTC (15 years, 10 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.7: +15 -18 lines
new routine for reading in eppa emissions

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

  ViewVC Help
Powered by ViewVC 1.1.22