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

  ViewVC Help
Powered by ViewVC 1.1.22