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