77 subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc &
78 &, iy,im,id,ih,fh,rla,rlo &
79 &, slmskl,slmskw,orog,orog_uf,use_ufo,nst_anl &
80 &, sihfcs,sicfcs,sitfcs &
82 &, vmnfcs,vmxfcs,slpfcs,absfcs &
83 &, tsffcs,snofcs,zorfcs,albfcs,tg3fcs &
84 &, cnpfcs,smcfcs,stcfcs,slifcs,aisfcs &
85 &, vegfcs,vetfcs,sotfcs,socfcs,alffcs &
86 &, cvfcs,cvbfcs,cvtfcs,me,nthrds,nlunit &
87 &, sz_nml,input_nml_file &
89 &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index)
91 use machine ,
only : kind_io8,kind_io4
94 character(len=*),
intent(in) :: tile_num_ch
95 integer,
intent(in) :: i_index(len), j_index(len), &
97 logical,
intent(in) :: use_ufo, nst_anl
98 real (kind=kind_io8),
intent(in) :: min_ice(len)
100 real (kind=kind_io8) sllnd,slsea,aicice,aicsea,tgice,rlapse, &
101 & orolmx,orolmn,oroomx,oroomn,orosmx, &
102 & orosmn,oroimx,oroimn,orojmx,orojmn, &
103 & alblmx,alblmn,albomx,albomn,albsmx, &
104 & albsmn,albimx,albimn,albjmx,albjmn, &
105 & wetlmx,wetlmn,wetomx,wetomn,wetsmx, &
106 & wetsmn,wetimx,wetimn,wetjmx,wetjmn, &
107 & snolmx,snolmn,snoomx,snoomn,snosmx, &
108 & snosmn,snoimx,snoimn,snojmx,snojmn, &
109 & zorlmx,zorlmn,zoromx,zoromn,zorsmx, &
110 & zorsmn,zorimx,zorimn,zorjmx,zorjmn, &
111 & plrlmx,plrlmn,plromx,plromn,plrsmx, &
112 & plrsmn,plrimx,plrimn,plrjmx,plrjmn, &
113 & tsflmx,tsflmn,tsfomx,tsfomn,tsfsmx, &
114 & tsfsmn,tsfimx,tsfimn,tsfjmx,tsfjmn, &
115 & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3smx, &
116 & tg3smn,tg3imx,tg3imn,tg3jmx,tg3jmn, &
117 & stclmx,stclmn,stcomx,stcomn,stcsmx, &
118 & stcsmn,stcimx,stcimn,stcjmx,stcjmn, &
119 & smclmx,smclmn,smcomx,smcomn,smcsmx, &
120 & smcsmn,smcimx,smcimn,smcjmx,smcjmn, &
121 & scvlmx,scvlmn,scvomx,scvomn,scvsmx, &
122 & scvsmn,scvimx,scvimn,scvjmx,scvjmn, &
123 & veglmx,veglmn,vegomx,vegomn,vegsmx, &
124 & vegsmn,vegimx,vegimn,vegjmx,vegjmn, &
125 & vetlmx,vetlmn,vetomx,vetomn,vetsmx, &
126 & vetsmn,vetimx,vetimn,vetjmx,vetjmn, &
127 & sotlmx,sotlmn,sotomx,sotomn,sotsmx, &
128 & sotsmn,sotimx,sotimn,sotjmx,sotjmn, &
129 & soclmx,soclmn,socomx,socomn,socsmx, &
130 & socsmn,socimx,socimn,socjmx,socjmn, &
131 & alslmx,alslmn,alsomx,alsomn,alssmx, &
132 & alssmn,alsimx,alsimn,alsjmx,alsjmn, &
133 & epstsf,epsalb,epssno,epswet,epszor, &
134 & epsplr,epsoro,epssmc,epsscv,eptsfc, &
135 & epstg3,epsais,epsacn,epsveg,epsvet, &
136 & epssot,epssoc,epsalf,qctsfs,qcsnos,qctsfi, &
137 & aislim,snwmin,snwmax,cplrl,cplrs, &
138 & cvegl,czors,csnol,csnos,czorl,csots, &
139 & csotl,csocs,csocl,cvwgs,cvetl,cvets,calfs, &
140 & fcalfl,fcalfs,ccvt,ccnp,ccv,ccvb, &
141 & calbl,calfl,calbs,ctsfs,grboro, &
142 & grbmsk,ctsfl,deltf,caisl,caiss, &
143 & fsalfl,fsalfs,flalfs,falbl,ftsfl, &
144 & ftsfs,fzorl,fzors,fplrl,fsnos,faisl, &
145 & faiss,fsnol,bltmsk,falbs,cvegs,percrit, &
146 & deltsfc,critp2,critp3,blnmsk,critp1, &
147 & fcplrl,fcplrs,fczors,fvets,fsotl,fsots, &
149 & fvetl,fplrs,fvegl,fvegs,fcsnol,fcsnos, &
150 & fczorl,fcalbs,fctsfl,fctsfs,fcalbl, &
151 & falfs,falfl,fh,crit,zsca,ztsfc,tem1,tem2 &
152 &, fsihl,fsihs,fsicl,fsics, &
153 & csihl,csihs,csicl,csics,epssih,epssic &
154 &, fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps, &
155 & fabsl,fabss,cvmnl,cvmns,cvmxl,cvmxs, &
156 & cslpl,cslps,cabsl,cabss,epsvmn,epsvmx, &
158 &, sihlmx,sihlmn,sihomx,sihomn,sihsmx, &
159 & sihsmn,sihimx,sihimn,sihjmx,sihjmn, &
160 & siclmx,siclmn,sicomx,sicomn,sicsmx, &
161 & sicsmn,sicimx,sicimn,sicjmx,sicjmn &
163 &, vmnlmx,vmnlmn,vmnomx,vmnomn,vmnsmx, &
164 & vmnsmn,vmnimx,vmnimn,vmnjmx,vmnjmn, &
165 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmxsmx, &
166 & vmxsmn,vmximx,vmximn,vmxjmx,vmxjmn, &
167 & slplmx,slplmn,slpomx,slpomn,slpsmx, &
168 & slpsmn,slpimx,slpimn,slpjmx,slpjmn, &
169 & abslmx,abslmn,absomx,absomn,abssmx, &
170 & abssmn,absimx,absimn,absjmx,absjmn &
173 integer imsk,jmsk,ifp,irtscv,irtacn,irtais,irtsno,irtzor, &
174 & irtalb,irtsot,irtsoc,irtalf,j,irtvet,irtsmc,irtstc,irtveg,&
175 & irtwet,k,iprnt,kk,irttsf,iret,i,igrdbg,iy,im,id, &
176 & icalbl,icalbs,icalfl,ictsfs,lugb,len,lsoil,ih, &
177 & ictsfl,iczors,icplrl,icplrs,iczorl,icalfs,icsnol, &
178 & icsnos,irttg3,kqcm,nlunit,sz_nml,ialb &
179 &, irtvmn, irtvmx, irtslp, irtabs, isot, ivegsrc
180 logical gausm, deads, qcmsk, znlst, monclm, monanl, &
181 & monfcs, monmer, mondif, landice
182 character(len=*),
intent(in) :: input_nml_file(sz_nml)
263 parameter(sllnd =1.0,slsea =0.0)
264 parameter(aicice=1.0,aicsea=0.0)
265 parameter(tgice=271.2)
266 parameter(rlapse=0.65e-2)
281 parameter(orolmx=8000.,orolmn=-1000.,oroomx=3000.,oroomn=-1000.,
282 & orosmx=8000.,orosmn=-1000.,oroimx=3000.,oroimn=-1000.,
283 & orojmx=3000.,orojmn=-1000.)
294 parameter(albomx=0.06,albomn=0.06,
295 & albimx=0.80,albimn=0.06,
296 & albjmx=0.80,albjmn=0.06)
297 parameter(sihlmx=0.0,sihlmn=0.0,sihomx=5.0,sihomn=0.0,
298 & sihsmx=5.0,sihsmn=0.0,sihimx=5.0,sihimn=0.10,
299 & sihjmx=5.0,sihjmn=0.10,glacir_hice=3.0)
308 parameter(siclmx=0.0,siclmn=0.0,sicomx=1.0,sicomn=0.0,
309 & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicjmx=1.0)
313 parameter(wetlmx=0.15,wetlmn=0.00,wetomx=0.15,wetomn=0.15,
314 & wetsmx=0.15,wetsmn=0.15,wetimx=0.15,wetimn=0.15,
315 & wetjmx=0.15,wetjmn=0.15)
316 parameter(snolmx=0.0,snolmn=0.0,snoomx=0.0,snoomn=0.0,
317 & snosmx=55000.,snosmn=0.001,snoimx=0.,snoimn=0.0,
318 & snojmx=10000.,snojmn=0.01)
319 parameter(zorlmx=300.,zorlmn=1.0,zoromx=1.0,zoromn=1.e-05,
320 & zorsmx=300.,zorsmn=1.0,zorimx=1.0,zorimn=1.0,
321 & zorjmx=1.0,zorjmn=1.0)
322 parameter(plrlmx=1000.,plrlmn=0.0,plromx=1000.0,plromn=0.0,
323 & plrsmx=1000.,plrsmn=0.0,plrimx=1000.,plrimn=0.0,
324 & plrjmx=1000.,plrjmn=0.0)
326 parameter(tsflmx=353.,tsflmn=173.0,tsfomx=313.0,tsfomn=271.2,
327 & tsfsmx=305.0,tsfsmn=173.0,tsfimx=271.2,tsfimn=173.0,
328 & tsfjmx=273.16,tsfjmn=173.0)
332 parameter(tg3lmx=310.,tg3lmn=200.0,tg3omx=310.0,tg3omn=200.0,
333 & tg3smx=310.,tg3smn=200.0,tg3imx=310.0,tg3imn=200.0,
334 & tg3jmx=310.,tg3jmn=200.0)
335 parameter(stclmx=353.,stclmn=173.0,stcomx=313.0,stcomn=200.0,
336 & stcsmx=310.,stcsmn=200.0,stcimx=310.0,stcimn=200.0,
337 & stcjmx=310.,stcjmn=200.0)
340 parameter(smclmx=0.55,smclmn=0.0,smcomx=1.0,smcomn=1.0,
341 & smcsmx=0.55,smcsmn=0.0,smcimx=1.0,smcimn=1.0,
342 & smcjmx=1.0,smcjmn=1.0)
343 parameter(scvlmx=0.0,scvlmn=0.0,scvomx=0.0,scvomn=0.0,
344 & scvsmx=1.0,scvsmn=1.0,scvimx=0.0,scvimn=0.0,
345 & scvjmx=1.0,scvjmn=1.0)
346 parameter(veglmx=1.0,veglmn=0.0,vegomx=0.0,vegomn=0.0,
347 & vegsmx=1.0,vegsmn=0.0,vegimx=0.0,vegimn=0.0,
348 & vegjmx=0.0,vegjmn=0.0)
349 parameter(vmnlmx=1.0,vmnlmn=0.0,vmnomx=0.0,vmnomn=0.0,
350 & vmnsmx=1.0,vmnsmn=0.0,vmnimx=0.0,vmnimn=0.0,
351 & vmnjmx=0.0,vmnjmn=0.0)
352 parameter(vmxlmx=1.0,vmxlmn=0.0,vmxomx=0.0,vmxomn=0.0,
353 & vmxsmx=1.0,vmxsmn=0.0,vmximx=0.0,vmximn=0.0,
354 & vmxjmx=0.0,vmxjmn=0.0)
355 parameter(slplmx=9.0,slplmn=1.0,slpomx=0.0,slpomn=0.0,
356 & slpsmx=9.0,slpsmn=1.0,slpimx=0.,slpimn=0.,
357 & slpjmx=0.,slpjmn=0.)
361 parameter(absomx=0.0,absomn=0.0,
362 & absimx=0.0,absimn=0.0,
363 & absjmx=0.0,absjmn=0.0)
365 parameter(vetlmx=20.,vetlmn=1.0,vetomx=0.0,vetomn=0.0,
366 & vetsmx=20.,vetsmn=1.0,vetimx=0.,vetimn=0.,
367 & vetjmx=0.,vetjmn=0.)
369 parameter(sotlmx=16.,sotlmn=1.0,sotomx=0.0,sotomn=0.0,
370 & sotsmx=16.,sotsmn=1.0,sotimx=0.,sotimn=0.,
371 & sotjmx=0.,sotjmn=0.)
373 parameter(soclmx=20.,soclmn=1.0,socomx=0.0,socomn=0.0,
374 & socsmx=20.,socsmn=1.0,socimx=0.,socimn=0.,
375 & socjmx=0.,socjmn=0.)
378 parameter(alslmx=1.0,alslmn=0.0,alsomx=0.0,alsomn=0.0,
379 & alssmx=1.0,alssmn=0.0,alsimx=0.0,alsimn=0.0,
380 & alsjmx=0.0,alsjmn=0.0)
384 parameter(epstsf=0.01,epsalb=0.001,epssno=0.01,
385 & epswet=0.01,epszor=0.0000001,epsplr=1.,epsoro=0.,
386 & epssmc=0.0001,epsscv=0.,eptsfc=0.01,epstg3=0.01,
387 & epsais=0.,epsacn=0.01,epsveg=0.01,
388 & epssih=0.001,epssic=0.001,
389 & epsvmn=0.01,epsvmx=0.01,epsabs=0.001,epsslp=0.01,
390 & epsvet=.01,epssot=.01,epssoc=0.01,epsalf=.001)
401 parameter(qctsfs=293.16,qcsnos=100.,qctsfi=280.16)
411 parameter(snwmin=5.0,snwmax=100.)
457 data critp1,critp2,critp3/80.,80.,25./
465 real (kind=kind_io8) slmskl(len), slmskw(len)
466 real (kind=kind_io8) orog(len), orog_uf(len), orogd(len)
467 real (kind=kind_io8) rla(len), rlo(len)
471 character*500 fnglac,fnmxic
472 real (kind=kind_io8),
allocatable :: glacir(:),amxice(:),tsfcl0(:)
478 character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc &
479 &, fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc &
480 &, fnvegc,fnvetc,fnsotc,fnsocc &
481 &, fnvmnc,fnvmxc,fnslpc,fnabsc, fnalbc2
482 real (kind=kind_io8) tsfclm(len), wetclm(len), snoclm(len) &
483 &, zorclm(len), albclm(len,4), aisclm(len) &
484 &, tg3clm(len), acnclm(len), cnpclm(len) &
485 &, cvclm (len), cvbclm(len), cvtclm(len) &
486 &, scvclm(len), tsfcl2(len), vegclm(len) &
487 &, vetclm(len), sotclm(len), socclm(len),alfclm(len,2), sliclm(len)&
488 &, smcclm(len,lsoil), stcclm(len,lsoil) &
489 &, sihclm(len), sicclm(len) &
490 &, vmnclm(len), vmxclm(len), slpclm(len), absclm(len)
494 character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa &
495 &, fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna &
496 &, fnvega,fnveta,fnsota,fnsoca &
497 &, fnvmna,fnvmxa,fnslpa,fnabsa
499 real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len) &
500 &, zoranl(len), albanl(len,4), aisanl(len) &
501 &, tg3anl(len), acnanl(len), cnpanl(len) &
502 &, cvanl(len), cvbanl(len), cvtanl(len) &
503 &, scvanl(len), tsfan2(len), veganl(len) &
504 &, vetanl(len), sotanl(len), socanl(len) &
505 &, alfanl(len,2), slianl(len) &
506 &, smcanl(len,lsoil), stcanl(len,lsoil) &
507 &, sihanl(len), sicanl(len) &
508 &, vmnanl(len), vmxanl(len), slpanl(len), absanl(len)
510 real (kind=kind_io8) tsfan0(len)
514 real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len) &
515 &, zorfcs(len), albfcs(len,4), aisfcs(len) &
516 &, tg3fcs(len), acnfcs(len), cnpfcs(len) &
517 &, cvfcs(len), cvbfcs(len), cvtfcs(len) &
518 &, slifcs(len), vegfcs(len) &
519 &, vetfcs(len), sotfcs(len), socfcs(len), alffcs(len,2) &
520 &, smcfcs(len,lsoil), stcfcs(len,lsoil) &
521 &, sihfcs(len), sicfcs(len), sitfcs(len) &
522 &, vmnfcs(len), vmxfcs(len), slpfcs(len), absfcs(len) &
523 &, swdfcs(len), slcfcs(len,lsoil)
528 real (kind=kind_io8) f10m(len)
529 real (kind=kind_io8) fsmcl(25), fsmcs(25), fstcl(25), fstcs(25)
530 real (kind=kind_io8) fcsmcl(25),fcsmcs(25),fcstcl(25),fcstcs(25)
533 real (kind=kind_io8) swratio(len,lsoil)
535 logical fixratio(lsoil)
537 integer icsmcl(25), icsmcs(25), icstcl(25), icstcs(25)
539 real (kind=kind_io8) csmcl(25), csmcs(25)
540 real (kind=kind_io8) cstcl(25), cstcs(25)
542 real (kind=kind_io8) slmskh(
mdata)
546 logical icefl1(len), icefl2(len)
548 real (kind=kind_io8),
allocatable,
dimension(:) :: &
549 & tsffcsd, snofcsd, tg3fcsd, zorfcsd, slifcsd, aisfcsd, &
550 & cnpfcsd, vegfcsd, vetfcsd, sotfcsd, socfcsd, sihfcsd, sicfcsd, &
551 & vmnfcsd, vmxfcsd, slpfcsd, absfcsd
552 real (kind=kind_io8),
allocatable,
dimension(:,:) :: &
553 & smcfcsd, stcfcsd, albfcsd
560 real (kind=kind_io8) sig1t(len)
612 logical :: ldebug, lqcbgs, lprnt
616 character*500 fndclm,fndanl
621 namelist/namsfc/fnglac,fnmxic,
622 & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,
623 & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,
624 & fnvegc,fnvetc,fnsotc,fnsocc,fnalbc2,
625 & fnvmnc,fnvmxc,fnslpc,fnabsc,
626 & fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,
627 & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna,
628 & fnvega,fnveta,fnsota,fnsoca,
629 & fnvmna,fnvmxa,fnslpa,fnabsa,
631 & ldebug,lgchek,lqcbgs,critp1,critp2,critp3,
634 & ftsfl,ftsfs,falbl,falbs,faisl,faiss,fsnol,fsnos,
635 & fzorl,fzors,fplrl,fplrs,fsmcl,fsmcs,
636 & fstcl,fstcs,fvegl,fvegs,fvetl,fvets,fsotl,fsots,
638 & fctsfl,fctsfs,fcalbl,fcalbs,fcsnol,fcsnos,
639 & fczorl,fczors,fcplrl,fcplrs,fcsmcl,fcsmcs,
640 & fcstcl,fcstcs,fsalfl,fsalfs,fcalfl,flalfs,
641 & fsihl,fsicl,fsihs,fsics,aislim,sihnew,
642 & fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps,
644 & ictsfl,ictsfs,icalbl,icalbs,icsnol,icsnos,
645 & iczorl,iczors,icplrl,icplrs,icsmcl,icsmcs,
646 & icstcl,icstcs,icalfl,icalfs,
647 & gausm, deads, qcmsk, znlst,
648 & monclm, monanl, monfcs, monmer, mondif, igrdbg,
649 & blnmsk, bltmsk, landice
651 data gausm/.true./, deads/.false./, blnmsk/0.0/, bltmsk/90.0/
652 &, qcmsk/.false./, znlst/.false./, igrdbg/-1/
653 &, monclm/.false./, monanl/.false./, monfcs/.false./
654 &, monmer/.false./, mondif/.false./, landice/.true./
658 data fnmskh/
'global_slmask.t126.grb'/
659 data fnalbc/
'global_albedo4.1x1.grb'/
660 data fnalbc2/
'global_albedo4.1x1.grb'/
661 data fntsfc/
'global_sstclim.2x2.grb'/
662 data fnsotc/
'global_soiltype.1x1.grb'/
664 data fnvegc/
'global_vegfrac.1x1.grb'/
665 data fnvetc/
'global_vegtype.1x1.grb'/
666 data fnglac/
'global_glacier.2x2.grb'/
667 data fnmxic/
'global_maxice.2x2.grb'/
668 data fnsnoc/
'global_snoclim.1.875.grb'/
669 data fnzorc/
'global_zorclim.1x1.grb'/
670 data fnaisc/
'global_iceclim.2x2.grb'/
671 data fntg3c/
'global_tg3clim.2.6x1.5.grb'/
672 data fnsmcc/
'global_soilmcpc.1x1.grb'/
674 data fnvmnc/
'global_shdmin.0.144x0.144.grb'/
675 data fnvmxc/
'global_shdmax.0.144x0.144.grb'/
676 data fnslpc/
'global_slope.1x1.grb'/
677 data fnabsc/
'global_snoalb.1x1.grb'/
707 data ldebug/.false./, lqcbgs/.true./
713 data ftsfl/99999.0/, ftsfs/0.0/
714 data falbl/0.0/, falbs/0.0/
715 data falfl/0.0/, falfs/0.0/
716 data faisl/0.0/, faiss/0.0/
717 data fsnol/0.0/, fsnos/99999.0/
718 data fzorl/0.0/, fzors/99999.0/
719 data fplrl/0.0/, fplrs/0.0/
720 data fvetl/0.0/, fvets/99999.0/
721 data fsotl/0.0/, fsots/99999.0/
722 data fsocl/0.0/, fsocs/99999.0/
723 data fvegl/0.0/, fvegs/99999.0/
725 data fsihl/99999.0/, fsihs/99999.0/
727 data fsicl/0.0/, fsics/0.0/
731 data aislim/0.15/, sihnew/0.2/
733 data fvmnl/0.0/, fvmns/99999.0/
734 data fvmxl/0.0/, fvmxs/99999.0/
735 data fslpl/0.0/, fslps/99999.0/
736 data fabsl/0.0/, fabss/99999.0/
738 data fctsfl/99999.0/, fctsfs/99999.0/
739 data fcalbl/99999.0/, fcalbs/99999.0/
740 data fcsnol/99999.0/, fcsnos/99999.0/
741 data fczorl/99999.0/, fczors/99999.0/
742 data fcplrl/99999.0/, fcplrs/99999.0/
744 data ictsfl/0/, ictsfs/1/
745 data icalbl/1/, icalbs/1/
746 data icalfl/1/, icalfs/1/
747 data icsnol/0/, icsnos/0/
748 data iczorl/1/, iczors/0/
749 data icplrl/1/, icplrs/0/
752 data ccv/1.0/, ccvb/1.0/, ccvt/1.0/
756 save ifp,fnglac,fnmxic,
757 & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,
758 & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc,
759 & fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,
760 & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega,
765 & fnvmnc,fnvmxc,fnabsc,fnslpc,
766 & fnvmna,fnvmxa,fnabsa,fnslpa,
767 & ldebug,lgchek,lqcbgs,critp1,critp2,critp3,
770 & ftsfl,ftsfs,falbl,falbs,faisl,faiss,fsnol,fsnos,
771 & fzorl,fzors,fplrl,fplrs,fsmcl,fsmcs,falfl,falfs,
772 & fstcl,fstcs,fvegl,fvegs,fvetl,fvets,fsotl,fsots,
774 & fctsfl,fctsfs,fcalbl,fcalbs,fcsnol,fcsnos,
775 & fczorl,fczors,fcplrl,fcplrs,fcsmcl,fcsmcs,
776 & fcstcl,fcstcs,fcalfl,fcalfs,
778 & fsihl,fsihs,fsicl,fsics,aislim,sihnew,
780 & fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps,
782 & ictsfl,ictsfs,icalbl,icalbs,icsnol,icsnos,
783 & iczorl,iczors,icplrl,icplrs,icsmcl,icsmcs,
784 & icstcl,icstcs,icalfl,icalfs,
785 & gausm, deads, qcmsk,
786 & monclm, monanl, monfcs, monmer, mondif, igrdbg,
789 & ctsfl, ctsfs, calbl, calfl, calbs, calfs, csmcs,
790 & csnol, csnos, czorl, czors, cplrl, cplrs, cstcl,
791 & cstcs, cvegl, cvwgs, cvetl, cvets, csotl, csots,
795 &, csihl, csihs, csicl, csics
797 &, cvmnl, cvmns, cvmxl, cvmxs, cslpl, cslps,
799 &, imsk, jmsk, slmskh, blnmsk, bltmsk
800 &, glacir, amxice, tsfcl0
801 &, caisl, caiss, cvegs
831 elseif (ialb ==2)
then
862#ifdef INTERNAL_FILE_NML
863 read(input_nml_file, nml=namsfc)
872 print *,
' ftsfl,falbl,faisl,fsnol,fzorl=', &
873 & ftsfl,falbl,faisl,fsnol,fzorl
874 print *,
' fsmcl=',fsmcl(1:lsoil)
875 print *,
' fstcl=',fstcl(1:lsoil)
876 print *,
' ftsfs,falbs,faiss,fsnos,fzors=', &
877 & ftsfs,falbs,faiss,fsnos,fzors
878 print *,
' fsmcs=',fsmcs(1:lsoil)
879 print *,
' fstcs=',fstcs(1:lsoil)
880 print *,
' aislim=',aislim,
' sihnew=',sihnew
881 print *,
' isot=', isot,
' ivegsrc=',ivegsrc
882 print *,
' fnsotc =', fnsotc
885 if (ivegsrc == 2)
then
898 deltf = deltsfc / 24.0
901 if (ftsfl >= 99999.) ctsfl = 1.
902 if (ftsfl > 0. .and. ftsfl < 99999) ctsfl = exp(-deltf/ftsfl)
905 if (ftsfs >= 99999.) ctsfs=1.
906 if (ftsfs > 0. .and. ftsfs < 99999) ctsfs = exp(-deltf/ftsfs)
910 if (fsmcl(k) >= 99999.) csmcl(k) = 1.
911 if (fsmcl(k) > 0. .and. fsmcl(k) < 99999)
912 & csmcl(k) = exp(-deltf/fsmcl(k))
914 if (fsmcs(k) >= 99999.) csmcs(k) = 1.
915 if (fsmcs(k) > 0. .and. fsmcs(k) < 99999)
916 & csmcs(k) = exp(-deltf/fsmcs(k))
920 if (ialb == 2) falbl=99999.
921 if (falbl >= 99999.) calbl = 1.
922 if (falbl > 0. .and. falbl < 99999) calbl = exp(-deltf/falbl)
925 if (falfl >= 99999.) calfl = 1.
926 if (falfl > 0. .and. falfl < 99999) calfl = exp(-deltf/falfl)
929 if (falbs >= 99999.) calbs = 1.
930 if (falbs > 0. .and. falbs < 99999) calbs = exp(-deltf/falbs)
933 if (falfs >= 99999.) calfs = 1.
934 if (falfs > 0. .and. falfs < 99999) calfs = exp(-deltf/falfs)
937 if (faisl >= 99999.) caisl = 1.
938 if (faisl > 0. .and. faisl < 99999) caisl = 1.
941 if (faiss >= 99999.) caiss = 1.
942 if (faiss > 0. .and. faiss < 99999) caiss = 1.
945 if (fsnol >= 99999.) csnol = 1.
946 if (fsnol > 0. .and. fsnol < 99999) csnol = exp(-deltf/fsnol)
950 if (fsnol < 0.) csnol = fsnol
953 if (fsnos >= 99999.) csnos = 1.
954 if (fsnos > 0 .and. fsnos < 99999) csnos = exp(-deltf/fsnos)
957 if (fzorl >= 99999.) czorl = 1.
958 if (fzorl > 0. .and. fzorl < 99999) czorl = exp(-deltf/fzorl)
961 if (fzors >= 99999.) czors = 1.
962 if (fzors > 0. .and. fzors < 99999) czors = exp(-deltf/fzors)
974 if (fstcl(k) >= 99999.) cstcl(k) = 1.
975 if (fstcl(k) > 0. .and. fstcl(k) < 99999) &
976 & cstcl(k) = exp(-deltf/fstcl(k))
978 if (fstcs(k) >= 99999.) cstcs(k) = 1.
979 if (fstcs(k) > 0. .and. fstcs(k) < 99999) &
980 & cstcs(k) = exp(-deltf/fstcs(k))
984 if (fvegl >= 99999.) cvegl = 1.
985 if (fvegl > 0. .and. fvegl < 99999) cvegl = exp(-deltf/fvegl)
988 if (fvegs >= 99999.) cvegs = 1.
989 if (fvegs > 0. .and. fvegs < 99999) cvegs = exp(-deltf/fvegs)
992 if (fvetl >= 99999.) cvetl = 1.
993 if (fvetl > 0. .and. fvetl < 99999) cvetl = exp(-deltf/fvetl)
996 if (fvets >= 99999.) cvets = 1.
997 if (fvets > 0. .and. fvets < 99999) cvets = exp(-deltf/fvets)
1000 if (fsotl >= 99999.) csotl = 1.
1001 if (fsotl > 0. .and. fsotl < 99999) csotl = exp(-deltf/fsotl)
1004 if (fsots >= 99999.) csots = 1.
1005 if (fsots > 0. .and. fsots < 99999) csots = exp(-deltf/fsots)
1008 if (fsocl >= 99999.) csocl = 1.
1009 if (fsocl > 0. .and. fsocl < 99999) csocl = exp(-deltf/fsocl)
1012 if (fsocs >= 99999.) csots = 1.
1013 if (fsocs > 0. .and. fsocs < 99999) csocs = exp(-deltf/fsocs)
1019 if (fsihl >= 99999.) csihl = 1.
1020 if (fsihl > 0. .and. fsihl < 99999) csihl = exp(-deltf/fsihl)
1023 if (fsihs >= 99999.) csihs = 1.
1024 if (fsihs > 0. .and. fsihs < 99999) csihs = exp(-deltf/fsihs)
1027 if (fsicl >= 99999.) csicl = 1.
1028 if (fsicl > 0. .and. fsicl < 99999) csicl = exp(-deltf/fsicl)
1031 if (fsics >= 99999.) csics = 1.
1032 if (fsics > 0. .and. fsics < 99999) csics = exp(-deltf/fsics)
1037 if (fvmnl >= 99999.) cvmnl = 1.
1038 if (fvmnl > 0. .and. fvmnl < 99999) cvmnl = exp(-deltf/fvmnl)
1041 if (fvmns >= 99999.) cvmns = 1.
1042 if (fvmns > 0. .and. fvmns < 99999) cvmns = exp(-deltf/fvmns)
1045 if (fvmxl >= 99999.) cvmxl = 1.
1046 if (fvmxl > 0. .and. fvmxl < 99999) cvmxl = exp(-deltf/fvmxl)
1049 if (fvmxs >= 99999.) cvmxs = 1.
1050 if (fvmxs > 0. .and. fvmxs < 99999) cvmxs = exp(-deltf/fvmxs)
1053 if (fslpl >= 99999.) cslpl = 1.
1054 if (fslpl > 0. .and. fslpl < 99999) cslpl = exp(-deltf/fslpl)
1057 if (fslps >= 99999.) cslps = 1.
1058 if (fslps > 0. .and. fslps < 99999) cslps = exp(-deltf/fslps)
1061 if (fabsl >= 99999.) cabsl = 1.
1062 if (fabsl > 0. .and. fabsl < 99999) cabsl = exp(-deltf/fabsl)
1065 if (fabss >= 99999.) cabss = 1.
1066 if (fabss > 0. .and. fabss < 99999) cabss = exp(-deltf/fabss)
1071 call hmskrd(lugb,imsk,jmsk,fnmskh, &
1072 & kpdmsk,slmskh,gausm,blnmsk,bltmsk,me)
1077 write(6,*)
' lugb=',lugb,
' len=',len,
' lsoil=',lsoil
1078 write(6,*)
'iy=',iy,
' im=',im,
' id=',id,
' ih=',ih,
' fh=',fh &
1079 &,
' sig1t(1)=',sig1t(1) &
1080 &,
' gausm=',gausm,
' blnmsk=',blnmsk,
' bltmsk=',bltmsk
1086 allocate (tsfcl0(len))
1087 allocate (glacir(len))
1088 allocate (amxice(len))
1096 &, imsk, jmsk, slmskh, gausm, blnmsk, bltmsk
1104 call fixrdc(lugb,fnmxic,kpdmxi,kpd7,kpd9,slmskl
1106 &, imsk, jmsk, slmskh, gausm, blnmsk, bltmsk
1112 call rof01(glacir,len,
'ge',crit)
1113 call rof01(amxice,len,
'ge',crit)
1117 call qcmxice(glacir,amxice,len,me)
1130 write(6,*)
'=============='
1131 write(6,*)
'climatology'
1132 write(6,*)
'=============='
1137 call clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw,
1138 & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,
1139 & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc,
1140 & fnvetc,fnsotc,fnsocc,
1141 & fnvmnc,fnvmxc,fnslpc,fnabsc,
1142 & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm,
1143 & tg3clm,cvclm ,cvbclm,cvtclm,
1144 & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm,
1145 & vetclm,sotclm,socclm,alfclm,
1146 & vmnclm,vmxclm,slpclm,absclm,
1148 &
kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg,
1149 & kpdvet,kpdsot,kpdsoc,
kpdalf,tsfcl0,
1150 & kpdvmn,kpdvmx,kpdslp,kpdabs,
1152 &, imsk, jmsk, slmskh, rla, rlo, gausm, blnmsk, bltmsk,me
1153 &, lprnt,iprnt,fnalbc2,ialb,tile_num_ch,i_index,j_index)
1160 call scale(zorclm,len,zsca)
1162 call scale(albclm,len,zsca)
1163 call scale(albclm(1,2),len,zsca)
1164 call scale(albclm(1,3),len,zsca)
1165 call scale(albclm(1,4),len,zsca)
1166 call scale(alfclm,len,zsca)
1167 call scale(alfclm(1,2),len,zsca)
1170 call scale(vmnclm,len,zsca)
1171 call scale(vmxclm,len,zsca)
1172 call scale(absclm,len,zsca)
1177 call albocn(albclm,slmskl,albomx,len)
1181 call landtyp(vetclm,sotclm,socclm,slpclm,slmskl,len)
1187 if(fnaisc(1:8) /=
' ')
then
1190 sihclm(i) = 3.0*aisclm(i)
1191 sicclm(i) = aisclm(i)
1192 if(nint(slmskl(i)) == 0 .and. nint(glacir(i)) == 1 &
1193 & .and. sicclm(i) /= 1.0)
then
1195 sihfcs(i) = glacir_hice
1201 call rof01_len(aisclm, len,
'ge', min_ice)
1203 elseif(fnacnc(1:8) /=
' ')
then
1206 sihclm(i) = 3.0*acnclm(i)
1207 sicclm(i) = acnclm(i)
1208 if(nint(slmskw(i)) == 0 .and. nint(glacir(i)) == 1 &
1209 & .and. sicclm(i).ne.1.)
then
1211 sihfcs(i) = glacir_hice
1215 call rof01_len(acnclm, len,
'ge', min_ice)
1217 aisclm(i) = acnclm(i)
1223 call qcsice(aisclm,glacir,amxice,aicice,aicsea,sllnd,slmskw,
1228 call setlsi(slmskl,aisclm,len,aicice,sliclm)
1238 call qcsnow(snoclm,slmskl,aisclm,glacir,len,snosmx,landice,me)
1240 call setzro(snoclm,epssno,len)
1247 call qcmxmn(
'snow ',snoclm,sliclm,snoclm,icefl1,
1248 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
1249 & snojmx,snojmn,snosmx,snosmn,epssno,
1250 & rla,rlo,len,kqcm,percrit,lgchek,me)
1257 if(fnscvc(1:8).eq.
' ')
then
1258 call getscv(snoclm,scvclm,len)
1263 call snosfc(snoclm,tsfclm,tsfsmx,len,me)
1270 icefl2(i) = sicclm(i) > 0.99999
1273 call qcmxmn(
'tsfc ',tsfclm,sliclm,snoclm,icefl2,
1274 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1275 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1276 & rla,rlo,len,kqcm,percrit,lgchek,me)
1277 call qcmxmn(
'tsf2 ',tsfcl2,sliclm,snoclm,icefl2,
1278 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1279 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1280 & rla,rlo,len,kqcm,percrit,lgchek,me)
1282 call qcmxmn(
'albc ',albclm(1,kk),sliclm,snoclm,icefl1,
1283 & alblmx,alblmn,albomx,albomn,albimx,albimn,
1284 & albjmx,albjmn,albsmx,albsmn,epsalb,
1285 & rla,rlo,len,kqcm,percrit,lgchek,me)
1287 if(fnwetc(1:8).ne.
' ')
then
1288 call qcmxmn(
'wetc ',wetclm,sliclm,snoclm,icefl1,
1289 & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn,
1290 & wetjmx,wetjmn,wetsmx,wetsmn,epswet,
1291 & rla,rlo,len,kqcm,percrit,lgchek,me)
1293 call qcmxmn(
'zorc ',zorclm,sliclm,snoclm,icefl1,
1294 & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn,
1295 & zorjmx,zorjmn,zorsmx,zorsmn,epszor,
1296 & rla,rlo,len,kqcm,percrit,lgchek,me)
1303 call qcmxmn(
'tg3c ',tg3clm,sliclm,snoclm,icefl1,
1304 & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn,
1305 & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3,
1306 & rla,rlo,len,kqcm,percrit,lgchek,me)
1311 if(fnsmcc(1:8).eq.
' ')
then
1312 call getsmc(wetclm,len,lsoil,smcclm,me)
1316 call qcmxmn(
message(
'stc',k),smcclm(1,k),slmskl,snoclm,icefl1,
1317 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1318 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1319 & rla,rlo,len,kqcm,percrit,lgchek,me)
1322 if(fnstcc(1:8).eq.
' ')
then
1323 call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx)
1327 call qcmxmn(
message(
'stc',k),stcclm(1,k),slmskl,snoclm,icefl1,
1328 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1329 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1330 & rla,rlo,len,kqcm,percrit,lgchek,me)
1333 call qcmxmn(
'vegc ',vegclm,slmskl,snoclm,icefl1,
1334 & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn,
1335 & vegjmx,vegjmn,vegsmx,vegsmn,epsveg,
1336 & rla,rlo,len,kqcm,percrit,lgchek,me)
1338 call qcmxmn(
'vetc ',vetclm,slmskl,snoclm,icefl1,
1339 & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn,
1340 & vetjmx,vetjmn,vetsmx,vetsmn,epsvet,
1341 & rla,rlo,len,kqcm,percrit,lgchek,me)
1343 call qcmxmn(
'sotc ',sotclm,slmskl,snoclm,icefl1,
1344 & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn,
1345 & sotjmx,sotjmn,sotsmx,sotsmn,epssot,
1346 & rla,rlo,len,kqcm,percrit,lgchek,me)
1348 call qcmxmn(
'socc ',socclm,slmskl,snoclm,icefl1,
1349 & soclmx,soclmn,socomx,socomn,socimx,socimn,
1350 & socjmx,socjmn,socsmx,socsmn,epssoc,
1351 & rla,rlo,len,kqcm,percrit,lgchek,me)
1357 call qcmxmn(
'sihc ',sihclm,sliclm,snoclm,icefl1,
1358 & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn,
1359 & sihjmx,sihjmn,sihsmx,sihsmn,epssih,
1360 & rla,rlo,len,kqcm,percrit,lgchek,me)
1367 call qcmxmn(
'vmnc ',vmnclm,slmskl,snoclm,icefl1,
1368 & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn,
1369 & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn,
1370 & rla,rlo,len,kqcm,percrit,lgchek,me)
1372 call qcmxmn(
'vmxc ',vmxclm,slmskl,snoclm,icefl1,
1373 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn,
1374 & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx,
1375 & rla,rlo,len,kqcm,percrit,lgchek,me)
1377 call qcmxmn(
'slpc ',slpclm,slmskl,snoclm,icefl1,
1378 & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn,
1379 & slpjmx,slpjmn,slpsmx,slpsmn,epsslp,
1380 & rla,rlo,len,kqcm,percrit,lgchek,me)
1381 call qcmxmn(
'absc ',absclm,sliclm,snoclm,icefl1,
1382 & abslmx,abslmn,absomx,absomn,absimx,absimn,
1383 & absjmx,absjmn,abssmx,abssmn,epsabs,
1384 & rla,rlo,len,kqcm,percrit,lgchek,me)
1392 print *,
'monitor of time and space interpolated climatology'
1396 call monitr(
'tsfclm',tsfclm,sliclm,snoclm,len)
1397 call monitr(
'albclm',albclm(1,1),sliclm,snoclm,len)
1398 call monitr(
'albclm',albclm(1,2),sliclm,snoclm,len)
1399 call monitr(
'albclm',albclm(1,3),sliclm,snoclm,len)
1400 call monitr(
'albclm',albclm(1,4),sliclm,snoclm,len)
1401 call monitr(
'aisclm',aisclm,sliclm,snoclm,len)
1402 call monitr(
'snoclm',snoclm,sliclm,snoclm,len)
1403 call monitr(
'scvclm',scvclm,sliclm,snoclm,len)
1405 call monitr(
message(
'smcclm',k),smcclm(1,k),sliclm,snoclm,len)
1406 call monitr(
message(
'stcclm',k),stcclm(1,k),sliclm,snoclm,len)
1408 call monitr(
'tg3clm',tg3clm,sliclm,snoclm,len)
1409 call monitr(
'zorclm',zorclm,sliclm,snoclm,len)
1411 call monitr(
'cvaclm',cvclm ,sliclm,snoclm,len)
1412 call monitr(
'cvbclm',cvbclm,sliclm,snoclm,len)
1413 call monitr(
'cvtclm',cvtclm,sliclm,snoclm,len)
1415 call monitr(
'sliclm',sliclm,sliclm,snoclm,len)
1417 call monitr(
'orog ',orog ,sliclm,snoclm,len)
1418 call monitr(
'vegclm',vegclm,sliclm,snoclm,len)
1419 call monitr(
'vetclm',vetclm,sliclm,snoclm,len)
1420 call monitr(
'sotclm',sotclm,sliclm,snoclm,len)
1421 call monitr(
'socclm',socclm,sliclm,snoclm,len)
1423 call monitr(
'sihclm',sihclm,sliclm,snoclm,len)
1424 call monitr(
'sicclm',sicclm,sliclm,snoclm,len)
1426 call monitr(
'vmnclm',vmnclm,sliclm,snoclm,len)
1427 call monitr(
'vmxclm',vmxclm,sliclm,snoclm,len)
1428 call monitr(
'slpclm',slpclm,sliclm,snoclm,len)
1429 call monitr(
'absclm',absclm,sliclm,snoclm,len)
1435 write(6,*)
'=============='
1436 write(6,*)
' analysis'
1437 write(6,*)
'=============='
1442 call filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl,
1443 & tg3anl,cvanl ,cvbanl,cvtanl,
1444 & cnpanl,smcanl,stcanl,slianl,scvanl,veganl,
1445 & vetanl,sotanl,socanl,alfanl,
1447 & vmnanl,vmxanl,slpanl,absanl,
1448 & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm,
1449 & tg3clm,cvclm ,cvbclm,cvtclm,
1450 & cnpclm,smcclm,stcclm,sliclm,scvclm,vegclm,
1451 & vetclm,sotclm,socclm,alfclm,
1453 & vmnclm,vmxclm,slpclm,absclm,
1460 call scale(zoranl,len, zsca)
1462 call scale(albanl,len,zsca)
1463 call scale(albanl(1,2),len,zsca)
1464 call scale(albanl(1,3),len,zsca)
1465 call scale(albanl(1,4),len,zsca)
1466 call scale(alfanl,len,zsca)
1467 call scale(alfanl(1,2),len,zsca)
1470 call scale(vmnanl,len,zsca)
1471 call scale(vmxanl,len,zsca)
1472 call scale(absanl,len,zsca)
1478 call analy(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw,
1479 & fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,
1480 & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega,
1481 & fnveta,fnsota,fnsoca,
1482 & fnvmna,fnvmxa,fnslpa,fnabsa,
1483 & tsfanl,wetanl,snoanl,zoranl,albanl,aisanl,
1484 & tg3anl,cvanl ,cvbanl,cvtanl,
1485 & smcanl,stcanl,slianl,scvanl,acnanl,veganl,
1486 & vetanl,sotanl,socanl,alfanl,tsfan0,
1487 & vmnanl,vmxanl,slpanl,absanl,
1489 &
kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg,
1490 & kpdvet,kpdsot,kpdsoc,
kpdalf,
1491 & kpdvmn,kpdvmx,kpdslp,kpdabs,
1492 & irttsf,irtwet,irtsno,irtzor,irtalb,irtais,
1493 & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg,
1494 & irtvet,irtsot,irtsoc,irtalf
1495 &, irtvmn,irtvmx,irtslp,irtabs,
1496 & imsk, jmsk, slmskh, rla, rlo, gausm, blnmsk, bltmsk
1505 call scale(zoranl,len, zsca)
1507 call scale(albanl,len,zsca)
1508 call scale(albanl(1,2),len,zsca)
1509 call scale(albanl(1,3),len,zsca)
1510 call scale(albanl(1,4),len,zsca)
1511 call scale(alfanl,len,zsca)
1512 call scale(alfanl(1,2),len,zsca)
1515 call scale(vmnanl,len,zsca)
1516 call scale(vmxanl,len,zsca)
1517 call scale(absanl,len,zsca)
1521 if(fh > 0.0 .and. fntsfa(1:8) /=
' ' .and. lanom)
then
1522 call anomint(tsfan0,tsfclm,tsfcl0,tsfanl,len)
1529 if (use_ufo .and. .not. nst_anl)
then
1531 call tsfcor(tsfanl,orog_uf,slmskw,ztsfc,len,rlapse)
1536 if(fnaisa(1:8) /=
' ')
then
1539 sihanl(i) = 3.0*aisanl(i)
1540 sicanl(i) = aisanl(i)
1541 if(nint(slmskw(i)) == 0 .and. nint(glacir(i)) == 1 &
1542 & .and. sicanl(i) /= 1.)
then
1544 sihfcs(i) = glacir_hice
1550 call rof01_len(aisanl, len,
'ge', min_ice)
1551 elseif(fnacna(1:8) /=
' ')
then
1554 sihanl(i) = 3.0*acnanl(i)
1555 sicanl(i) = acnanl(i)
1556 if(nint(slmskw(i)) == 0 .and. nint(glacir(i)) == 1 &
1557 & .and. sicanl(i) /= 1.)
then
1559 sihfcs(i) = glacir_hice
1565 if (nint(slianl(i)) == 0 .and. sicanl(i) >= crit)
then
1566 slianl(i) = 2.0_kind_io8
1568 elseif (nint(slianl(i)) >= 2 .and. sicanl(i) < crit)
then
1571 elseif (nint(slianl(i)) == 1 .and. sicanl(i) >= crit)
then
1575 if (nint(slmskw(i)) /= 0)
then
1577 sicanl(i) = 0.0_kind_io8
1590 call rof01_len(acnanl, len,
'ge', min_ice)
1592 aisanl(i) = acnanl(i)
1598 call qcsice(aisanl,glacir,amxice,aicice,aicsea,sllnd,slmskw,
1603 call setlsi(slmskl,aisanl,len,aicice,slianl)
1611 if (slianl(i) == 0 .and. nint(slmskl(i)) /= 1)
then
1612 smcanl(i,k) = smcomx
1613 stcanl(i,k) = tsfanl(i)
1622 call qcmxmn(
'siha ',sihanl,slianl,snoanl,icefl1,
1623 & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn,
1624 & sihjmx,sihjmn,sihsmx,sihsmn,epssih,
1625 & rla,rlo,len,kqcm,percrit,lgchek,me)
1633 call albocn(albanl,slmskl,albomx,len)
1638 if (fnsnoa(1:8) /=
' ')
then
1639 call setzro(snoanl,epssno,len)
1640 call qcsnow(snoanl,slmskl,aisanl,glacir,len,
ten,landice,me)
1641 if (.not.landice)
then
1642 call snodpth2(glacir,snosmx,snoanl, len, me)
1645 call snosfc(snoanl,tsfanl,tsfsmx,len,me)
1646 call qcmxmn(
'snoa ',snoanl,slianl,snoanl,icefl1,
1647 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
1648 & snojmx,snojmn,snosmx,snosmn,epssno,
1649 & rla,rlo,len,kqcm,percrit,lgchek,me)
1650 call getscv(snoanl,scvanl,len)
1651 call qcmxmn(
'sncva ',scvanl,slianl,snoanl,icefl1,
1652 & scvlmx,scvlmn,scvomx,scvomn,scvimx,scvimn,
1653 & scvjmx,scvjmn,scvsmx,scvsmn,epsscv,
1654 & rla,rlo,len,kqcm,percrit,lgchek,me)
1657 call rof01(scvanl,len,
'ge',crit)
1658 call qcsnow(scvanl,slmskl,aisanl,glacir,len,
one,landice,me)
1659 call qcmxmn(
'sncva ',scvanl,slianl,scvanl,icefl1,
1660 & scvlmx,scvlmn,scvomx,scvomn,scvimx,scvimn,
1661 & scvjmx,scvjmn,scvsmx,scvsmn,epsscv,
1662 & rla,rlo,len,kqcm,percrit,lgchek,me)
1663 call snodpth(scvanl,slianl,tsfanl,snoclm,
1664 & glacir,snwmax,snwmin,landice,len,snoanl,me)
1665 call qcsnow(scvanl,slmskl,aisanl,glacir,len,snosmx,landice,me)
1666 call snosfc(snoanl,tsfanl,tsfsmx,len,me)
1667 call qcmxmn(
'snowa ',snoanl,slianl,snoanl,icefl1,
1668 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
1669 & snojmx,snojmn,snosmx,snosmn,epssno,
1670 & rla,rlo,len,kqcm,percrit,lgchek,me)
1674 icefl2(i) = sicanl(i) > 0.99999
1676 call qcmxmn(
'tsfa ',tsfanl,slianl,snoanl,icefl2,
1677 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1678 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1679 & rla,rlo,len,kqcm,percrit,lgchek,me)
1681 call qcmxmn(
'alba ',albanl(1,kk),slianl,snoanl,icefl1,
1682 & alblmx,alblmn,albomx,albomn,albimx,albimn,
1683 & albjmx,albjmn,albsmx,albsmn,epsalb,
1684 & rla,rlo,len,kqcm,percrit,lgchek,me)
1686 if(fnwetc(1:8) /=
' ' .or. fnweta(1:8) /=
' ' )
then
1687 call qcmxmn(
'weta ',wetanl,slianl,snoanl,icefl1,
1688 & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn,
1689 & wetjmx,wetjmn,wetsmx,wetsmn,epswet,
1690 & rla,rlo,len,kqcm,percrit,lgchek,me)
1692 call qcmxmn(
'zora ',zoranl,slianl,snoanl,icefl1,
1693 & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn,
1694 & zorjmx,zorjmn,zorsmx,zorsmn,epszor,
1695 & rla,rlo,len,kqcm,percrit,lgchek,me)
1703 call qcmxmn(
'tg3a ',tg3anl,slmskl,snoanl,icefl1,
1704 & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn,
1705 & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3,
1706 & rla,rlo,len,kqcm,percrit,lgchek,me)
1710 if(fnsmca(1:8) ==
' ' .and. fnsmcc(1:8) ==
' ')
then
1711 call getsmc(wetanl,len,lsoil,smcanl,me)
1716 call qcmxmn(
message(
'smca',k),smcanl(1,1),slmskl,snoanl,icefl1,
1717 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1718 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1719 & rla,rlo,len,kqcm,percrit,lgchek,me)
1722 if(fnstca(1:8).eq.
' ')
then
1723 call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx)
1727 call qcmxmn(
message(
'stca',k),stcanl(1,1),slmskl,snoanl,icefl1,
1728 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1729 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1730 & rla,rlo,len,kqcm,percrit,lgchek,me)
1733 call qcmxmn(
'vega ',veganl,slmskl,snoanl,icefl1,
1734 & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn,
1735 & vegjmx,vegjmn,vegsmx,vegsmn,epsveg,
1736 & rla,rlo,len,kqcm,percrit,lgchek,me)
1738 call qcmxmn(
'veta ',vetanl,slmskl,snoanl,icefl1,
1739 & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn,
1740 & vetjmx,vetjmn,vetsmx,vetsmn,epsvet,
1741 & rla,rlo,len,kqcm,percrit,lgchek,me)
1743 call qcmxmn(
'sota ',sotanl,slmskl,snoanl,icefl1,
1744 & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn,
1745 & sotjmx,sotjmn,sotsmx,sotsmn,epssot,
1746 & rla,rlo,len,kqcm,percrit,lgchek,me)
1748 call qcmxmn(
'soca ',socanl,slmskl,snoanl,icefl1,
1749 & soclmx,soclmn,socomx,socomn,socimx,socimn,
1750 & socjmx,socjmn,socsmx,socsmn,epssoc,
1751 & rla,rlo,len,kqcm,percrit,lgchek,me)
1755 call qcmxmn(
'vmna ',vmnanl,slmskl,snoanl,icefl1,
1756 & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn,
1757 & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn,
1758 & rla,rlo,len,kqcm,percrit,lgchek,me)
1760 call qcmxmn(
'vmxa ',vmxanl,slmskl,snoanl,icefl1,
1761 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn,
1762 & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx,
1763 & rla,rlo,len,kqcm,percrit,lgchek,me)
1765 call qcmxmn(
'slpa ',slpanl,slmskl,snoanl,icefl1,
1766 & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn,
1767 & slpjmx,slpjmn,slpsmx,slpsmn,epsslp,
1768 & rla,rlo,len,kqcm,percrit,lgchek,me)
1769 call qcmxmn(
'absa ',absanl,slianl,snoanl,icefl1,
1770 & abslmx,abslmn,absomx,absomn,absimx,absimn,
1771 & absjmx,absjmn,abssmx,abssmn,epsabs,
1772 & rla,rlo,len,kqcm,percrit,lgchek,me)
1780 print *,
'monitor of time and space interpolated analysis'
1784 call monitr(
'tsfanl',tsfanl,slianl,snoanl,len)
1785 call monitr(
'albanl',albanl,slianl,snoanl,len)
1786 call monitr(
'aisanl',aisanl,slianl,snoanl,len)
1787 call monitr(
'snoanl',snoanl,slianl,snoanl,len)
1788 call monitr(
'scvanl',scvanl,slianl,snoanl,len)
1790 call monitr(
message(
'smcanl',k),smcanl(1,k),slianl,snoanl,len)
1791 call monitr(
message(
'stcanl',k),stcanl(1,k),slianl,snoanl,len)
1793 call monitr(
'tg3anl',tg3anl,slianl,snoanl,len)
1794 call monitr(
'zoranl',zoranl,slianl,snoanl,len)
1796 call monitr(
'cvaanl',cvanl ,slianl,snoanl,len)
1797 call monitr(
'cvbanl',cvbanl,slianl,snoanl,len)
1798 call monitr(
'cvtanl',cvtanl,slianl,snoanl,len)
1800 call monitr(
'slianl',slianl,slianl,snoanl,len)
1802 call monitr(
'orog ',orog ,slianl,snoanl,len)
1803 call monitr(
'veganl',veganl,slianl,snoanl,len)
1804 call monitr(
'vetanl',vetanl,slianl,snoanl,len)
1805 call monitr(
'sotanl',sotanl,slianl,snoanl,len)
1806 call monitr(
'socanl',socanl,slianl,snoanl,len)
1808 call monitr(
'sihanl',sihanl,slianl,snoanl,len)
1809 call monitr(
'sicanl',sicanl,slianl,snoanl,len)
1811 call monitr(
'vmnanl',vmnanl,slianl,snoanl,len)
1812 call monitr(
'vmxanl',vmxanl,slianl,snoanl,len)
1813 call monitr(
'slpanl',slpanl,slianl,snoanl,len)
1814 call monitr(
'absanl',absanl,slianl,snoanl,len)
1822 write(6,*)
'=============='
1823 write(6,*)
' fcst guess'
1824 write(6,*)
'=============='
1834 if (me == 0)
write(6,*)
'this run is dead start run'
1835 call filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs,
1836 & tg3fcs,cvfcs ,cvbfcs,cvtfcs,
1837 & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs,
1838 & vegfcs,vetfcs,sotfcs,socfcs,alffcs,
1842 & vmnfcs,vmxfcs,slpfcs,absfcs,
1843 & tsfanl,wetanl,snoanl,zoranl,albanl,
1844 & tg3anl,cvanl ,cvbanl,cvtanl,
1845 & cnpanl,smcanl,stcanl,slianl,aisanl,
1846 & veganl,vetanl,sotanl,socanl,alfanl,
1850 & vmnanl,vmxanl,slpanl,absanl,
1854 print *,
'AFTER FILFCS (i) is ',socfcs(i)
1857 if (sig1t(1) /= 0.)
then
1858 call usesgt(sig1t,slianl,tg3anl,len,lsoil,tsffcs,stcfcs,
1861 icefl2(i) = sicfcs(i) > 0.99999
1864 call qcmxmn(
'tsff ',tsffcs,slifcs,snofcs,icefl2,
1865 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1866 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1867 & rla,rlo,len,kqcm,percrit,lgchek,me)
1869 call qcmxmn(
'stc1f ',stcfcs(1,1),slmskl,snofcs,icefl1,
1870 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1871 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1872 & rla,rlo,len,kqcm,percrit,lgchek,me)
1874 call qcmxmn(
'stc2f ',stcfcs(1,2),slmskl,snofcs,icefl1,
1875 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1876 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1877 & rla,rlo,len,kqcm,percrit,lgchek,me)
1886 orogd = orog - orog_uf
1892 if ( index(fntg3c,
"tileX.nc") == 0)
then
1894 call tsfcor(tg3fcs,orogd,slmskl,ztsfc,len,-rlapse)
1897 call tsfcor(tsffcs,orogd,slmskw,ztsfc,len,-rlapse)
1900 call tsfcor(tsffcs,orog,slmskw,ztsfc,len,-rlapse)
1909 if(smcfcs(i,j) /= 0.)
then
1910 swratio(i,j) = slcfcs(i,j)/smcfcs(i,j)
1912 swratio(i,j) = -999.
1918 if (lqcbgs .and. irtacn == 0)
then
1919 call qcsli(slianl,slifcs,len,me)
1920 call albocn(albfcs,slmskl,albomx,len)
1922 icefl2(i) = sicfcs(i) .gt. 0.99999
1925 call qcmxmn(
'snof ',snofcs,slifcs,snofcs,icefl1,
1926 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
1927 & snojmx,snojmn,snosmx,snosmn,epssno,
1928 & rla,rlo,len,kqcm,percrit,lgchek,me)
1929 call qcmxmn(
'tsff ',tsffcs,slifcs,snofcs,icefl2,
1930 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1931 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1932 & rla,rlo,len,kqcm,percrit,lgchek,me)
1934 call qcmxmn(
'albf ',albfcs(1,kk),slifcs,snofcs,icefl1,
1935 & alblmx,alblmn,albomx,albomn,albimx,albimn,
1936 & albjmx,albjmn,albsmx,albsmn,epsalb,
1937 & rla,rlo,len,kqcm,percrit,lgchek,me)
1939 if(fnwetc(1:8) /=
' ' .or. fnweta(1:8) /=
' ' )
1941 call qcmxmn(
'wetf ',wetfcs,slifcs,snofcs,icefl1,
1942 & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn,
1943 & wetjmx,wetjmn,wetsmx,wetsmn,epswet,
1944 & rla,rlo,len,kqcm,percrit,lgchek,me)
1946 call qcmxmn(
'zorf ',zorfcs,slifcs,snofcs,icefl1,
1947 & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn,
1948 & zorjmx,zorjmn,zorsmx,zorsmn,epszor,
1949 & rla,rlo,len,kqcm,percrit,lgchek,me)
1957 call qcmxmn(
'tg3f ',tg3fcs,slmskl,snofcs,icefl1,
1958 & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn,
1959 & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3,
1960 & rla,rlo,len,kqcm,percrit,lgchek,me)
1962 call qcmxmn(
'sihf ',sihfcs,slifcs,snofcs,icefl1,
1963 & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn,
1964 & sihjmx,sihjmn,sihsmx,sihsmn,epssih,
1965 & rla,rlo,len,kqcm,percrit,lgchek,me)
1975 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1976 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1977 & rla,rlo,len,kqcm,percrit,lgchek,me)
1984 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1985 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1986 & rla,rlo,len,kqcm,percrit,lgchek,me)
1989 call qcmxmn(
'vegf ',vegfcs,slmskl,snofcs,icefl1,
1990 & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn,
1991 & vegjmx,vegjmn,vegsmx,vegsmn,epsveg,
1992 & rla,rlo,len,kqcm,percrit,lgchek,me)
1994 call qcmxmn(
'vetf ',vetfcs,slmskl,snofcs,icefl1,
1995 & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn,
1996 & vetjmx,vetjmn,vetsmx,vetsmn,epsvet,
1997 & rla,rlo,len,kqcm,percrit,lgchek,me)
1999 call qcmxmn(
'sotf ',sotfcs,slmskl,snofcs,icefl1,
2000 & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn,
2001 & sotjmx,sotjmn,sotsmx,sotsmn,epssot,
2002 & rla,rlo,len,kqcm,percrit,lgchek,me)
2003 call qcmxmn(
'socf ',socfcs,slmskl,snofcs,icefl1,
2004 & soclmx,soclmn,socomx,socomn,socimx,socimn,
2005 & socjmx,socjmn,socsmx,socsmn,epssoc,
2006 & rla,rlo,len,kqcm,percrit,lgchek,me)
2011 call qcmxmn(
'vmnf ',vmnfcs,slmskl,snofcs,icefl1,
2012 & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn,
2013 & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn,
2014 & rla,rlo,len,kqcm,percrit,lgchek,me)
2016 call qcmxmn(
'vmxf ',vmxfcs,slmskl,snofcs,icefl1,
2017 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn,
2018 & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx,
2019 & rla,rlo,len,kqcm,percrit,lgchek,me)
2021 call qcmxmn(
'slpf ',slpfcs,slmskl,snofcs,icefl1,
2022 & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn,
2023 & slpjmx,slpjmn,slpsmx,slpsmn,epsslp,
2024 & rla,rlo,len,kqcm,percrit,lgchek,me)
2025 call qcmxmn(
'absf ',absfcs,slifcs,snofcs,icefl1,
2026 & abslmx,abslmn,absomx,absomn,absimx,absimn,
2027 & absjmx,absjmn,abssmx,abssmn,epsabs,
2028 & rla,rlo,len,kqcm,percrit,lgchek,me)
2036 print *,
'monitor of guess'
2040 call monitr(
'tsffcs',tsffcs,slifcs,snofcs,len)
2041 call monitr(
'albfcs',albfcs,slifcs,snofcs,len)
2042 call monitr(
'aisfcs',aisfcs,slifcs,snofcs,len)
2043 call monitr(
'snofcs',snofcs,slifcs,snofcs,len)
2045 call monitr(
message(
'smcfcs',k),smcfcs(1,k),slifcs,snofcs,len)
2046 call monitr(
message(
'stcfcs',k),stcfcs(1,k),slifcs,snofcs,len)
2048 call monitr(
'tg3fcs',tg3fcs,slifcs,snofcs,len)
2049 call monitr(
'zorfcs',zorfcs,slifcs,snofcs,len)
2051 call monitr(
'cvafcs',cvfcs ,slifcs,snofcs,len)
2052 call monitr(
'cvbfcs',cvbfcs,slifcs,snofcs,len)
2053 call monitr(
'cvtfcs',cvtfcs,slifcs,snofcs,len)
2055 call monitr(
'slifcs',slifcs,slifcs,snofcs,len)
2057 call monitr(
'orog ',orog ,slifcs,snofcs,len)
2058 call monitr(
'vegfcs',vegfcs,slifcs,snofcs,len)
2059 call monitr(
'vetfcs',vetfcs,slifcs,snofcs,len)
2060 call monitr(
'sotfcs',sotfcs,slifcs,snofcs,len)
2061 call monitr(
'socfcs',socfcs,slifcs,snofcs,len)
2063 call monitr(
'sihfcs',sihfcs,slifcs,snofcs,len)
2064 call monitr(
'sicfcs',sicfcs,slifcs,snofcs,len)
2066 call monitr(
'vmnfcs',vmnfcs,slifcs,snofcs,len)
2067 call monitr(
'vmxfcs',vmxfcs,slifcs,snofcs,len)
2068 call monitr(
'slpfcs',slpfcs,slifcs,snofcs,len)
2069 call monitr(
'absfcs',absfcs,slifcs,snofcs,len)
2079 if (nint(slmskl(i)) /= 1)
then
2080 if (sicanl(i) >= min_ice(i))
then
2081 slianl(i) = 2.0_kind_io8
2089 if (fh-deltsfc > -0.001 )
then
2091 if(slianl(i) == 0.0)
then
2092 tsffcs(i) = tsffcs(i) + (tsfclm(i) - tsfcl2(i))
2099 call qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi,len,lsoil,
2100 & snoanl,aisanl,slianl,tsfanl,albanl,
2102 & smcclm,tsfsmx,albomx,zoromx,me)
2107 write(6,*)
'=============='
2108 write(6,*)
' merging'
2109 write(6,*)
'=============='
2120 call merge(len,lsoil,iy,im,id,ih,fh,deltsfc,
2121 & slmskl,slmskw,sihfcs,sicfcs,
2122 & vmnfcs,vmxfcs,slpfcs,absfcs,
2123 & tsffcs,wetfcs,snofcs,zorfcs,albfcs,aisfcs,
2124 & cvfcs ,cvbfcs,cvtfcs,
2125 & cnpfcs,smcfcs,stcfcs,slifcs,vegfcs,
2126 & vetfcs,sotfcs,socfcs,alffcs,
2128 & vmnanl,vmxanl,slpanl,absanl,
2129 & tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl,
2130 & cvanl ,cvbanl,cvtanl,
2131 & cnpanl,smcanl,stcanl,slianl,veganl,
2132 & vetanl,sotanl,socanl,alfanl,
2133 & ctsfl,calbl,caisl,csnol,csmcl,czorl,cstcl,cvegl,
2134 & ctsfs,calbs,caiss,csnos,csmcs,czors,cstcs,cvegs,
2135 & ccv,ccvb,ccvt,ccnp,cvetl,cvets,csotl,csots,csocl,csocs,
2137 & csihl,csihs,csicl,csics,
2138 & cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps,cabsl,cabss,
2139 & irttsf,irtwet,irtsno,irtzor,irtalb,irtais,
2140 & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg,
2141 & irtvmn,irtvmx,irtslp,irtabs,
2142 & irtvet,irtsot,irtsoc,irtalf,landice,me)
2144 call setzro(snoanl,epssno,len)
2154 call newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil,
2156 & sihnew,aislim,sihanl,sicanl,
2157 & albanl,snoanl,zoranl,smcanl,stcanl,
2158 & albomx,snoomx,zoromx,smcomx,smcimx,
2161 & tsfomn,tsfimx,albimn,zorimx,tgice,
2170 call snosfc(snoanl,tsfanl,tsfsmx,len,me)
2173 icefl2(i) = sicanl(i) > 0.99999
2176 call qcmxmn(
'snowm ',snoanl,slianl,snoanl,icefl1,
2177 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
2178 & snojmx,snojmn,snosmx,snosmn,epssno,
2179 & rla,rlo,len,kqcm,percrit,lgchek,me)
2180 call qcmxmn(
'tsfm ',tsfanl,slianl,snoanl,icefl2,
2181 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
2182 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
2183 & rla,rlo,len,kqcm,percrit,lgchek,me)
2185 call qcmxmn(
'albm ',albanl(1,kk),slianl,snoanl,icefl1,
2186 & alblmx,alblmn,albomx,albomn,albimx,albimn,
2187 & albjmx,albjmn,albsmx,albsmn,epsalb,
2188 & rla,rlo,len,kqcm,percrit,lgchek,me)
2190 if(fnwetc(1:8) /=
' ' .or. fnweta(1:8) /=
' ')
then
2191 call qcmxmn(
'wetm ',wetanl,slianl,snoanl,icefl1,
2192 & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn,
2193 & wetjmx,wetjmn,wetsmx,wetsmn,epswet,
2194 & rla,rlo,len,kqcm,percrit,lgchek,me)
2196 call qcmxmn(
'zorm ',zoranl,slianl,snoanl,icefl1,
2197 & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn,
2198 & zorjmx,zorjmn,zorsmx,zorsmn,epszor,
2199 & rla,rlo,len,kqcm,percrit,lgchek,me)
2209 call qcmxmn(
message(
'stcm',k),stcanl(1,k),slmskl,snoanl,icefl1,
2210 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
2211 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
2212 & rla,rlo,len,kqcm,percrit,lgchek,me)
2216 call qcmxmn(
message(
'smcm',k),smcanl(1,k),slmskl,snoanl,icefl1,
2217 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
2218 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
2219 & rla,rlo,len,kqcm,percrit,lgchek,me)
2223 call qcmxmn(
'vegm ',veganl,slmskl,snoanl,icefl1,
2224 & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn,
2225 & vegjmx,vegjmn,vegsmx,vegsmn,epsveg,
2226 & rla,rlo,len,kqcm,percrit,lgchek,me)
2228 call qcmxmn(
'vetm ',vetanl,slmskl,snoanl,icefl1,
2229 & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn,
2230 & vetjmx,vetjmn,vetsmx,vetsmn,epsvet,
2231 & rla,rlo,len,kqcm,percrit,lgchek,me)
2233 call qcmxmn(
'sotm ',sotanl,slmskl,snoanl,icefl1,
2234 & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn,
2235 & sotjmx,sotjmn,sotsmx,sotsmn,epssot,
2236 & rla,rlo,len,kqcm,percrit,lgchek,me)
2238 call qcmxmn(
'socm ',socanl,slmskl,snoanl,icefl1,
2239 & soclmx,soclmn,socomx,socomn,socimx,socimn,
2240 & socjmx,socjmn,socsmx,socsmn,epssoc,
2241 & rla,rlo,len,kqcm,percrit,lgchek,me)
2243 call qcmxmn(
'sihm ',sihanl,slianl,snoanl,icefl1,
2244 & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn,
2245 & sihjmx,sihjmn,sihsmx,sihsmn,epssih,
2246 & rla,rlo,len,kqcm,percrit,lgchek,me)
2253 call qcmxmn(
'vmnm ',vmnanl,slmskl,snoanl,icefl1,
2254 & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn,
2255 & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn,
2256 & rla,rlo,len,kqcm,percrit,lgchek,me)
2258 call qcmxmn(
'vmxm ',vmxanl,slmskl,snoanl,icefl1,
2259 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn,
2260 & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx,
2261 & rla,rlo,len,kqcm,percrit,lgchek,me)
2263 call qcmxmn(
'slpm ',slpanl,slmskl,snoanl,icefl1,
2264 & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn,
2265 & slpjmx,slpjmn,slpsmx,slpsmn,epsslp,
2266 & rla,rlo,len,kqcm,percrit,lgchek,me)
2267 call qcmxmn(
'absm ',absanl,slianl,snoanl,icefl1,
2268 & abslmx,abslmn,absomx,absomn,absimx,absimn,
2269 & absjmx,absjmn,abssmx,abssmn,epsabs,
2270 & rla,rlo,len,kqcm,percrit,lgchek,me)
2274 write(6,*)
'=============='
2275 write(6,*)
'final results'
2276 write(6,*)
'=============='
2288 if ( index(fntg3c,
"tileX.nc") == 0)
then
2290 call tsfcor(tg3anl,orogd,slmskl,ztsfc,len,rlapse)
2293 call tsfcor(tsfanl,orogd,slmskw,ztsfc,len,rlapse)
2296 call tsfcor(tsfanl,orog,slmskw,ztsfc,len,rlapse)
2305 print *,
'monitor of updated surface fields'
2306 print *,
' (includes angulation correction)'
2310 call monitr(
'tsfanl',tsfanl,slianl,snoanl,len)
2311 call monitr(
'albanl',albanl,slianl,snoanl,len)
2312 call monitr(
'aisanl',aisanl,slianl,snoanl,len)
2313 call monitr(
'snoanl',snoanl,slianl,snoanl,len)
2315 call monitr(
message(
'smcanl',k),smcanl(1,k),slianl,snoanl,len)
2316 call monitr(
message(
'stcanl',k),stcanl(1,k),slianl,snoanl,len)
2319 call monitr(
'tg3anl',tg3anl,slianl,snoanl,len)
2320 call monitr(
'zoranl',zoranl,slianl,snoanl,len)
2323 call monitr(
'cvaanl',cvanl ,slianl,snoanl,len)
2324 call monitr(
'cvbanl',cvbanl,slianl,snoanl,len)
2325 call monitr(
'cvtanl',cvtanl,slianl,snoanl,len)
2327 call monitr(
'slianl',slianl,slianl,snoanl,len)
2329 call monitr(
'orog ',orog ,slianl,snoanl,len)
2330 call monitr(
'cnpanl',cnpanl,slianl,snoanl,len)
2331 call monitr(
'veganl',veganl,slianl,snoanl,len)
2332 call monitr(
'vetanl',vetanl,slianl,snoanl,len)
2333 call monitr(
'sotanl',sotanl,slianl,snoanl,len)
2334 call monitr(
'socanl',socanl,slianl,snoanl,len)
2336 call monitr(
'sihanl',sihanl,slianl,snoanl,len)
2337 call monitr(
'sicanl',sicanl,slianl,snoanl,len)
2339 call monitr(
'vmnanl',vmnanl,slianl,snoanl,len)
2340 call monitr(
'vmxanl',vmxanl,slianl,snoanl,len)
2341 call monitr(
'slpanl',slpanl,slianl,snoanl,len)
2342 call monitr(
'absanl',absanl,slianl,snoanl,len)
2347 allocate (tsffcsd(len), snofcsd(len), tg3fcsd(len), &
2348 & zorfcsd(len), slifcsd(len), aisfcsd(len), &
2349 & cnpfcsd(len), vegfcsd(len), vetfcsd(len), &
2350 & sotfcsd(len), socfcsd(len),sihfcsd(len), &
2352 & vmnfcsd(len), vmxfcsd(len), slpfcsd(len), &
2354 allocate (smcfcsd(len,lsoil), stcfcsd(len,lsoil), &
2357 tsffcsd(i) = tsfanl(i) - tsffcs(i)
2358 snofcsd(i) = snoanl(i) - snofcs(i)
2359 tg3fcsd(i) = tg3anl(i) - tg3fcs(i)
2360 zorfcsd(i) = zoranl(i) - zorfcs(i)
2363 slifcsd(i) = slianl(i) - slifcs(i)
2364 aisfcsd(i) = aisanl(i) - aisfcs(i)
2365 cnpfcsd(i) = cnpanl(i) - cnpfcs(i)
2366 vegfcsd(i) = veganl(i) - vegfcs(i)
2367 vetfcsd(i) = vetanl(i) - vetfcs(i)
2368 sotfcsd(i) = sotanl(i) - sotfcs(i)
2369 socfcsd(i) = socanl(i) - socfcs(i)
2371 sihfcsd(i) = sihanl(i) - sihfcs(i)
2372 sicfcsd(i) = sicanl(i) - sicfcs(i)
2374 vmnfcsd(i) = vmnanl(i) - vmnfcs(i)
2375 vmxfcsd(i) = vmxanl(i) - vmxfcs(i)
2376 slpfcsd(i) = slpanl(i) - slpfcs(i)
2377 absfcsd(i) = absanl(i) - absfcs(i)
2381 smcfcsd(i,j) = smcanl(i,j) - smcfcs(i,j)
2382 stcfcsd(i,j) = stcanl(i,j) - stcfcs(i,j)
2387 albfcsd(i,j) = albanl(i,j) - albfcs(i,j)
2395 print *,
'monitor of difference'
2396 print *,
' (includes angulation correction)'
2398 call monitr(
'tsfdif', tsffcsd,slianl,snoanl,len)
2399 call monitr(
'albdif', albfcsd,slianl,snoanl,len)
2400 call monitr(
'albdif1',albfcsd,slianl,snoanl,len)
2401 call monitr(
'albdif2',albfcsd(1,2),slianl,snoanl,len)
2402 call monitr(
'albdif3',albfcsd(1,3),slianl,snoanl,len)
2403 call monitr(
'albdif4',albfcsd(1,4),slianl,snoanl,len)
2404 call monitr(
'aisdif', aisfcsd,slianl,snoanl,len)
2405 call monitr(
'snodif', snofcsd,slianl,snoanl,len)
2407 call monitr(
message(
'smcanl',k),smcfcsd(1,k),slianl,snoanl,len)
2408 call monitr(
message(
'stcanl',k),stcfcsd(1,k),slianl,snoanl,len)
2410 call monitr(
'tg3dif',tg3fcsd,slianl,snoanl,len)
2411 call monitr(
'zordif',zorfcsd,slianl,snoanl,len)
2413 call monitr(
'cvadif',cvfcs ,slianl,snoanl,len)
2414 call monitr(
'cvbdif',cvbfcs,slianl,snoanl,len)
2415 call monitr(
'cvtdif',cvtfcs,slianl,snoanl,len)
2417 call monitr(
'slidif',slifcsd,slianl,snoanl,len)
2419 call monitr(
'cnpdif',cnpfcsd,slianl,snoanl,len)
2420 call monitr(
'vegdif',vegfcsd,slianl,snoanl,len)
2421 call monitr(
'vetdif',vetfcsd,slianl,snoanl,len)
2422 call monitr(
'sotdif',sotfcsd,slianl,snoanl,len)
2423 call monitr(
'socdif',socfcsd,slianl,snoanl,len)
2425 call monitr(
'sihdif',sihfcsd,slianl,snoanl,len)
2426 call monitr(
'sicdif',sicfcsd,slianl,snoanl,len)
2428 call monitr(
'vmndif',vmnfcsd,slianl,snoanl,len)
2429 call monitr(
'vmxdif',vmxfcsd,slianl,snoanl,len)
2430 call monitr(
'slpdif',slpfcsd,slianl,snoanl,len)
2431 call monitr(
'absdif',absfcsd,slianl,snoanl,len)
2433 deallocate (tsffcsd, snofcsd, tg3fcsd, zorfcsd, slifcsd, &
2434 & aisfcsd, cnpfcsd, vegfcsd, vetfcsd, sotfcsd,socfcsd, &
2435 & sihfcsd, sicfcsd, vmnfcsd, vmxfcsd, slpfcsd, &
2437 deallocate (smcfcsd, stcfcsd, albfcsd)
2442 tsffcs(i) = tsfanl(i)
2443 snofcs(i) = snoanl(i)
2444 tg3fcs(i) = tg3anl(i)
2445 zorfcs(i) = zoranl(i)
2448 slifcs(i) = slianl(i)
2449 aisfcs(i) = aisanl(i)
2451 cvbfcs(i) = cvbanl(i)
2452 cvtfcs(i) = cvtanl(i)
2453 cnpfcs(i) = cnpanl(i)
2454 vegfcs(i) = veganl(i)
2455 vetfcs(i) = vetanl(i)
2456 sotfcs(i) = sotanl(i)
2457 socfcs(i) = socanl(i)
2459 vmnfcs(i) = vmnanl(i)
2460 vmxfcs(i) = vmxanl(i)
2461 slpfcs(i) = slpanl(i)
2462 absfcs(i) = absanl(i)
2466 smcfcs(i,j) = smcanl(i,j)
2467 if (slifcs(i) > 0.0_kind_io8)
then
2468 stcfcs(i,j) = stcanl(i,j)
2470 stcfcs(i,j) = tsffcs(i)
2478 albfcs(i,j) = albanl(i,j)
2483 alffcs(i,j) = alfanl(i,j)
2490 if (slmskw(i) ==
zero)
then
2492 if (sicanl(i) >= crit)
then
2493 sihfcs(i) = sihanl(i)
2494 sitfcs(i) = tsffcs(i)
2495 if (sicfcs(i) >= crit)
then
2496 tem1 = 1.0_kind_io8 / sicfcs(i)
2497 tsffcs(i) = (sicanl(i)*tsffcs(i)
2498 & + (sicfcs(i)-sicanl(i))*tgice) * tem1
2499 sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) * tem1
2500 sicfcs(i) = sicanl(i)
2504 sicfcs(i) = sicanl(i)
2508 tsffcs(i) = tsfanl(i)
2512 sitfcs(i) = tsffcs(i)
2515 if (slifcs(i) > 1.5_kind_io8 .and. sicfcs(i) < crit)
then
2516 print *,
'warning: check, slifcs and sicfcs', &
2517 & slifcs(i),sicfcs(i)
2539 fixratio(k) = .false.
2540 if (fsmcl(k) < 99999.) fixratio(k) = .true.
2544 print *,
'dbgx --fixratio:',(fixratio(k),k=1,lsoil)
2548 if(fixratio(k))
then
2550 if(swratio(i,k) == -999.)
then
2551 slcfcs(i,k) = smcfcs(i,k)
2553 slcfcs(i,k) = swratio(i,k) * smcfcs(i,k)
2555 if (slifcs(i) /= 1.0) slcfcs(i,k) = 1.0
2562 if (slifcs(i) == 1.0 .and.
2573 if(fsnol < 99999.)
then
2575 print *,
'dbgx -- scale snwdph from sheleg'
2578 if(slifcs(i) == 1.) swdfcs(i) = 10.* snofcs(i)
2587 if (slifcs(i) /= 1) swdfcs(i) = 3.*snofcs(i)
2591 if(slifcs(i) == 1.)
then
2592 if(snofcs(i) /= 0. .and. swdfcs(i) == 0.)
then
2593 print *,
'dbgx --scale snwdph from sheleg', &
2594 & i, swdfcs(i), snofcs(i)
2595 swdfcs(i) = 10.* snofcs(i)
2606 if (slifcs(i) == 1.0 .and. &
2608 snofcs(i) = max(snofcs(i),100.0)
2609 swdfcs(i) = max(swdfcs(i),1000.0)
2610 tg3fcs(i) = min(tg3fcs(i),273.15)
2611 tsffcs(i) = min(tsffcs(i),273.15)
2616 if (nint(slmskl(i)) == 1 .and. nint(slmskw(i)) == 0)
then
2617 slifcs(i) = slmskl(i)
7052 subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, &
7053 & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, &
7054 & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, &
7055 & fnvetc,fnsotc,fnsocc, &
7056 & fnvmnc,fnvmxc,fnslpc,fnabsc, &
7057 & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm,&
7058 & tg3clm,cvclm ,cvbclm,cvtclm, &
7059 & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm,&
7060 & vetclm,sotclm,socclm,alfclm, &
7061 & vmnclm,vmxclm,slpclm,absclm, &
7062 & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais, &
7063 & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, &
7064 & kpdvet,kpdsot,kpdsoc,kpdalf,tsfcl0, &
7065 & kpdvmn,kpdvmx,kpdslp,kpdabs, &
7067 &, imsk, jmsk, slmskh, outlat, outlon &
7068 &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb &
7069 &, tile_num_ch, i_index, j_index)
7071 use machine ,
only : kind_io8,kind_io4, kind_dbl_prec
7073 character(len=*),
intent(in) :: tile_num_ch
7074 integer,
intent(in) :: i_index(len), j_index(len)
7075 real (kind=kind_io8) rjday,wei1x,wei2x,rjdayh,wei2m,wei1m,wei1s, &
7076 & wei2s,fh,stcmon1s,blto,blno,deltsfc,rjdayh2
7077 real (kind=kind_io8) wei1y,wei2y
7078 integer jdoy,jday,jh,jdow,mmm,mmp,mm,iret,monend,i,k,jm,jd,iy4, &
7079 & jy,mon1,is2,isx,kpd9,is1,l,nn,mon2,mon,is,kpdsno, &
7080 & kpdzor,kpdtsf,kpdwet,kpdscv,kpdacn,kpdais,kpdtg3,im,id, &
7081 & lugb,iy,len,lsoil,ih,kpdsmc,iprnt,me,m1,m2,k1,k2, &
7082 & kpdvet,kpdsot,kpdsoc,kpdstc,kpdveg,jmsk,imsk,j,ialb &
7083 &, kpdvmn,kpdvmx,kpdslp,kpdabs,landice_cat
7084 integer kpdalb(4), kpdalf(2)
7086 character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, &
7087 & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, &
7088 & fnvetc,fnsotc,fnsocc,fnalbc2 &
7089 &, fnvmnc,fnvmxc,fnslpc,fnabsc
7090 real (kind=kind_io8) tsfclm(len),tsfcl2(len), &
7091 & wetclm(len),snoclm(len), &
7092 & zorclm(len),albclm(len,4),aisclm(len), &
7093 & tg3clm(len),acnclm(len), &
7094 & cvclm (len),cvbclm(len),cvtclm(len), &
7096 & smcclm(len,lsoil),stcclm(len,lsoil), &
7097 & sliclm(len),scvclm(len),vegclm(len), &
7098 & vetclm(len),sotclm(len),socclm(len),alfclm(len,2) &
7099 &, vmnclm(len),vmxclm(len),slpclm(len),absclm(len)
7100 real (kind=kind_io8) slmskh(imsk,jmsk)
7101 real (kind=kind_io8) outlat(len), outlon(len)
7103 real (kind=kind_io8) slmskl(len), slmskw(len), tsfcl0(len)
7104 real (kind=kind_io8),
allocatable :: slmask_noice(:)
7106 logical lanom, gaus, first
7109 real (kind=kind_io8) z0_sib(13)
7110 data z0_sib /2.653, 0.826, 0.563, 1.089, 0.854, 0.856,
7111 & 0.035, 0.238, 0.065, 0.076, 0.011, 0.125,
7114 real (kind=kind_io8) z0_igbp_min(20), z0_igbp_max(20)
7115 real (kind=kind_io8) z0_season(12)
7116 data z0_igbp_min /1.089, 2.653, 0.854, 0.826, 0.800, 0.050,
7117 & 0.030, 0.856, 0.856, 0.150, 0.040, 0.130,
7118 & 1.000, 0.250, 0.011, 0.011, 0.001, 0.076,
7120 data z0_igbp_max /1.089, 2.653, 0.854, 0.826, 0.800, 0.050,
7121 & 0.030, 0.856, 0.856, 0.150, 0.040, 0.130,
7122 & 1.000, 0.250, 0.011, 0.011, 0.001, 0.076,
7127 real (kind=kind_io8) dayhf(13)
7128 data dayhf/ 15.5, 45.0, 74.5,105.0,135.5,166.0,
7129 & 196.5,227.5,258.0,288.5,319.0,349.5,380.5/
7131 real (kind=kind_dbl_prec) fha(5)
7132 integer ida(8),jda(8),ivtyp, kpd7
7134 real (kind=kind_io8),
allocatable :: tsf(:,:),sno(:,:),
7135 & zor(:,:),wet(:,:),
7136 & ais(:,:), acn(:,:), scv(:,:), smc(:,:,:),
7137 & tg3(:), alb(:,:,:), alf(:,:),
7138 & vet(:), sot(:), soc(:), tsf2(:),
7139 & veg(:,:), stc(:,:,:)
7140 &, vmn(:), vmx(:), slp(:), absm(:)
7142 integer mon1s, mon2s, sea1s, sea2s, sea1, sea2, hyr1, hyr2
7144 data mon1s/0/, mon2s/0/, sea1s/0/, sea2s/0/
7146 save first, tsf, sno, zor, wet, ais, acn, scv, smc, tg3,
7147 & alb, alf, vet, sot, soc,tsf2, veg, stc,
7148 & vmn, vmx, slp, absm,
7149 & mon1s, mon2s, sea1s, sea2s, dayhf, k1, k2, m1, m2,
7167 sliclm(i) = slmskl(i)
7198 allocate (tsf(len,2), sno(len,2), zor(len,2),
7199 & wet(len,2), ais(len,2), acn(len,2),
7200 & scv(len,2), smc(len,lsoil,2),
7201 & tg3(len), alb(len,4,2), alf(len,2),
7202 & vet(len), sot(len), soc(len),tsf2(len),
7204 & vmn(len), vmx(len), slp(len), absm(len),
7205 & veg(len,2), stc(len,lsoil,2))
7211 if (me == 0) print*,
'bosu fh gt 0'
7214 if (iy < 101) iy4 = 1900 + iy4
7223 call w3movdat(fha,ida,jda)
7228 if (me == 0)
write(6,*)
' forecast jy,jm,jd,jh',
7233 call w3doxdat(jda,jdow,jdoy,jday)
7234 rjday = jdoy + jda(5) / 24.
7235 if(rjday < dayhf(1)) rjday = rjday + 365.
7237 if (me == 0)
write(6,*)
'forecast jy,jm,jd,jh=',jy,jm,jd,jh
7245 if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp))
then
7251 print *,
'FATAL ERROR: wrong rjday',rjday
7254 wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1))
7257 if (mon2 == 13) mon2 = 1
7258 if (me == 0) print *,
'rjday,mon1,mon2,wei1m,wei2m=',
7259 & rjday,mon1,mon2,wei1m,wei2m
7266 if (nn == 2) mon = mon2
7267 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmskw,
7268 & tsf(1,nn),len,iret
7269 &, imsk, jmsk, slmskh, gaus,blno, blto
7270 &, outlat, outlon, me)
7276 tsfcl0(i) = wei1m * tsf(i,1) + wei2m * tsf(i,2)
7284 if (iy < 101) iy4=1900+iy4
7293 call w3movdat(fha,ida,jda)
7303 call w3doxdat(jda,jdow,jdoy,jday)
7304 rjday = jdoy + jda(5) / 24.
7305 if(rjday < dayhf(1)) rjday = rjday + 365.
7307 if (me == 0)
write(6,*)
' forecast jy,jm,jd,jh,rjday=',
7310 if (me == 0)
write(6,*)
'forecast jy,jm,jd,jh=',jy,jm,jd,jh
7318 if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp))
then
7324 print *,
'FATAL ERROR: wrong rjday',rjday
7327 wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1))
7330 if (mon2 == 13) mon2 = 1
7331 if (me == 0) print *,
'rjday,mon1,mon2,wei1m,wei2m=',
7332 & rjday,mon1,mon2,wei1m,wei2m
7342 if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp))
then
7348 print *,
'FATAL ERROR: wrong rjday',rjday
7351 wei1s = (dayhf(sea2)-rjday)/(dayhf(sea2)-dayhf(sea1))
7354 if (sea2 == 13) sea2 = 1
7355 if (me == 0) print *,
'rjday,sea1,sea2,wei1s,wei2s=',
7356 & rjday,sea1,sea2,wei1s,wei2s
7366 if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp))
then
7372 print *,
'FATAL ERROR: wrong rjday',rjday
7375 wei1y = (dayhf(hyr2)-rjday)/(dayhf(hyr2)-dayhf(hyr1))
7378 if (hyr2 == 13) hyr2 = 1
7379 if (me == 0) print *,
'rjday,hyr1,hyr2,wei1y,wei2y=',
7380 & rjday,hyr1,hyr2,wei1y,wei2y
7384 first_time :
if (first)
then
7386 if (me == 0) print*,
'bosu first time thru'
7400 if (ialb == 1 .or. ialb == 2)
then
7402 if ( index(fnalbc2,
"tileX.nc") == 0)
then
7403 call fixrdc(lugb,fnalbc2,kpdalf(1),kpd7,kpd9,slmskl
7405 &, imsk, jmsk, slmskh, gaus,blno, blto
7406 &, outlat, outlon, me)
7408 call fixrdc_tile(fnalbc2, tile_num_ch, i_index, j_index,
7409 & kpdalf(1), alf(:,1), 1, len, me)
7412 call fixrdc(lugb,fnalbc,kpdalf(1),kpd7,kpd9,slmskl
7414 &, imsk, jmsk, slmskh, gaus,blno, blto
7415 &, outlat, outlon, me)
7418 if(slmskl(i) == 1.)
then
7419 alf(i,2) = 100. - alf(i,1)
7425 if(fntg3c(1:8).ne.
' ')
then
7426 if ( index(fntg3c,
"tileX.nc") == 0)
then
7428 call fixrdc(lugb,fntg3c,kpdtg3,kpd7,kpd9,slmskl,
7430 &, imsk, jmsk, slmskh, gaus,blno, blto
7431 &, outlat, outlon, me)
7433 call fixrdc_tile(fntg3c, tile_num_ch, i_index, j_index,
7434 & kpdtg3, tg3, 1, len, me)
7443 if(fnvetc(1:8).ne.
' ')
then
7444 if ( index(fnvetc,
"tileX.nc") == 0)
then
7446 call fixrdc(lugb,fnvetc,kpdvet,kpd7,kpd9,slmskl,
7448 &, imsk, jmsk, slmskh, gaus,blno, blto
7449 &, outlat, outlon, me)
7451 if (maxval(vet)> 13.0) landice_cat=15
7453 call fixrdc_tile(fnvetc, tile_num_ch, i_index, j_index,
7454 & kpdvet, vet, 1, len, me)
7457 if (me .eq. 0)
write(6,*)
'climatological vegetation',
7459 elseif(index(fnsmcc,
'soilmgldas') /= 0)
then
7461 write(6,*)
'FATAL ERROR: must choose'
7462 write(6,*)
'climatological veg type when'
7463 write(6,*)
'using new gldas soil moisture.'
7468 if(fnsotc(1:8).ne.
' ')
then
7469 if ( index(fnsotc,
"tileX.nc") == 0)
then
7471 call fixrdc(lugb,fnsotc,kpdsot,kpd7,kpd9,slmskl,
7473 &, imsk, jmsk, slmskh, gaus,blno, blto
7474 &, outlat, outlon, me)
7476 call fixrdc_tile(fnsotc, tile_num_ch, i_index, j_index,
7477 & kpdsot, sot, 1, len, me)
7479 if (me .eq. 0)
write(6,*)
'climatological soil type read in.'
7485 If(fnsocc(1:8).ne.
' ')
then
7486 if ( index(fnsocc,
"tileX.nc") == 0)
then
7488 call fixrdc(lugb,fnsocc,kpdsoc,kpd7,kpd9,slmskl,
7490 &, imsk, jmsk, slmskh, gaus,blno, blto
7491 &, outlat, outlon, me)
7493 call fixrdc_tile(fnsocc, tile_num_ch, i_index, j_index,
7494 & 255, soc, 1, len, me)
7495 if (me .eq. 0)
write(6,*)
'Soil color data name is',fnsocc
7497 if (me .eq. 0)
write(6,*)
'climatological soil color read in.'
7503 if(fnvmnc(1:8).ne.
' ')
then
7504 if ( index(fnvmnc,
"tileX.nc") == 0)
then
7506 call fixrdc(lugb,fnvmnc,kpdvmn,kpd7,kpd9,slmskl,
7508 &, imsk, jmsk, slmskh, gaus,blno, blto
7509 &, outlat, outlon, me)
7511 call fixrdc_tile(fnvmnc, tile_num_ch, i_index, j_index,
7512 & 257, vmn, 99, len, me)
7515 if (me .eq. 0)
write(6,*)
'climatological shdmin read in.'
7520 if(fnvmxc(1:8).ne.
' ')
then
7521 if ( index(fnvmxc,
"tileX.nc") == 0)
then
7523 call fixrdc(lugb,fnvmxc,kpdvmx,kpd7,kpd9,slmskl,
7525 &, imsk, jmsk, slmskh, gaus,blno, blto
7526 &, outlat, outlon, me)
7528 call fixrdc_tile(fnvmxc, tile_num_ch, i_index, j_index,
7529 & 256, vmx, 99, len, me)
7531 if (me .eq. 0)
write(6,*)
'climatological shdmax read in.'
7536 if(fnslpc(1:8).ne.
' ')
then
7537 if ( index(fnslpc,
"tileX.nc") == 0)
then
7539 call fixrdc(lugb,fnslpc,kpdslp,kpd7,kpd9,slmskl,
7541 &, imsk, jmsk, slmskh, gaus,blno, blto
7542 &, outlat, outlon, me)
7544 call fixrdc_tile(fnslpc, tile_num_ch, i_index, j_index,
7545 & kpdslp, slp, 1, len, me)
7547 if (me .eq. 0)
write(6,*)
'climatological slope read in.'
7552 if(fnabsc(1:8).ne.
' ')
then
7553 if ( index(fnabsc,
"tileX.nc") == 0)
then
7555 call fixrdc(lugb,fnabsc,kpdabs,kpd7,kpd9,slmskl,
7557 &, imsk, jmsk, slmskh, gaus,blno, blto
7558 &, outlat, outlon, me)
7560 call fixrdc_tile(fnabsc, tile_num_ch, i_index, j_index,
7561 & kpdabs, absm, 1, len, me)
7563 if (me .eq. 0)
write(6,*)
'climatological snoalb read in.'
7569 if (is1 == 5) is1 = 1
7570 if (is2 == 5) is2 = 1
7579 if(isx == 1) kpd9 = 12
7580 if(isx == 2) kpd9 = 3
7581 if(isx == 3) kpd9 = 6
7582 if(isx == 4) kpd9 = 9
7594 call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,kpd9,slmskl,
7595 & alb(1,k,nn),len,iret
7596 &, imsk, jmsk, slmskh, gaus,blno, blto
7597 &, outlat, outlon, me)
7604 if (nn .eq. 2) mon = mon2
7607 if (ialb == 1 .or. ialb == 2)
then
7608 if ( index(fnalbc,
"tileX.nc") == 0)
then
7611 call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,mon,slmskl,
7612 & alb(1,k,nn),len,iret
7613 &, imsk, jmsk, slmskh, gaus,blno, blto
7614 &, outlat, outlon, me)
7618 call fixrdc_tile(fnalbc, tile_num_ch, i_index, j_index,
7619 & kpdalb(k), alb(:,k,nn), mon, len, me)
7629 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmskw,
7630 & tsf(1,nn),len,iret
7631 &, imsk, jmsk, slmskh, gaus,blno, blto
7632 &, outlat, outlon, me)
7651 if(fnwetc(1:8).ne.
' ')
then
7653 call fixrdc(lugb,fnwetc,kpdwet,kpd7,mon,slmskl,
7654 & wet(1,nn),len,iret
7655 &, imsk, jmsk, slmskh, gaus,blno, blto
7656 &, outlat, outlon, me)
7657 elseif(fnsmcc(1:8).ne.
' ')
then
7658 if (index(fnsmcc,
'global_soilmcpc.1x1.grb') /= 0)
then
7660 call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmskl,
7661 & smc(1,lsoil,nn),len,iret
7662 &, imsk, jmsk, slmskh, gaus,blno, blto
7663 &, outlat, outlon, me)
7666 smc(i,l,nn) = smc(i,lsoil,nn)
7672 allocate(slmask_noice(len))
7673 slmask_noice = slmskl
7675 if (nint(vet(i)) < 1 .or.
7676 & nint(vet(i)) == landice_cat)
then
7677 slmask_noice(i) = 0.0
7683 if (k==3) kpd7=10340
7684 if (k==4) kpd7=25800
7685 call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask_noice,
7686 & smc(1,k,nn),len,iret
7687 &, imsk, jmsk, slmskh, gaus,blno, blto
7688 &, outlat, outlon, me)
7690 deallocate(slmask_noice)
7693 write(6,*)
'FATAL ERROR: climatological soil wetness'
7694 write(6,*)
'file not given.'
7700 if(fnstcc(1:8).ne.
' ')
then
7702 call fixrdc(lugb,fnstcc,kpdstc,kpd7,mon,slmskl,
7703 & stc(1,lsoil,nn),len,iret
7704 &, imsk, jmsk, slmskh, gaus,blno, blto
7705 &, outlat, outlon, me)
7708 stc(i,l,nn) = stc(i,lsoil,nn)
7716 if(fnacnc(1:8).ne.
' ')
then
7717 call fixrdc(lugb,fnacnc,kpdacn,kpd7,mon,slmskw,
7718 & acn(1,nn),len,iret
7719 &, imsk, jmsk, slmskh, gaus,blno, blto
7720 &, outlat, outlon, me)
7721 elseif(fnaisc(1:8).ne.
' ')
then
7722 call fixrdc(lugb,fnaisc,kpdais,kpd7,mon,slmskw,
7723 & ais(1,nn),len,iret
7724 &, imsk, jmsk, slmskh, gaus,blno, blto
7725 &, outlat, outlon, me)
7727 write(6,*)
'FATAL ERROR: climatological ice cover'
7728 write(6,*)
'file not given.'
7735 call fixrdc(lugb,fnsnoc,kpdsno,kpd7,mon,slmskl,
7736 & sno(1,nn),len,iret
7737 &, imsk, jmsk, slmskh, gaus,blno, blto
7738 &, outlat, outlon, me)
7742 if(fnscvc(1:8).ne.
' ')
then
7744 call fixrdc(lugb,fnscvc,kpdscv,kpd7,mon,slmskl,
7745 & scv(1,nn),len,iret
7746 &, imsk, jmsk, slmskh, gaus,blno, blto
7747 &, outlat, outlon, me)
7748 write(6,*)
'climatological snow cover read in.'
7753 if(fnzorc(1:3) ==
'sib')
then
7755 write(6,*)
'roughness length to be set from sib veg type'
7757 elseif(fnzorc(1:4) ==
'igbp')
then
7759 write(6,*)
'roughness length to be set from igbp veg type'
7763 call fixrdc(lugb,fnzorc,kpdzor,kpd7,mon,slmskl,
7764 & zor(1,nn),len,iret
7765 &, imsk, jmsk, slmskh, gaus,blno, blto
7766 &, outlat, outlon, me)
7780 if(fnvegc(1:8).ne.
' ')
then
7781 if ( index(fnvegc,
"tileX.nc") == 0)
then
7783 call fixrdc(lugb,fnvegc,kpdveg,kpd7,mon,slmskl,
7784 & veg(1,nn),len,iret
7785 &, imsk, jmsk, slmskh, gaus,blno, blto
7786 &, outlat, outlon, me)
7788 call fixrdc_tile(fnvegc, tile_num_ch, i_index, j_index,
7789 & kpdveg, veg(:,nn), mon, len, me)
7791 if (me .eq. 0)
write(6,*)
'climatological vegetation',
7792 &
' cover read in for mon=',mon
7797 mon1s = mon1 ; mon2s = mon2 ; sea1s = sea1 ; sea2s = sea2
7799 if (me == 0) print *,
' mon1s=',mon1s,
' mon2s=',mon2s
7800 &,
' sea1s=',sea1s,
' sea2s=',sea2s
7811 rjdayh = rjday - deltsfc/24.0
7817 if (rjdayh .ge. dayhf(mon1))
then
7818 if (mon2 .eq. 1) mon2 = 13
7819 wei1x = (dayhf(mon2)-rjdayh)/(dayhf(mon2)-dayhf(mon1))
7821 if (mon2 .eq. 13) mon2 = 1
7824 if (rjdayh .lt. dayhf(1)) rjdayh2 = rjdayh2 + 365.0
7825 if (mon1s .eq. mon1)
then
7827 if (mon1s .eq. 0) mon1s = 12
7832 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmskw,
7833 & tsf(1,k1),len,iret
7834 &, imsk, jmsk, slmskh, gaus,blno, blto
7835 &, outlat, outlon, me)
7839 wei1x = (dayhf(mon2s)-rjdayh2)/(dayhf(mon2s)-dayhf(mon1s))
7841 if (mon2s .eq. 13) mon2s = 1
7843 tsf2(i) = wei1x * tsf(i,k1) + wei2x * tsf(i,k2)
7848 if (sea1 .ne. sea1s)
then
7857 if (isx == 5) isx = 1
7858 if (isx == 1) kpd9 = 12
7859 if (isx == 2) kpd9 = 3
7860 if (isx == 3) kpd9 = 6
7861 if (isx == 4) kpd9 = 9
7872 call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,kpd9,slmskl
7873 &, alb(1,k,m2),len,iret
7874 &, imsk, jmsk, slmskh, gaus,blno, blto
7875 &, outlat, outlon, me)
7881 if (mon1 .ne. mon1s)
then
7893 if (ialb == 1 .or. ialb == 2)
then
7894 if (me == 0) print*,
'bosu 2nd time in clima for month ',
7896 if ( index(fnalbc,
"tileX.nc") == 0)
then
7899 call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,mon,slmskl,
7900 & alb(1,k,nn),len,iret
7901 &, imsk, jmsk, slmskh, gaus,blno, blto
7902 &, outlat, outlon, me)
7906 call fixrdc_tile(fnalbc, tile_num_ch, i_index, j_index,
7907 & kpdalb(k), alb(:,k,nn), mon, len, me)
7915 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmskw,
7916 & tsf(1,nn),len,iret
7917 &, imsk, jmsk, slmskh, gaus,blno, blto
7918 &, outlat, outlon, me)
7922 if (fnwetc(1:8).ne.
' ')
then
7924 call fixrdc(lugb,fnwetc,kpdwet,kpd7,mon,slmskl,
7925 & wet(1,nn),len,iret
7926 &, imsk, jmsk, slmskh, gaus,blno, blto
7927 &, outlat, outlon, me)
7928 elseif (fnsmcc(1:8).ne.
' ')
then
7929 if (index(fnsmcc,
'global_soilmcpc.1x1.grb') /= 0)
then
7931 call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmskl,
7932 & smc(1,lsoil,nn),len,iret
7933 &, imsk, jmsk, slmskh, gaus,blno, blto
7934 &, outlat, outlon, me)
7937 smc(i,l,nn) = smc(i,lsoil,nn)
7943 allocate(slmask_noice(len))
7946 if (nint(vet(i)) < 1 .or.
7947 & nint(vet(i)) == landice_cat)
then
7948 slmask_noice(i) = 0.0
7954 if (k==3) kpd7=10340
7955 if (k==4) kpd7=25800
7956 call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask_noice,
7957 & smc(1,k,nn),len,iret
7958 &, imsk, jmsk, slmskh, gaus,blno, blto
7959 &, outlat, outlon, me)
7961 deallocate(slmask_noice)
7964 write(6,*)
'FATAL ERROR: climatological soil wetness'
7965 write(6,*)
'file not given.'
7972 if (fnacnc(1:8).ne.
' ')
then
7973 call fixrdc(lugb,fnacnc,kpdacn,kpd7,mon,slmskw,
7974 & acn(1,nn),len,iret
7975 &, imsk, jmsk, slmskh, gaus,blno, blto
7976 &, outlat, outlon, me)
7977 elseif (fnaisc(1:8).ne.
' ')
then
7978 call fixrdc(lugb,fnaisc,kpdais,kpd7,mon,slmskw,
7979 & ais(1,nn),len,iret
7980 &, imsk, jmsk, slmskh, gaus,blno, blto
7981 &, outlat, outlon, me)
7983 write(6,*)
'FATAL ERROR: climatological ice cover'
7984 write(6,*)
'file not given.'
7991 call fixrdc(lugb,fnsnoc,kpdsno,kpd7,mon,slmskl,
7992 & sno(1,nn),len,iret
7993 &, imsk, jmsk, slmskh, gaus,blno, blto
7994 &, outlat, outlon, me)
7998 if (fnscvc(1:8).ne.
' ')
then
8000 call fixrdc(lugb,fnscvc,kpdscv,kpd7,mon,slmskl,
8001 & scv(1,nn),len,iret
8002 &, imsk, jmsk, slmskh, gaus,blno, blto
8003 &, outlat, outlon, me)
8004 write(6,*)
'climatological snow cover read in.'
8009 if (fnzorc(1:3) ==
'sib')
then
8011 write(6,*)
'roughness length to be set from sib veg type'
8013 elseif(fnzorc(1:4) ==
'igbp')
then
8015 write(6,*)
'roughness length to be set from igbp veg type'
8019 call fixrdc(lugb,fnzorc,kpdzor,kpd7,mon,slmskl,
8020 & zor(1,nn),len,iret
8021 &, imsk, jmsk, slmskh, gaus,blno, blto
8022 &, outlat, outlon, me)
8027 if (fnvegc(1:8) .ne.
' ')
then
8028 if ( index(fnvegc,
"tileX.nc") == 0)
then
8030 call fixrdc(lugb,fnvegc,kpdveg,kpd7,mon,slmskl,
8031 & veg(1,nn),len,iret
8032 &, imsk, jmsk, slmskh, gaus,blno, blto
8033 &, outlat, outlon, me)
8035 call fixrdc_tile(fnvegc, tile_num_ch, i_index, j_index,
8036 & kpdveg, veg(:,nn), mon, len, me)
8049 if (fnzorc(1:3) ==
'sib')
then
8050 if (fnvetc(1:4) ==
' ')
then
8052 write(6,*)
"FATAL ERROR: must choose sib"
8053 write(6,*)
"vegetation type climo file."
8059 ivtyp = nint(vet(i))
8060 if (ivtyp >= 1 .and. ivtyp <= 13)
then
8061 zorclm(i) = z0_sib(ivtyp)
8064 elseif(fnzorc(1:4) ==
'igbp')
then
8065 if (fnvetc(1:4) ==
' ')
then
8067 write(6,*)
"FATAL ERROR: must choose igbp"
8068 write(6,*)
"vegetation type climo file."
8074 ivtyp = nint(vet(i))
8075 if (ivtyp >= 1 .and. ivtyp <= 20)
then
8076 z0_season(1) = z0_igbp_min(ivtyp)
8077 z0_season(7) = z0_igbp_max(ivtyp)
8078 if (outlat(i) < 0.0)
then
8079 zorclm(i) = wei1y * z0_season(hyr2) +
8080 & wei2y * z0_season(hyr1)
8082 zorclm(i) = wei1y * z0_season(hyr1) +
8083 & wei2y * z0_season(hyr2)
8089 zorclm(i) = wei1m * zor(i,k1) + wei2m * zor(i,k2)
8094 tsfclm(i) = wei1m * tsf(i,k1) + wei2m * tsf(i,k2)
8095 snoclm(i) = wei1m * sno(i,k1) + wei2m * sno(i,k2)
8105 if (fh .eq. 0.0)
then
8107 tsfcl0(i) = tsfclm(i)
8110 if (rjdayh .ge. dayhf(mon1))
then
8112 tsf2(i) = wei1x * tsf(i,k1) + wei2x * tsf(i,k2)
8121 if(fnacnc(1:8).ne.
' ')
then
8123 acnclm(i) = wei1m * acn(i,k1) + wei2m * acn(i,k2)
8125 elseif(fnaisc(1:8).ne.
' ')
then
8127 aisclm(i) = wei1m * ais(i,k1) + wei2m * ais(i,k2)
8131 if(fnwetc(1:8).ne.
' ')
then
8133 wetclm(i) = wei1m * wet(i,k1) + wei2m * wet(i,k2)
8135 elseif(fnsmcc(1:8).ne.
' ')
then
8138 smcclm(i,k) = wei1m * smc(i,k,k1) + wei2m * smc(i,k,k2)
8143 if(fnscvc(1:8).ne.
' ')
then
8145 scvclm(i) = wei1m * scv(i,k1) + wei2m * scv(i,k2)
8149 if(fntg3c(1:8).ne.
' ')
then
8153 elseif(fnstcc(1:8).ne.
' ')
then
8156 stcclm(i,k) = wei1m * stc(i,k,k1) + wei2m * stc(i,k,k2)
8161 if(fnvegc(1:8).ne.
' ')
then
8163 vegclm(i) = wei1m * veg(i,k1) + wei2m * veg(i,k2)
8167 if(fnvetc(1:8).ne.
' ')
then
8173 if(fnsotc(1:8).ne.
' ')
then
8185 if(fnsocc(1:8).ne.
' ')
then
8193 if(fnvmnc(1:8).ne.
' ')
then
8199 if(fnvmxc(1:8).ne.
' ')
then
8205 if(fnslpc(1:8).ne.
' ')
then
8211 if(fnabsc(1:8).ne.
' ')
then
8219 if (me == 0) print*,
'monthly albedo weights are ',
8220 & wei1m,
' for k', k1, wei2m,
' for k', k2
8222 if (ialb == 1 .or. ialb == 2)
then
8225 albclm(i,k) = wei1m * alb(i,k,k1) + wei2m * alb(i,k,k2)
8231 albclm(i,k) = wei1s * alb(i,k,m1) + wei2s * alb(i,k,m2)
8238 alfclm(i,k) = alf(i,k)