/[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.6 - (hide annotations) (download)
Wed Oct 17 21:07:21 2007 UTC (17 years, 9 months ago) by jscott
Branch: MAIN
Changes since 1.5: +2 -2 lines
do pov_nep write in atmos library code to avoid endian problem

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

  ViewVC Help
Powered by ViewVC 1.1.22