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

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

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


Revision 1.8 - (hide annotations) (download)
Thu Sep 17 15:48:38 2009 UTC (15 years, 10 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.7: +15 -18 lines
new routine for reading in eppa emissions

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

  ViewVC Help
Powered by ViewVC 1.1.22