/[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.7 - (show annotations) (download)
Tue Sep 1 22:03:56 2009 UTC (15 years, 10 months ago) by jscott
Branch: MAIN
Changes since 1.6: +17 -3 lines
add changes for stochastic precip

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

  ViewVC Help
Powered by ViewVC 1.1.22