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

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

  ViewVC Help
Powered by ViewVC 1.1.22