/[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.1 - (hide annotations) (download)
Fri Aug 11 19:35:31 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
atm2d package

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

  ViewVC Help
Powered by ViewVC 1.1.22