/[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.3 - (hide annotations) (download)
Mon Apr 23 21:20:18 2007 UTC (18 years, 3 months ago) by jscott
Branch: MAIN
Changes since 1.2: +103 -101 lines
bring igsm atmos code up to date

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

  ViewVC Help
Powered by ViewVC 1.1.22