/[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.5 - (show annotations) (download)
Mon Oct 15 15:03:55 2007 UTC (17 years, 9 months ago) by jscott
Branch: MAIN
Changes since 1.4: +13 -7 lines
changes to file I/O in conjunction with forward_step_atm2d edits

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

  ViewVC Help
Powered by ViewVC 1.1.22