PGF90 (Version 12.8) 08/30/2020 00:27:46 page 1 Switches: -noasm -nodclchk -debug -nodlines -line -list -idir ../include -inform warn -opt 0 -nosave -object -noonetrip -depchk on -nostandard -symbol -noupcase Filename: qu2ll2.f90 ( 1) subroutine qu2ll2 ( 2) ( 3) USE mod_extra ( 4) USE mod_pvrbls ( 5) USE mod_vrbls ( 6) USE mod_pvrbls_ll ( 7) implicit none ( 8) include 'param_o.h' ( 9) !!JNT include 'extra.comm' ( 10) ( 11) !! real,dimension(0:im+1,0:jm+1,nm,lsm)::fsl,usl,vsl,ull,vll,qsl,tsl,q2sl ( 12) !! real,dimension(igm,jgm,lsm)::fsl_ll,hgt_ll,usp,vsp,qsl_ll,tsl_ll,q2sl_ll ../include/param_o.h ( 1)* integer,parameter :: im0=401 ( 2)* integer, parameter :: nm=6 ( 3)* integer, parameter :: lm = 50 ( 4)* integer, parameter :: nsub = 10 ( 5)* ( 6)* integer, parameter :: im=im0, jm=im ( 7)* integer, parameter :: im1=im-1, jm1=jm-1 ( 8)* ( 9)* integer, parameter :: lm1 = lm-1, lp1 =lm +1 ( 10)* ( 11)* integer, parameter :: ixm = nsub, jym = ixm, nxy = ixm*jym ( 12)* integer, parameter :: ildom = (im - 1)/ixm, jldom = (jm - 1)/jym ( 13)* integer, parameter :: ilm = (im - 1)/ixm +1, jlm = (jm - 1)/jym +1 ( 14)* ( 15)* logical,parameter::flat=.false. ( 16)* logical,parameter::hstst=.false. ( 17)* ( 18)*! integer,parameter::igm=360, jgm = 181 ( 19)* integer,parameter::igm=(im0-1)*4, jgm = (igm/2)+1 ( 20)* real,parameter::alfa=0.0, beta=0.0, gamm=0.0 ( 21)*! real,parameter::alfa=0.*3.1415926/180.,beta=66.*3.1415926/180. & ( 22)*! ,gamm=175.*3.1415926/180. ( 23)* ( 24)*!GSM integer,parameter::lsm=20 ( 25)* integer,parameter::lsm=31 ( 26)* ( 27)*!RESTART ( 28)* ( 29)* character(len=10):: restartdate='2020080412' !restart date to create appropriate folder name ( 13) real, allocatable, dimension(:,:,:,:)::fsl,usl,vsl,ull,vll,qsl,tsl,q2sl ( 14) real, allocatable, dimension(:,:,:)::fsl_ll,hgt_ll,usp,vsp,qsl_ll,tsl_ll,q2sl_ll ( 15) real,dimension(jgm,lsm)::usp_avg ( 16) real,dimension(jgm,lsm)::tsl_ll_avg ( 17) ( 18) !pvrbls_ll real,dimension(igm,jgm)::psurf_ll,tsfc_ll,pslp_ll,sfcshx_ll,sfclhx_ll,vegfrc_ll,z0_ll,albedo_ll ( 19) !pvrbls_ll real, allocatable, dimension(:,:)::psurf_ll,tsfc_ll,pslp_ll,sfcshx_ll,sfclhx_ll,vegfrc_ll,z0_ll,albedo_ll ( 20) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::tsfc,sfclhx,sfcshx,vegfrc,z0,albedo ( 21) !! real,dimension(0:im+1,0:jm+1,nm) :: tsfc PGF90 (Version 12.8) 08/30/2020 00:27:46 page 2 ( 22) real, allocatable, dimension(:,:,:) :: tsfc ( 23) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::RSWIN,RSWOUT,RSWTOA,ASWIN,ASWOUT,ASWTOA,rswnet ( 24) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::RLWIN,RLWOUT,RLWTOA,ALWIN,ALWOUT,ALWTOA,rlwnet ( 25) ( 26) ( 27) !!pvrbls_ll real,dimension(igm,jgm)::RSWIN_ll,RSWOUT_ll,RSWTOA_ll,ASWIN_ll,ASWOUT_ll,ASWTOA_ll,rswnet_ll ( 28) !!pvrbls_ll real,dimension(igm,jgm)::RLWIN_ll,RLWOUT_ll,RLWTOA_ll,ALWIN_ll,ALWOUT_ll,ALWTOA_ll,rlwnet_ll ( 29) !pvrbls_ll real, allocatable, dimension(:,:)::RSWIN_ll,RSWOUT_ll,RSWTOA_ll,ASWIN_ll,ASWOUT_ll,ASWTOA_ll,rswnet_ll ( 30) !pvrbls_ll real, allocatable, dimension(:,:)::RLWIN_ll,RLWOUT_ll,RLWTOA_ll,ALWIN_ll,ALWOUT_ll,ALWTOA_ll,rlwnet_ll ( 31) ( 32) !pvrbls real,dimension(0:im+1,0:jm+1,nm,lsm)::RSWTT,RLWTT ( 33) !!pvrbls_ll real,dimension(igm,jgm,lsm)::RSWTT_ll,RLWTT_ll ( 34) !pvrbls_ll real, allocatable, dimension(:,:,:)::RSWTT_ll,RLWTT_ll ( 35) ( 36) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::CUPPT,cfracl,cfracm,cfrach ( 37) !!pvrbls_ll real,dimension(igm,jgm)::CUPPT_ll,cfracl_ll,cfracm_ll,cfrach_ll ( 38) !pvrbls_ll real, allocatable, dimension(:,:)::CUPPT_ll,cfracl_ll,cfracm_ll,cfrach_ll ( 39) ( 40) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::acprec,cuprec,aprec,acsnow,prec ( 41) !!pvrbls_ll real,dimension(igm,jgm)::acprec_ll,cuprec_ll,aprec_ll,acsnow_ll,prec_ll ( 42) !pvrbls_ll real, allocatable, dimension(:,:)::acprec_ll,cuprec_ll,aprec_ll,acsnow_ll,prec_ll ( 43) ( 44) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::SMSTAV,BGROFF,SSROFF ( 45) !! real,dimension(igm,jgm)::SMSTAV_ll,BGROFF_ll,SSROFF_ll ( 46) real, allocatable, dimension(:,:)::SMSTAV_ll,BGROFF_ll,SSROFF_ll ( 47) ( 48) !pvrbls integer,parameter::nsoil=4 ( 49) !pvrbls real,dimension(0:im+1,0:jm+1,nm,nsoil)::stc,smc ( 50) !!pvrbls_ll real,dimension(igm,jgm,nsoil)::stc_ll,smc_ll ( 51) !pvrbls_ll real, allocatable, dimension(:,:,:)::stc_ll,smc_ll ( 52) ( 53) ( 54) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::tshltr,qshltr,albase,cnvtop,cnvbot,htop,hbot ( 55) !!pvrbls_ll real,dimension(igm,jgm)::tshltr_ll,qshltr_ll,albase_ll,cnvtop_ll,cnvbot_ll,htop_ll,hbot_ll ( 56) !pvrbls_ll real, allocatable, dimension(:,:)::tshltr_ll,qshltr_ll,albase_ll,cnvtop_ll,cnvbot_ll,htop_ll,hbot_ll ( 57) ( 58) !pvrbls integer,dimension(0:im+1,0:jm+1,nm)::IVGTYP,ISLTYP ( 59) !!pvrbls_ll integer,dimension(igm,jgm)::IVGTYP_ll,ISLTYP_ll ( 60) !pvrbls_ll integer, allocatable, dimension(:,:)::IVGTYP_ll,ISLTYP_ll ( 61) ( 62) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::acfrcv,acfrst,acsnom,cmc, & ( 63) !pvrbls czen,czmean,epsr,glat,glon,grnflx,mxsnal,potevp,potflx ( 64) ( 65) !!pvrbls_ll real,dimension(igm,jgm)::acfrcv_ll,acfrst_ll,acsnom_ll,cmc_ll, & ( 66) !pvrbls_ll real, allocatable, dimension(:,:)::acfrcv_ll,acfrst_ll,acsnom_ll,cmc_ll, & ( 67) !pvrbls_ll czen_ll,czmean_ll,epsr_ll,glat_ll,glon_ll,grnflx_ll,mxsnal_ll,potevp_ll,potflx_ll ( 68) ( 69) !pvrbls real,dimension(0:im+1,0:jm+1,nm,lm)::omgalf,q2,tcucn,train,div,rtop,htm,vtm, w, dwdt, z ( 70) ( 71) !!pvrbls_ll real,dimension(igm,jgm,lsm)::omgalf_ll,q2_ll,tcucn_ll,train_ll,div_ll,rtop_ll,htm_ll,vtm_ll, w_ll, dwdt_ll, z_ll ( 72) !pvrbls_ll real, allocatable, dimension(:,:,:)::omgalf_ll,q2_ll,tcucn_ll,train_ll,div_ll,rtop_ll,htm_ll,vtm_ll, w_ll, dwdt_ll, z_ll ( 73) ( 74) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::qwbs,twbs,sm,fis,q10,th10,qz0,thz0,radot,sigt4, & ( 75) !pvrbls sfcevp,subshx,snopcx,si,sno,sice,smstot,soiltb,tg,sr,akhs,akms,ths,plm ( 76) ( 77) !!pvrbls_ll real,dimension(igm,jgm)::qwbs_ll,twbs_ll,sm_ll,fis_ll,q10_ll,th10_ll,qz0_ll,thz0_ll, & ( 78) !pvrbls_ll real, allocatable, dimension(:,:)::qwbs_ll,twbs_ll,sm_ll,fis_ll,q10_ll,th10_ll,qz0_ll,thz0_ll, & ( 79) !pvrbls_ll radot_ll,sigt4_ll,sfcevp_ll,subshx_ll,snopcx_ll,si_ll,sno_ll,sice_ll,smstot_ll,soiltb_ll, & PGF90 (Version 12.8) 08/30/2020 00:27:46 page 3 ( 80) !pvrbls_ll tg_ll,sr_ll,akhs_ll,akms_ll,ths_ll,plm_ll ( 81) ( 82) !pvrbls real,dimension(0:im+1,0:jm+1,nm)::u10,v10,uz0,vz0,ustar,u10ll,v10ll,uz0ll,vz0ll ( 83) !!pvrbls_ll real,dimension(0:im+1,0:jm+1,nm):: u10ll,v10ll,uz0ll,vz0ll ( 84) !!pvrbls_ll real,dimension(igm,jgm)::u10_ll,v10_ll,uz0_ll,vz0_ll,ustar_ll ( 85) !pvrbls_ll real, allocatable, dimension(:,:,:):: u10ll,v10ll,uz0ll,vz0ll ( 86) !pvrbls_ll real, allocatable, dimension(:,:)::u10_ll,v10_ll,uz0_ll,vz0_ll,ustar_ll ( 87) ( 88) ( 89) integer::l,i,j,n,k ( 90) ( 91) ( 92) !+++++++++++++++++++ ( 93) ! open(1,file='../data_out/tmpfld.dat',form='unformatted') ( 94) ALLOCATE(fsl(0:im+1,0:jm+1,nm,lsm)) ( 95) ALLOCATE(usl(0:im+1,0:jm+1,nm,lsm)) ( 96) ALLOCATE(vsl(0:im+1,0:jm+1,nm,lsm)) ( 97) ALLOCATE(ull(0:im+1,0:jm+1,nm,lsm)) ( 98) ALLOCATE(vll(0:im+1,0:jm+1,nm,lsm)) ( 99) ALLOCATE(qsl(0:im+1,0:jm+1,nm,lsm)) ( 100) ALLOCATE(tsl(0:im+1,0:jm+1,nm,lsm)) ( 101) ALLOCATE(q2sl(0:im+1,0:jm+1,nm,lsm)) ( 102) ( 103) ull = 0.0 ( 104) vll = 0.0 ( 105) ( 106) ALLOCATE(tsfc(0:im+1,0:jm+1,nm)) ( 107) open(1,file='tmpfld.dat',form='unformatted') ( 108) !!! open(1,file='./ETAPOST/tmpfld.dat',form='unformatted') ( 109) do l=1,lsm ( 110) read(1)fsl(:,:,:,l) ( 111) read(1)usl(:,:,:,l) ( 112) read(1)vsl(:,:,:,l) ( 113) read(1)qsl(:,:,:,l) !DRAGAN 23.09.'10 ( 114) read(1)tsl(:,:,:,l) ( 115) !!!avg2017 read(1)q2sl(:,:,:,l) ( 116) !non-hydrostatic ( 117) !!! read(1)w(:,:,:,l) ( 118) !!! read(1)dwdt(:,:,:,l) ( 119) !!! read(1)z(:,:,:,l) ( 120) ( 121) ( 122) ! read(1)tshltr ( 123) ! read(1)qshltr ( 124) ! read(1)plm ( 125) enddo ( 126) close(1) ( 127) ( 128) !! do j=1,jm ( 129) !! do i=1,im ( 130) ! print *,i,j,q2sl(i,j,3,1) ( 131) !! enddo ( 132) !! enddo ( 133) !++++++++++++++++++ ( 134) ( 135) open(1,file='tmpsfc.dat',form='unformatted') ( 136) !!! open(1,file='./ETAPOST/tmpsfc.dat',form='unformatted') ( 137) read(1)tsfc PGF90 (Version 12.8) 08/30/2020 00:27:46 page 4 ( 138) !jnt read(1)tshltr ( 139) !jnt read(1)qshltr ( 140) !jnt read(1)plm ( 141) !jnt ( 142) !jnt read(1)sfclhx !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ( 143) !jnt read(1)sfcshx !!!!!!!!!!!! ( 144) !jnt read(1)qwbs ( 145) !jnt read(1)twbs ( 146) !jnt ( 147) !jnt read(1)grnflx ( 148) !jnt read(1)vegfrc !!!!!!!!!!!!! ( 149) !jnt read(1)IVGTYP ( 150) !jnt read(1)ISLTYP ( 151) !jnt read(1)glat ( 152) !jnt read(1)glon ( 153) !jnt read(1)sm ( 154) !jnt! read(1)htm ( 155) !jnt! read(1)vtm ( 156) !jnt read(1)sice ( 157) !jnt read(1)z0 ( 158) !jnt read(1)omgalf ( 159) !jnt read(1)albedo ( 160) !jnt read(1)albase ( 161) !jnt read(1)mxsnal ( 162) !jnt ( 163) !jnt read(1)czen ( 164) !jnt read(1)czmean ( 165) !jnt read(1)fis ( 166) !jnt read(1)q10 ( 167) !jnt read(1)th10 ( 168) !jnt read(1)qz0 ( 169) !jnt read(1)thz0 ( 170) !jnt ( 171) !jnt read(1)u10 ( 172) !jnt read(1)v10 ( 173) !jnt read(1)uz0 ( 174) !jnt read(1)vz0 ( 175) !jnt read(1)ustar ( 176) !jnt ( 177) !jnt read(1)ths ( 178) !jnt read(1)q2 ( 179) !jnt read(1)tcucn ( 180) !jnt read(1)train ( 181) !jnt read(1)div ( 182) !jnt read(1)rtop ( 183) !jnt ( 184) !jnt ( 185) !jnt close(1) ( 186) !jnt!+++++++++++++++++++ ( 187) !jnt open(2,file='./ETAPOST/sw_rdtn.dat',form='unformatted') ( 188) !jnt read(2)RSWIN ( 189) !jnt read(2)RSWOUT ( 190) !jnt read(2)RSWTOA !!!!!!!!!!!!!!!!DRAGAN ( 191) !jnt read(2)ASWIN ( 192) !jnt read(2)ASWOUT ( 193) !jnt ( 194) !jnt read(2)ASWTOA ( 195) !jnt read(2)rswnet PGF90 (Version 12.8) 08/30/2020 00:27:46 page 5 ( 196) !jnt read(2)RSWTT ( 197) !jnt ( 198) !jnt close(2) ( 199) !jnt!+++++++++++++++++ ( 200) !jnt open(3,file='./ETAPOST/lw_rdtn.dat',form='unformatted') ( 201) !jnt read(3)RLWIN ( 202) !jnt read(3)RLWOUT ( 203) !jnt read(3)RLWTOA !!!!!!!!!!!!!!!!DRAGAN ( 204) !jnt read(3)ALWIN ( 205) !jnt read(3)ALWOUT ( 206) !jnt ( 207) !jnt read(3)ALWTOA ( 208) !jnt read(3)rlwnet ( 209) !jnt read(3)RLWTT ( 210) !jnt read(3)epsr ( 211) !jnt read(3)radot ( 212) !jnt read(3)sigt4 ( 213) !jnt close(3) ( 214) !jnt ( 215) !jnt ( 216) !jnt!++++++++++++++++ ( 217) !jnt ( 218) !jnt ( 219) !jnt open(4,file='./ETAPOST/clouds.dat',form='unformatted') ( 220) !jnt read(4)CUPPT ( 221) !jnt read(4)cfracl ( 222) !jnt read(4)cfracm !!!!!!!!!!!!!!!!DRAGAN ( 223) !jnt read(4)cfrach ( 224) !jnt read(4)acfrcv ( 225) !jnt read(4)acfrst ( 226) !jnt ( 227) !jnt read(4)cnvtop ( 228) !jnt read(4)cnvbot ( 229) !jnt! read(4)htop ( 230) !jnt! read(4)hbot ( 231) !jnt close(4) ( 232) !jnt ( 233) !jnt!++++++++++++++++ ( 234) !jnt ( 235) !jnt open(5,file='./ETAPOST/precANDsoil.dat',form='unformatted') ( 236) !jnt read(5)acprec ( 237) !jnt read(5)cuprec ( 238) !jnt read(5)aprec !!!!!!!!!!!!!!!!DRAGAN ( 239) !jnt read(5)acsnow ( 240) !jnt read(5)acsnom ( 241) !jnt ( 242) !jnt read(5)prec ( 243) !jnt ( 244) !jnt read(5)stc(:,:,:,1) ( 245) !jnt read(5)stc(:,:,:,4) ( 246) !jnt read(5)smc(:,:,:,1) ( 247) !jnt read(5)smc(:,:,:,4) ( 248) !jnt ( 249) !jnt ( 250) !jnt read(5)SMSTAV ( 251) !jnt read(5)BGROFF ( 252) !jnt read(5)SSROFF ( 253) !jnt read(5)cmc PGF90 (Version 12.8) 08/30/2020 00:27:46 page 6 ( 254) !jnt read(5)potevp ( 255) !jnt read(5)potflx ( 256) !jnt read(5)sfcevp ( 257) !jnt read(5)subshx ( 258) !jnt read(5)snopcx ( 259) !jnt ( 260) !jnt read(5)si ( 261) !jnt read(5)sno ( 262) !jnt ( 263) !jnt read(5)smstot ( 264) !jnt read(5)soiltb !!!! ( 265) !jnt! read(5)tg !!!! ( 266) !jnt read(5)sr ( 267) !jnt read(5)akhs ( 268) !jnt read(5)akms ( 269) !jnt close(5) ( 270) !+++++++++++++++++ ( 271) ( 272) ( 273) ( 274) ALLOCATE(fsl_ll(igm,jgm,lsm)) ( 275) ALLOCATE(hgt_ll(igm,jgm,lsm)) ( 276) ALLOCATE(usp(igm,jgm,lsm)) ( 277) ALLOCATE(vsp(igm,jgm,lsm)) ( 278) ALLOCATE(qsl_ll(igm,jgm,lsm)) ( 279) ALLOCATE(tsl_ll(igm,jgm,lsm)) ( 280) ALLOCATE(q2sl_ll(igm,jgm,lsm)) ( 281) fsl_ll = 0.0 ( 282) hgt_ll = 0.0 ( 283) usp = 0.0 ( 284) vsp = 0.0 ( 285) qsl_ll = 0.0 ( 286) tsl_ll = 0.0 ( 287) q2sl_ll = 0.0 ( 288) ( 289) ALLOCATE(SMSTAV_ll(igm,jgm)) ( 290) ALLOCATE(BGROFF_ll(igm,jgm)) ( 291) ALLOCATE(SSROFF_ll(igm,jgm)) ( 292) SMSTAV_ll = 0.0 ( 293) BGROFF_ll = 0.0 ( 294) SSROFF_ll = 0.0 ( 295) ( 296) print *,'tsl,30,14,4,',tsl(30,14,4,17),tsl(30,15,4,17),tsl(31,14,4,17), & ( 297) tsl(31,15,4,17) ( 298) print *,'tsl,30,14,4,',tsl(30,14,4,16),tsl(30,15,4,16),tsl(31,14,4,16), & ( 299) tsl(31,15,4,16) ( 300) !! do n=1,nm ( 301) !! do i=1,im ( 302) !! do j=1,jm ( 303) ! print *,i,j,n,usl(i,j,n,1),vsl(i,j,n,1) ( 304) !! enddo ( 305) !! enddo ( 306) !! enddo ( 307) ( 308) ( 309) if(nm.eq.14)then ( 310) ! print *,pslp(34,57,3),pslp(34,58,3),pslp(35,57,3),pslp(35,58,3) ( 311) call octa2llH(fsl, fsl_ll, lsm) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 7 ( 312) call octa2llH(qsl, qsl_ll, lsm) ( 313) call octa2llH(tsl, tsl_ll, lsm) ( 314) call octa2llH(q2sl, q2sl_ll, lsm) ( 315) !!! call octa2llH(tshltr, tshltr_ll, 1) ( 316) !!! call octa2llH(qshltr, qshltr_ll, 1) ( 317) ! call octa2llH(plm, plm_ll, 1) ( 318) ( 319) call octa2llH(pint(:,:,:,lp1),psurf_ll,1) ( 320) call octa2llH(pslp,pslp_ll,1) ( 321) call octa2llH(tsfc,tsfc_ll,1) ( 322) ( 323) !++++++++++++++++++++++++++++++++++++++ ( 324) call octa2llH(tshltr, tshltr_ll, 1) ( 325) call octa2llH(qshltr, qshltr_ll, 1) ( 326) call octa2llH(plm, plm_ll, 1) ( 327) ( 328) call octa2llH(sfclhx,sfclhx_ll,1) ( 329) call octa2llH(sfcshx,sfcshx_ll,1) ( 330) call octa2llH(qwbs,qwbs_ll,1) ( 331) call octa2llH(twbs,twbs_ll,1) ( 332) ( 333) call octa2llH(grnflx,grnflx_ll,1) ( 334) ( 335) call octa2llH(vegfrc,vegfrc_ll,1) ( 336) call octa2llH(IVGTYP,IVGTYP_ll,1) ( 337) call octa2llH(ISLTYP,ISLTYP_ll,1) ( 338) call octa2llH(glat,glat_ll,1) ( 339) call octa2llH(glon,glon_ll,1) ( 340) call octa2llH(sm,sm_ll,1) ( 341) ! call octa2llH(htm,htm_ll,lsm) ( 342) ! call octa2llH(vtm,vtm_ll,lsm) ( 343) call octa2llH(sice,sice_ll,1) ( 344) ( 345) call octa2llH(z0,z0_ll,1) ( 346) call octa2llH(omgalf,omgalf_ll,lsm) ( 347) call octa2llH(albedo,albedo_ll,1) ( 348) call octa2llH(albase,albase_ll,1) ( 349) call octa2llH(mxsnal,mxsnal_ll,1) ( 350) call octa2llH(czen,czen_ll,1) ( 351) call octa2llH(czmean,czmean_ll,1) ( 352) call octa2llH(fis,fis_ll,1) ( 353) call octa2llH(q10,q10_ll,1) ( 354) call octa2llH(th10,th10_ll,1) ( 355) call octa2llH(qz0,qz0_ll,1) ( 356) call octa2llH(thz0,thz0_ll,1) ( 357) ( 358) call octa2llH(ustar,ustar_ll,1) ( 359) ( 360) call octa2llH(ths,ths_ll,1) ( 361) ( 362) call octa2llH(q2,q2_ll,lsm) ( 363) call octa2llH(tcucn,tcucn_ll,lsm) ( 364) call octa2llH(train,train_ll,lsm) ( 365) call octa2llH(div,div_ll,lsm) ( 366) call octa2llH(rtop,rtop_ll,lsm) ( 367) !++++++++++++++++++++++++++++++++++++ ( 368) call octa2llH(RSWIN,RSWIN_ll,1) ( 369) call octa2llH(RSWOUT,RSWOUT_ll,1) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 8 ( 370) call octa2llH(RSWTOA,RSWTOA_ll,1) ( 371) ( 372) call octa2llH(ASWIN,ASWIN_ll,1) ( 373) call octa2llH(ASWOUT,ASWOUT_ll,1) ( 374) call octa2llH(ASWTOA,ASWTOA_ll,1) ( 375) call octa2llH(rswnet,rswnet_ll,1) ( 376) call octa2llH(RSWTT,RSWTT_ll,lsm) ( 377) ( 378) !+++++++++++++++++++++++++++++++++++++++ ( 379) call octa2llH(RLWIN,RLWIN_ll,1) ( 380) call octa2llH(RLWOUT,RLWOUT_ll,1) ( 381) call octa2llH(RLWTOA,RLWTOA_ll,1) ( 382) ( 383) call octa2llH(ALWIN,ALWIN_ll,1) ( 384) call octa2llH(ALWOUT,ALWOUT_ll,1) ( 385) call octa2llH(ALWTOA,ALWTOA_ll,1) ( 386) call octa2llH(rlwnet,rlwnet_ll,1) ( 387) call octa2llH(RLWTT,RLWTT_ll,lsm) ( 388) call octa2llH(epsr,epsr_ll,1) ( 389) call octa2llH(radot,radot_ll,1) ( 390) call octa2llH(sigt4,sigt4_ll,1) ( 391) !++++++++++++++++++++++++++++++++++++++ ( 392) call octa2llH(CUPPT,CUPPT_ll,1) ( 393) call octa2llH(cfracl,cfracl_ll,1) ( 394) call octa2llH(cfracm,cfracm_ll,1) ( 395) ( 396) call octa2llH(cfrach,cfrach_ll,1) ( 397) call octa2llH(acfrcv,acfrcv_ll,1) ( 398) call octa2llH(acfrst,acfrst_ll,1) ( 399) ( 400) !++++++++++++++++++++++++++++++++++++++ ( 401) call octa2llH(cnvtop,cnvtop_ll,1) ( 402) call octa2llH(cnvbot,cnvbot_ll,1) ( 403) ! call octa2llH(htop,htop_ll,1) ( 404) ! call octa2llH(hbot,hbot_ll,1) ( 405) ( 406) call octa2llH(acprec,acprec_ll,1) ( 407) call octa2llH(cuprec,cuprec_ll,1) ( 408) call octa2llH(aprec,aprec_ll,1) ( 409) call octa2llH(acsnow,acsnow_ll,1) ( 410) call octa2llH(acsnom,acsnom_ll,1) ( 411) ( 412) call octa2llH(prec,prec_ll,1) ( 413) ( 414) ( 415) ( 416) !++++++++++++++++++++++++++++++++++++++ ( 417) ( 418) call octa2llH(stc,stc_ll,1) ( 419) call octa2llH(stc,stc_ll,4) ( 420) call octa2llH(smc,smc_ll,1) ( 421) call octa2llH(smc,smc_ll,4) ( 422) call octa2llH(SMSTAV,SMSTAV_ll,1) ( 423) call octa2llH(BGROFF,BGROFF_ll,1) ( 424) call octa2llH(SSROFF,SSROFF_ll,1) ( 425) call octa2llH(cmc,cmc_ll,1) ( 426) call octa2llH(potevp,potevp_ll,1) ( 427) call octa2llH(potflx,potflx_ll,1) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 9 ( 428) call octa2llH(sfcevp,sfcevp_ll,1) ( 429) call octa2llH(subshx,subshx_ll,1) ( 430) call octa2llH(snopcx,snopcx_ll,1) ( 431) call octa2llH(si,si_ll,1) ( 432) call octa2llH(sno,sno_ll,1) ( 433) ( 434) call octa2llH(smstot,smstot_ll,1) ( 435) call octa2llH(soiltb,soiltb_ll,1) ( 436) ! call octa2llH(tg,tg_ll,1) ( 437) call octa2llH(sr,sr_ll,1) ( 438) call octa2llH(akhs,akhs_ll,1) ( 439) call octa2llH(akms,akms_ll,1) ( 440) !++++++++++++++++++++++++++++++++++++++ ( 441) call llwinds_oc(usl, vsl, ull, vll,lsm) ( 442) call bocovs_oc(ull,im,jm,lsm) ( 443) call bocovs_oc(vll,im,jm,lsm) ( 444) call avrv_oc(ull, usl,lsm) ( 445) call avrv_oc(vll, vsl,lsm) ( 446) usl = usl * .25 ( 447) vsl = vsl * .25 ( 448) do k=1,nm ( 449) if(k.eq.1.or.k.eq.2.or.k.eq.7.or.k.eq.8.or.k.eq.9 & ( 450) .or.k.eq.12)then ( 451) usl(1 ,1 ,k,:)=usl(1 ,1 ,k,:)*4./3. ( 452) vsl(1 ,1 ,k,:)=vsl(1 ,1 ,k,:)*4./3. ( 453) endif ( 454) ( 455) if(k.eq.1.or.k.eq.4.or.k.eq.6.or.k.eq.7.or.k.eq.11 & ( 456) .or.k.eq.14)then ( 457) usl(im,1 ,k,:)=usl(im,1 ,k,:)*4./3. ( 458) vsl(im,1 ,k,:)=vsl(im,1 ,k,:)*4./3. ( 459) endif ( 460) ( 461) if(k.eq.2.or.k.eq.5.or.k.eq.6.or.k.eq.9.or.k.eq.13 & ( 462) .or.k.eq.14)then ( 463) usl(1 ,jm,k,:)=usl(1 ,jm,k,:)*4./3. ( 464) vsl(1 ,jm,k,:)=vsl(1 ,jm,k,:)*4./3. ( 465) endif ( 466) ( 467) if(k.eq.4.or.k.eq.5.or.k.eq.8.or.k.eq.11.or.k.eq.12 & ( 468) .or.k.eq.13)then ( 469) usl(im,jm,k,:)=usl(im,jm,k,:)*4./3. ( 470) vsl(im,jm,k,:)=vsl(im,jm,k,:)*4./3. ( 471) endif ( 472) enddo ( 473) ( 474) call octa2llH(usl, usp, lsm) ( 475) call octa2llH(vsl, vsp, lsm) ( 476) !+++++++++++++++++++++++++++++ ( 477) ( 478) ! call llwinds_oc(u10, v10, u10ll, v10ll,1) ( 479) ! call bocovs_oc(u10ll,im,jm,1) ( 480) ! call bocovs_oc(v10ll,im,jm,1) ( 481) ! call avrv_oc(u10ll, u10,1) ( 482) ! call avrv_oc(v10ll, v10,1) ( 483) ! u10 = u10 * .25 ( 484) ! v10 = v10 * .25 ( 485) ! do k=1,nm PGF90 (Version 12.8) 08/30/2020 00:27:46 page 10 ( 486) ! if(k.eq.1.or.k.eq.2.or.k.eq.7.or.k.eq.8.or.k.eq.9 & ( 487) ! .or.k.eq.12)then ( 488) ! u10(1 ,1 ,k)=u10(1 ,1 ,k)*4./3. ( 489) ! v10(1 ,1 ,k)=v10(1 ,1 ,k)*4./3. ( 490) ! endif ( 491) ! ( 492) ! if(k.eq.1.or.k.eq.4.or.k.eq.6.or.k.eq.7.or.k.eq.11 & ( 493) ! .or.k.eq.14)then ( 494) ! u10(im,1 ,k)=u10(im,1 ,k)*4./3. ( 495) ! v10(im,1 ,k)=v10(im,1 ,k)*4./3. ( 496) ! endif ( 497) ! ( 498) ! if(k.eq.2.or.k.eq.5.or.k.eq.6.or.k.eq.9.or.k.eq.13 & ( 499) ! .or.k.eq.14)then ( 500) ! u10(1 ,jm,k)=u10(1 ,jm,k)*4./3. ( 501) ! v10(1 ,jm,k)=v10(1 ,jm,k)*4./3. ( 502) ! endif ( 503) ! ( 504) ! if(k.eq.4.or.k.eq.5.or.k.eq.8.or.k.eq.11.or.k.eq.12 & ( 505) ! .or.k.eq.13)then ( 506) ! u10(im,jm,k)=u10(im,jm,k)*4./3. ( 507) ! v10(im,jm,k)=v10(im,jm,k)*4./3. ( 508) ! endif ( 509) ! enddo ( 510) ( 511) call octa2llH(u10, u10_ll, 1) ( 512) call octa2llH(v10, v10_ll, 1) ( 513) !++++++++++++++++++++++++++++ ( 514) ( 515) ! call llwinds_oc(uz0, vz0, uz0ll, vz0ll,1) ( 516) ! call bocovs_oc(uz0ll,im,jm,1) ( 517) ! call bocovs_oc(vz0ll,im,jm,1) ( 518) ! call avrv_oc(uz0ll, uz0,1) ( 519) ! call avrv_oc(v10ll, vz0,1) ( 520) ! uz0 = uz0 * .25 ( 521) ! vz0 = vz0 * .25 ( 522) ! do k=1,nm ( 523) ! if(k.eq.1.or.k.eq.2.or.k.eq.7.or.k.eq.8.or.k.eq.9 & ( 524) ! .or.k.eq.12)then ( 525) ! uz0(1 ,1 ,k)=uz0(1 ,1 ,k)*4./3. ( 526) ! vz0(1 ,1 ,k)=vz0(1 ,1 ,k)*4./3. ( 527) ! endif ( 528) ( 529) ! if(k.eq.1.or.k.eq.4.or.k.eq.6.or.k.eq.7.or.k.eq.11 & ( 530) ! .or.k.eq.14)then ( 531) ! uz0(im,1 ,k)=uz0(im,1 ,k)*4./3. ( 532) ! vz0(im,1 ,k)=vz0(im,1 ,k)*4./3. ( 533) ! endif ( 534) ( 535) ! if(k.eq.2.or.k.eq.5.or.k.eq.6.or.k.eq.9.or.k.eq.13 & ( 536) ! .or.k.eq.14)then ( 537) ! uz0(1 ,jm,k)=uz0(1 ,jm,k)*4./3. ( 538) ! vz0(1 ,jm,k)=vz0(1 ,jm,k)*4./3. ( 539) ! endif ( 540) ( 541) ! if(k.eq.4.or.k.eq.5.or.k.eq.8.or.k.eq.11.or.k.eq.12 & ( 542) ! .or.k.eq.13)then ( 543) ! uz0(im,jm,k)=uz0(im,jm,k)*4./3. PGF90 (Version 12.8) 08/30/2020 00:27:46 page 11 ( 544) ! vz0(im,jm,k)=vz0(im,jm,k)*4./3. ( 545) ! endif ( 546) ! enddo ( 547) ( 548) call octa2llH(uz0, uz0_ll, 1) ( 549) call octa2llH(vz0, vz0_ll, 1) ( 550) ( 551) ( 552) !+++++ ( 553) else if(nm.eq.6)then ( 554) print *,'calling cube2llH - fsl ...' ( 555) call cube2llH(fsl, fsl_ll, lsm) ( 556) print *,'calling cube2llH - qsl ...' ( 557) call cube2llH(qsl, qsl_ll, lsm) ( 558) print *,'calling cube2llH - tsl ...' ( 559) call cube2llH(tsl, tsl_ll, lsm) ( 560) !!!avg2017 print *,'calling cube2llH - q2sl ...' ( 561) !!!avg2017 call cube2llH(q2sl, q2sl_ll, lsm) ( 562) !!! call cube2llH(tshltr, tshltr_ll, 1) ( 563) !!! call cube2llH(qshltr, qshltr_ll, 1) ( 564) ! call cube2llH(plm, plm_ll, 1) ( 565) ( 566) !!!avg2017 print *,'calling cube2llH - psurf_ll ...' ( 567) !!!avg2017 call cube2llH(pint(:,:,:,lp1),psurf_ll,1) ( 568) print *,'calling cube2llH - pslp_ll ...' ( 569) call cube2llH(pslp,pslp_ll,1) ( 570) print *,'calling cube2llH - tsfc_ll ...' ( 571) call cube2llH(tsfc,tsfc_ll,1) ( 572) !non-hydrostatic ( 573) !!! print *,'calling cube2llH - w_ll ...' ( 574) !!! call cube2llH(w, w_ll, lsm) ( 575) !!! print *,'calling cube2llH - dwdt_ll ...' ( 576) !!! call cube2llH(dwdt, dwdt_ll, lsm) ( 577) !!! print *,'calling cube2llH - z_ll ...' ( 578) !!! call cube2llH(z, z_ll, lsm) ( 579) ( 580) !++++++++++++++++++++++++++++++++++++++++++++++++++++++ ( 581) print *,'calling cube2llH - tshltr_ll ...' ( 582) call cube2llH(tshltr, tshltr_ll, 1) ( 583) print *,'calling cube2llH - qshltr_ll ...' ( 584) call cube2llH(qshltr, qshltr_ll, 1) ( 585) print *,'calling cube2llH - plm_ll ...' ( 586) call cube2llH(plm, plm_ll, 1) ( 587) ( 588) print *,'calling cube2llH - sfclhx_ll ...' ( 589) call cube2llH(sfclhx,sfclhx_ll,1) ( 590) print *,'calling cube2llH - sfcshx_ll ...' ( 591) call cube2llH(sfcshx,sfcshx_ll,1) ( 592) !!!avg2017 print *,'calling cube2llH - qwbs_ll ...' ( 593) !!!avg2017 call cube2llH(qwbs,qwbs_ll,1) ( 594) !!!avg2017 print *,'calling cube2llH - twbsb ...' ( 595) !!!avg2017 call cube2llH(twbs,twbs_ll,1) ( 596) !!!avg2017 call cube2llH(grnflx,grnflx_ll,1) ( 597) call cube2llH(vegfrc,vegfrc_ll,1) ( 598) !!!avg2017 call cube2llH(IVGTYP,IVGTYP_ll,1) ( 599) !!!avg2017 call cube2llH(ISLTYP,ISLTYP_ll,1) ( 600) !!!avg2017 print *,'calling cube2llH - glat_ll ...' ( 601) !!!avg2017 call cube2llH(glat,glat_ll,1) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 12 ( 602) !!!avg2017 call cube2llH(glon,glon_ll,1) ( 603) call cube2llH(sm,sm_ll,1) ( 604) ! call cube2llH(htm,htm_ll,lsm) ( 605) ! call cube2llH(vtm,vtm_ll,lsm) ( 606) call cube2llH(sice,sice_ll,1) ( 607) call cube2llH(z0,z0_ll,1) ( 608) print *,'calling cube2llH - omgalf_ll...' ( 609) call cube2llH(omgalf,omgalf_ll,lsm) ( 610) call cube2llH(albedo,albedo_ll,1) ( 611) call cube2llH(albase,albase_ll,1) ( 612) !!!avg2017 call cube2llH(mxsnal,mxsnal_ll,1) ( 613) !!!avg2017 call cube2llH(czen,czen_ll,1) ( 614) !!!avg2017 call cube2llH(czmean,czmean_ll,1) ( 615) !!!avg2017 print *,'calling cube2llH - fis ...' ( 616) !!!avg2017 call cube2llH(fis,fis_ll,1) ( 617) !!!avg2017 call cube2llH(q10,q10_ll,1) ( 618) !!!avg2017 call cube2llH(th10,th10_ll,1) ( 619) !!!avg2017 call cube2llH(qz0,qz0_ll,1) ( 620) !!!avg2017 call cube2llH(thz0,thz0_ll,1) ( 621) !!!avg2017 call cube2llH(ustar,ustar_ll,1) ( 622) ( 623) !!!avg2017 print *,'calling cube2llH - ths_ll ...' ( 624) !!!avg2017 call cube2llH(ths,ths_ll,1) ( 625) ( 626) !!!avg2017 call cube2llH(q2,q2_ll,lsm) ( 627) !!!avg2017 call cube2llH(tcucn,tcucn_ll,lsm) ( 628) !!!avg2017 call cube2llH(train,train_ll,lsm) ( 629) !!!avg2017 call cube2llH(div,div_ll,lsm) ( 630) !!!avg2017 call cube2llH(rtop,rtop_ll,lsm) ( 631) !++++++++++++++++++++++++++++++++++++++++++++++++++++++ ( 632) ( 633) !!!avg2017 print *,'calling cube2llH - RSWIN_ll ...' ( 634) !!!avg2017 call cube2llH(RSWIN,RSWIN_ll,1) ( 635) !!!avg2017 print *,'calling cube2llH - 01 ...' ( 636) !!!avg2017 call cube2llH(RSWOUT,RSWOUT_ll,1) ( 637) !!!avg2017 print *,'calling cube2llH - 02 ...' ( 638) !!!avg2017 call cube2llH(RSWTOA,RSWTOA_ll,1) ( 639) print *,'calling cube2llH - 03 ...' ( 640) ( 641) call cube2llH(ASWIN,ASWIN_ll,1) ( 642) print *,'calling cube2llH - 04 ...' ( 643) call cube2llH(ASWOUT,ASWOUT_ll,1) ( 644) !!!avg2017 print *,'calling cube2llH - 05 ...' ( 645) !!!avg2017 call cube2llH(ASWTOA,ASWTOA_ll,1) ( 646) !!!avg2017 print *,'calling cube2llH - 06 ...' ( 647) !!!avg2017 call cube2llH(rswnet,rswnet_ll,1) ( 648) !!!avg2017 print *,'calling cube2llH - 07 ...' ( 649) !!!avg2017 call cube2llH(RSWTT,RSWTT_ll,lsm)!!!!!!!!!!!!!!!!!??? ( 650) ( 651) !+++++++++++++++++++++++++++++++++++++++ ( 652) !!!avg2017 print *,'calling cube2llH - RLWIN_l ...' ( 653) !!!avg2017 call cube2llH(RLWIN,RLWIN_ll,1) ( 654) !!!avg2017 call cube2llH(RLWOUT,RLWOUT_ll,1) ( 655) !!!avg2017 call cube2llH(RLWTOA,RLWTOA_ll,1) ( 656) ( 657) print *,'calling cube2llH - ALWIN_llf ...' ( 658) call cube2llH(ALWIN,ALWIN_ll,1) ( 659) call cube2llH(ALWOUT,ALWOUT_ll,1) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 13 ( 660) call cube2llH(ALWTOA,ALWTOA_ll,1) ( 661) !!!avg2017 call cube2llH(rlwnet,rlwnet_ll,1) ( 662) !!!avg2017 call cube2llH(RLWTT,RLWTT_ll,lsm) !!!!!!!!!!??? ( 663) !!!avg2017 call cube2llH(epsr,epsr_ll,1) ( 664) !!!avg2017 print *,'calling cube2llH - radot_ll ...' ( 665) !!!avg2017 call cube2llH(radot,radot_ll,1) ( 666) !!!avg2017 call cube2llH(sigt4,sigt4_ll,1) ( 667) !++++++++++++++++++++++++++++++++++++++ ( 668) !!!avg2017 call cube2llH(CUPPT,CUPPT_ll,1) ( 669) !!!avg2017 call cube2llH(cfracl,cfracl_ll,1) ( 670) !!!avg2017 call cube2llH(cfracm,cfracm_ll,1) ( 671) ( 672) !!!avg2017 call cube2llH(cfrach,cfrach_ll,1) ( 673) !!!avg2017 call cube2llH(acfrcv,acfrcv_ll,1) ( 674) !!!avg2017 call cube2llH(acfrst,acfrst_ll,1) ( 675) !!!avg2017 call cube2llH(cnvtop,cnvtop_ll,1) ( 676) !!!avg2017 call cube2llH(cnvbot,cnvbot_ll,1) ( 677) ( 678) call cube2llH(htop,htop_ll,1) ( 679) call cube2llH(hbot,hbot_ll,1) ( 680) !++++++++++++++++++++++++++++++++++++++ ( 681) print *,'calling cube2llH - acprec_l ...' ( 682) call cube2llH(acprec,acprec_ll,1) ( 683) call cube2llH(cuprec,cuprec_ll,1) ( 684) call cube2llH(aprec,aprec_ll,1) ( 685) call cube2llH(acsnow,acsnow_ll,1) ( 686) !!!avg2017 call cube2llH(acsnom,acsnom_ll,1) ( 687) call cube2llH(prec,prec_ll,1) ( 688) !++++++++++++++++++++++++++++++++++++++ ( 689) ( 690) print *,'calling cube2llH - stc_ll ...' ( 691) call cube2llH(stc,stc_ll,1) ( 692) print *,'calling cube2llH - 01 ...' ( 693) call cube2llH(stc,stc_ll,4) ( 694) print *,'calling cube2llH - 02 ...' ( 695) call cube2llH(smc,smc_ll,1) ( 696) print *,'calling cube2llH - 03 ...' ( 697) call cube2llH(smc,smc_ll,4) ( 698) print *,'calling cube2llH - 04 ...' ( 699) call cube2llH(SMSTAV,SMSTAV_ll,1) ( 700) print *,'calling cube2llH - 05 ...' ( 701) call cube2llH(BGROFF,BGROFF_ll,1) ( 702) print *,'calling cube2llH - 06 ...' ( 703) call cube2llH(SSROFF,SSROFF_ll,1) ( 704) !!!avg2017 print *,'calling cube2llH - 07 ...' ( 705) !!!avg2017 call cube2llH(cmc,cmc_ll,1) ( 706) print *,'calling cube2llH - 08 ...' ( 707) call cube2llH(potevp,potevp_ll,1) ( 708) print *,'calling cube2llH - 09 ...' ( 709) call cube2llH(potflx,potflx_ll,1) ( 710) print *,'calling cube2llH - 10 ...' ( 711) call cube2llH(sfcevp,sfcevp_ll,1) ( 712) print *,'calling cube2llH - 11 ...' ( 713) call cube2llH(subshx,subshx_ll,1) ( 714) print *,'calling cube2llH - 12 ...' ( 715) call cube2llH(snopcx,snopcx_ll,1) ( 716) print *,'calling cube2llH - 13 ...' ( 717) call cube2llH(si,si_ll,1) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 14 ( 718) !!!avg2017 print *,'calling cube2llH - 14 ...' ( 719) !!!avg2017 call cube2llH(sno,sno_ll,1) ( 720) ( 721) !!!avg2017 print *,'calling cube2llH - smstot_ll ...' ( 722) !!!avg2017 call cube2llH(smstot,smstot_ll,1) ( 723) !!!avg2017 call cube2llH(soiltb,soiltb_ll,1) ( 724) ! call cube2llH(tg,tg_ll,1) ( 725) !!!avg2017 call cube2llH(sr,sr_ll,1) ( 726) !!!avg2017 call cube2llH(akhs,akhs_ll,1) ( 727) !!!avg2017 call cube2llH(akms,akms_ll,1) ( 728) !++++++++++++++++++++++++++++++++++++++ ( 729) ( 730) print *,'calling llwinds - ...' ( 731) call llwinds(usl, vsl, ull, vll,lsm) ( 732) call bocovs(ull,im,jm,lsm) ( 733) call bocovs(vll,im,jm,lsm) ( 734) call avrv(ull, usl,lsm) ( 735) call avrv(vll, vsl,lsm) ( 736) usl = usl * .25 ( 737) vsl = vsl * .25 ( 738) do k=1,nm ( 739) usl(1 ,1 ,k,:)=usl(1 ,1 ,k,:)*4./3. ( 740) vsl(1 ,1 ,k,:)=vsl(1 ,1 ,k,:)*4./3. ( 741) usl(im,1 ,k,:)=usl(im,1 ,k,:)*4./3. ( 742) vsl(im,1 ,k,:)=vsl(im,1 ,k,:)*4./3. ( 743) usl(1 ,jm,k,:)=usl(1 ,jm,k,:)*4./3. ( 744) vsl(1 ,jm,k,:)=vsl(1 ,jm,k,:)*4./3. ( 745) usl(im,jm,k,:)=usl(im,jm,k,:)*4./3. ( 746) vsl(im,jm,k,:)=vsl(im,jm,k,:)*4./3. ( 747) enddo ( 748) ( 749) print *,'calling cube2llH - usp,vsp ...' ( 750) call cube2llH(usl, usp, lsm) ( 751) call cube2llH(vsl, vsp, lsm) ( 752) !++++++++++++++++++++++++++++++++++++++ ( 753) ( 754) ! call llwinds(u10, v10, u10ll, v10ll,1) ( 755) ! call bocovs(u10ll,im,jm,1) ( 756) ! call bocovs(v10ll,im,jm,1) ( 757) ! call avrv(u10ll, u10,1) ( 758) ! call avrv(v10ll, v10,1) ( 759) ! u10 = u10 * .25 ( 760) ! v10 = v10 * .25 ( 761) ! do k=1,nm ( 762) ! u10(1 ,1 ,k)=u10(1 ,1 ,k)*4./3. ( 763) ! v10(1 ,1 ,k)=v10(1 ,1 ,k)*4./3. ( 764) ! u10(im,1 ,k)=u10(im,1 ,k)*4./3. ( 765) ! v10(im,1 ,k)=v10(im,1 ,k)*4./3. ( 766) ! u10(1 ,jm,k)=u10(1 ,jm,k)*4./3. ( 767) ! v10(1 ,jm,k)=v10(1 ,jm,k)*4./3. ( 768) ! u10(im,jm,k)=u10(im,jm,k)*4./3. ( 769) ! v10(im,jm,k)=v10(im,jm,k)*4./3. ( 770) ! enddo ( 771) ! ( 772) call cube2llH(u10, u10_ll, 1) ( 773) call cube2llH(v10, v10_ll, 1) ( 774) ( 775) !+++++++++++++++++++++++++++++++++++++ PGF90 (Version 12.8) 08/30/2020 00:27:46 page 15 ( 776) ! call llwinds(uz0, vz0, uz0ll, vz0ll,1) ( 777) ! call bocovs(uz0ll,im,jm,1) ( 778) ! call bocovs(vz0ll,im,jm,1) ( 779) ! call avrv(uz0ll, uz0,1) ( 780) ! call avrv(vz0ll, vz0,1) ( 781) ! uz0 = uz0 * .25 ( 782) ! vz0 = vz0 * .25 ( 783) ! do k=1,nm ( 784) ! uz0(1 ,1 ,k)=uz0(1 ,1 ,k)*4./3. ( 785) ! vz0(1 ,1 ,k)=vz0(1 ,1 ,k)*4./3. ( 786) ! uz0(im,1 ,k)=uz0(im,1 ,k)*4./3. ( 787) ! vz0(im,1 ,k)=vz0(im,1 ,k)*4./3. ( 788) ! uz0(1 ,jm,k)=uz0(1 ,jm,k)*4./3. ( 789) ! vz0(1 ,jm,k)=vz0(1 ,jm,k)*4./3. ( 790) ! uz0(im,jm,k)=uz0(im,jm,k)*4./3. ( 791) ! vz0(im,jm,k)=vz0(im,jm,k)*4./3. ( 792) ! enddo ( 793) ! ( 794) ( 795) !!!avg2017 print *,'calling cube2llH - uz0 ...' ( 796) !!!avg2017 call cube2llH(uz0, uz0_ll, 1) ( 797) !!!avg2017 print *,'calling cube2llH - vz0 ...' ( 798) !!!avg2017 call cube2llH(vz0, vz0_ll, 1) ( 799) ( 800) !+++++++++++++++++++++++++++++++++++++ ( 801) ( 802) endif ( 803) ( 804) ( 805) print *,' Endif nm.eq.6 ' ( 806) ( 807) print *,' update hgt_ll ' ( 808) ( 809) hgt_ll=fsl_ll/9.80616 ( 810) ! print *,usp(82,44,17) ( 811) ( 812) print *,' update usp_avg, tsl_ll_avg ' ( 813) ( 814) do l=1,lsm ( 815) do j=1,jgm ( 816) usp_avg(j,l)=0. ( 817) tsl_ll_avg(j,l)=0. ( 818) do i=1,igm ( 819) ! do i=14,250 ( 820) usp_avg(j,l)=usp_avg(j,l)+usp(i,j,l) ( 821) tsl_ll_avg(j,l)=tsl_ll_avg(j,l)+tsl_ll(i,j,l) ( 822) if(l.eq.17.and.j.eq.44)then ( 823) ! print *,i,j,l,tsl_ll(i,j,l),usp_avg(j,l),usp(i,j,l) ( 824) endif ( 825) enddo ( 826) ! do i=335,360 !igm ( 827) ! usp_avg(j,l)=usp_avg(j,l)+usp(i,j,l) ( 828) ! tsl_ll_avg(j,l)=tsl_ll_avg(j,l)+tsl_ll(i,j,l) ( 829) ! if(l.eq.17.and.j.eq.44)then ( 830) ! print *,i,j,l,tsl_ll(i,j,l),usp_avg(j,l),usp(i,j,l) ( 831) ! endif ( 832) ! enddo ( 833) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 16 ( 834) usp_avg(j,l)=usp_avg(j,l)/igm ( 835) ! usp_avg(j,l)=usp_avg(j,l)/237 ( 836) tsl_ll_avg(j,l)=tsl_ll_avg(j,l)/igm ( 837) ! tsl_ll_avg(j,l)=tsl_ll_avg(j,l)/237 ( 838) enddo ( 839) enddo ( 840) ( 841) !! do l=lsm-1,lsm ( 842) !! do j=90,91 ( 843) ! print *,j,l,tsl_ll_avg(j,l) ( 844) !! enddo ( 845) !! enddo ( 846) ( 847) ( 848) != = = = = = = = = = = = = = = = = = = = = = = = = = = ( 849) ( 850) !VARIABLES WHICH GO TO THE GLOBRUN***.DAT FILES ( 851) !DRAGAN 21.09.10. ( 852) ( 853) != = = = = = = = = = = = = = = = = = = = = = = = = = = ( 854) ( 855) print *, 'writeout to unit 9 .... ' ( 856) ( 857) write(9)tsfc_ll(:,:) !DRAGAN 21.09. ( 858) ( 859) ( 860) !!!avg2017 write(9)psurf_ll(:,:) !DRAGAN 21.09. ( 861) ( 862) ( 863) write(9)pslp_ll(:,:) !DRAGAN 21.09. ( 864) ( 865) !!! write(9)tshltr_ll(:,:) !DRAGAN 21.09. ( 866) ( 867) ( 868) !!! write(9)qshltr_ll(:,:) !DRAGAN 21.09. ( 869) ( 870) ! write(9)plm_ll(:,:) ( 871) !++++++++++++++++++++++++++++++++++++++++++++ ( 872) ( 873) write(9)tshltr_ll(:,:) !DRAGAN 21.09. ( 874) write(9)qshltr_ll(:,:) !DRAGAN 21.09. ( 875) write(9)plm_ll(:,:) ( 876) ( 877) write(9)sfclhx_ll(:,:) !DRAGAN 21.09. ( 878) ( 879) ( 880) write(9)sfcshx_ll(:,:) !DRAGAN 21.09. ( 881) ( 882) !!!avg2017 write(9)qwbs_ll(:,:) !DRAGAN 21.09. ( 883) ( 884) !!!avg2017 write(9)twbs_ll(:,:) !DRAGAN 21.09. ( 885) ( 886) !!!avg2017 write(9)grnflx_ll(:,:) !DRAGAN 21.09. ( 887) ( 888) write(9)vegfrc_ll(:,:) !DRAGAN 21.09. ( 889) ( 890) !!!!!!!! write(9)IVGTYP_ll(:,:) !DRAGAN 21.09. ( 891) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 17 ( 892) !!!!!!!! write(9)ISLTYP_ll(:,:) !DRAGAN 21.09. ( 893) ( 894) !!!!!!!! write(9)glat_ll(:,:) !DRAGAN 21.09. ( 895) ( 896) !!!!!!!! write(9)glon_ll(:,:) !DRAGAN 21.09. ( 897) ( 898) write(9)sm_ll(:,:) !DRAGAN 21.09. ( 899) ( 900) ! do l=1,lsm ( 901) ! write(9)htm_ll(:,:,l) !DRAGAN 17.09. ( 902) ! enddo ( 903) ( 904) ! do l=1,lsm ( 905) ! write(9)vtm_ll(:,:,l) !DRAGAN 17.09. ( 906) ! enddo ( 907) ( 908) ( 909) write(9)sice_ll(:,:) !DRAGAN 21.09. ( 910) ( 911) !!!!!!!! write(9)z0_ll(:,:) !DRAGAN 21.09. ( 912) ( 913) write(9)albedo_ll(:,:) !DRAGAN 21.09. ( 914) ( 915) write(9)albase_ll(:,:) !DRAGAN 21.09. ( 916) ( 917) !!!!!!!! write(9)mxsnal_ll(:,:) !DRAGAN 21.09. ( 918) ( 919) !!!!!!!! write(9)czen_ll(:,:) !DRAGAN 21.09. ( 920) ( 921) !!!!!!!! write(9)czmean_ll(:,:) !DRAGAN 21.09. ( 922) ( 923) !!!avg2017 write(9)fis_ll(:,:) !DRAGAN 21.09. ( 924) ( 925) !!!avg2017 write(9)q10_ll(:,:) !DRAGAN 21.09. ( 926) ( 927) !!!avg2017 write(9)th10_ll(:,:) !DRAGAN 21.09. ( 928) ( 929) !!!!!!!! write(9)qz0_ll(:,:) !DRAGAN 21.09. ( 930) ( 931) !!!!!!!! write(9)thz0_ll(:,:) !DRAGAN 21.09. ( 932) ( 933) ( 934) !!!! write(9)u10_ll(:,:) !DRAGAN 21.09. ( 935) ( 936) !!!! write(9)v10_ll(:,:) !DRAGAN 21.09. ( 937) ( 938) !!!!!!!! write(9)uz0_ll(:,:) !DRAGAN 21.09. ( 939) ( 940) !!!!!!!! write(9)vz0_ll(:,:) !DRAGAN 21.09. ( 941) ( 942) ( 943) !!!!!! write(9)ustar_ll(:,:) !DRAGAN 21.09. ( 944) ( 945) ( 946) ( 947) ( 948) !!!avg2017 write(9)ths_ll(:,:) !DRAGAN 21.09. ( 949) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 18 ( 950) !++++++++++++++++++++++++++++++++++++++++++++ ( 951) !!!!!!!! write(9)RSWIN_ll(:,:) !DRAGAN 21.09. ( 952) ( 953) !!!!!!!! write(9)RSWOUT_ll(:,:) !DRAGAN 21.09. ( 954) ( 955) !!!!!!!! write(9)RSWTOA_ll(:,:) !DRAGAN 21.09. ( 956) ( 957) write(9)ASWIN_ll(:,:) !DRAGAN 21.09. !!!avg2017 ( 958) ( 959) write(9)ASWOUT_ll(:,:) !DRAGAN 21.09. !!!avg2017 ( 960) ( 961) !!!!!!!! write(9)ASWTOA_ll(:,:) !DRAGAN 21.09. ( 962) ( 963) !!!!!!!! write(9)rswnet_ll(:,:) !DRAGAN 21.09. ( 964) !++++++++++++ ( 965) ( 966) !!!!!!!! write(9)RLWIN_ll(:,:) !DRAGAN 21.09. ( 967) ( 968) !!!!!!!! write(9)RLWOUT_ll(:,:) !DRAGAN 21.09. ( 969) ( 970) !!!!!!!! write(9)RLWTOA_ll(:,:) !DRAGAN 21.09. ( 971) ( 972) write(9)ALWIN_ll(:,:) !DRAGAN 21.09. !!!avg2017 ( 973) ( 974) write(9)ALWOUT_ll(:,:) !DRAGAN 21.09. !!!avg2017 ( 975) ( 976) write(9)ALWTOA_ll(:,:) !DRAGAN 21.09. !!!avg2017 ( 977) ( 978) !!!!!!!! write(9)rlwnet_ll(:,:) !DRAGAN 21.09. ( 979) ( 980) !!!!!!!! write(9)epsr_ll(:,:) !DRAGAN 21.09. ( 981) ( 982) !!!!!!!! write(9)radot_ll(:,:) !DRAGAN 21.09. ( 983) ( 984) !!!avg2017 write(9)sigt4_ll(:,:) !DRAGAN 21.09. ( 985) !++++++++++++ ( 986) ( 987) !!!avg2017 write(9)CUPPT_ll(:,:) !DRAGAN 21.09. ( 988) ( 989) !!!avg2017 write(9)cfracl_ll(:,:) !DRAGAN 21.09. ( 990) ( 991) !!!avg2017 write(9)cfracm_ll(:,:) !DRAGAN 21.09. ( 992) ( 993) !!!avg2017 write(9)cfrach_ll(:,:) !DRAGAN 21.09. ( 994) ( 995) !!!avg2017 write(9)acfrcv_ll(:,:) !DRAGAN 21.09. ( 996) ( 997) !!!avg2017 write(9)acfrst_ll(:,:) !DRAGAN 21.09. ( 998) ( 999) !!!avg2017 write(9)cnvtop_ll(:,:) !DRAGAN 21.09. ( 1000) ( 1001) !!!avg2017 write(9)cnvbot_ll(:,:) !DRAGAN 21.09. ( 1002) ( 1003) write(9)htop_ll(:,:) !DRAGAN 21.09. !!!avg2017 ( 1004) ( 1005) write(9)hbot_ll(:,:) !DRAGAN 21.09. !!!avg2017 ( 1006) ( 1007) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 19 ( 1008) !++++++++++++ ( 1009) write(9)acprec_ll(:,:) !DRAGAN 21.09. ( 1010) ( 1011) write(9)cuprec_ll(:,:) !DRAGAN 21.09. ( 1012) ( 1013) write(9)aprec_ll(:,:) !DRAGAN 21.09. ( 1014) ( 1015) write(9)acsnow_ll(:,:) !DRAGAN 21.09. ( 1016) ( 1017) !!!avg2017 write(9)acsnom_ll(:,:) !DRAGAN 21.09. ( 1018) ( 1019) write(9)prec_ll(:,:) !DRAGAN 21.09. ( 1020) ( 1021) !++++++++++++ ( 1022) ( 1023) ( 1024) write(9)stc_ll(:,:,1) !DRAGAN 21.09. ( 1025) ( 1026) write(9)stc_ll(:,:,4) !DRAGAN 21.09. ( 1027) ( 1028) write(9)smc_ll(:,:,1) !DRAGAN 21.09. ( 1029) ( 1030) write(9)smc_ll(:,:,4) !DRAGAN 21.09. ( 1031) ( 1032) write(9)SMSTAV_ll(:,:) !DRAGAN 21.09. ( 1033) ( 1034) write(9)BGROFF_ll(:,:) !DRAGAN 21.09. ( 1035) ( 1036) write(9)SSROFF_ll(:,:) !DRAGAN 21.09. ( 1037) ( 1038) !!!avg2017 write(9)cmc_ll(:,:) !DRAGAN 21.09. ( 1039) ( 1040) write(9)potevp_ll(:,:) !DRAGAN 21.09. ( 1041) ( 1042) write(9)potflx_ll(:,:) !DRAGAN 21.09. ( 1043) ( 1044) write(9)sfcevp_ll(:,:) !DRAGAN 21.09. ( 1045) ( 1046) write(9)subshx_ll(:,:) !DRAGAN 21.09. ( 1047) ( 1048) write(9)snopcx_ll(:,:) !DRAGAN 21.09. ( 1049) ( 1050) write(9)si_ll(:,:) !DRAGAN 21.09. ( 1051) ( 1052) !!!avg2017 write(9)sno_ll(:,:) !DRAGAN 21.09. ( 1053) ( 1054) ( 1055) ( 1056) !!!avg2017 write(9)smstot_ll(:,:) !DRAGAN 21.09. ( 1057) ( 1058) !!!avg2017 write(9)soiltb_ll(:,:) !DRAGAN 21.09. ( 1059) ( 1060) ! write(9)tg_ll(:,:) !DRAGAN 21.09. ( 1061) ( 1062) !!!avg2017 write(9)sr_ll(:,:) !DRAGAN 21.09. ( 1063) ( 1064) !!!!!!!! write(9)akhs_ll(:,:) !DRAGAN 21.09. ( 1065) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 20 ( 1066) !!!!!!!! write(9)akms_ll(:,:) !DRAGAN 21.09. ( 1067) ( 1068) !++++++++++++ ( 1069) ! do l=1,lsm ( 1070) !!!!!!!! write(9)RSWTT_ll(:,:,l) !DRAGAN 17.09. ( 1071) ! enddo ( 1072) ( 1073) ! do l=1,lsm ( 1074) !!!!!!!! write(9)RLWTT_ll(:,:,l) !DRAGAN 17.09. ( 1075) ! enddo ( 1076) ( 1077) ! do l=1,lsm ( 1078) !!!!!!!! write(9)omgalf_ll(:,:,l) !DRAGAN 17.09. ( 1079) ! enddo ( 1080) ( 1081) ! do l=1,lsm ( 1082) !!!!!!!! write(9)q2_ll(:,:,l) !DRAGAN 17.09. ( 1083) ! enddo ( 1084) ( 1085) ! do l=1,lsm ( 1086) !!!!!!!! write(9)tcucn_ll(:,:,l) !DRAGAN 17.09. ( 1087) ! enddo ( 1088) ( 1089) ! do l=1,lsm ( 1090) !!!!!!!! write(9)train_ll(:,:,l) !DRAGAN 17.09. ( 1091) ! enddo ( 1092) ( 1093) !!!avg2017 do l=1,lsm ( 1094) !!!avg2017 write(9)div_ll(:,:,l) !DRAGAN 17.09. ( 1095) !!!avg2017 enddo ( 1096) ( 1097) !!!avg2017 do l=1,lsm ( 1098) !!!avg2017 write(9)rtop_ll(:,:,l) !DRAGAN 17.09. ( 1099) !!!avg2017 enddo ( 1100) ( 1101) ( 1102) !++++++++++++++ ( 1103) !!! do l=1,lsm ( 1104) !!! write(9)w_ll(:,:,l) !DRAGAN 2016 ( 1105) !!! enddo ( 1106) ( 1107) !!! do l=1,lsm ( 1108) !!! write(9)dwdt_ll(:,:,l) !DRAGAN 2016 ( 1109) !!! enddo ( 1110) ( 1111) !!! do l=1,lsm ( 1112) !!! write(9)z_ll(:,:,l) !DRAGAN 2016 ( 1113) !!! enddo ( 1114) ( 1115) ( 1116) do l=1,lsm ( 1117) write(9)hgt_ll(:,:,l) !DRAGAN 17.09. ( 1118) enddo ( 1119) ( 1120) do l=1,lsm ( 1121) write(9)tsl_ll(:,:,l) !DRAGAN 21.09. ( 1122) enddo ( 1123) PGF90 (Version 12.8) 08/30/2020 00:27:46 page 21 ( 1124) !!!avg2017 do l=1,lsm ( 1125) !!!avg2017 write(9)fsl_ll(:,:,l) !DRAGAN 21.09. ( 1126) !!!avg2017 enddo ( 1127) ( 1128) do l=1,lsm ( 1129) write(9)qsl_ll(:,:,l) !DRAGAN 21.09. ( 1130) enddo ( 1131) ( 1132) !!!avg2017 do l=1,lsm ( 1133) !!!avg2017 write(9)q2sl_ll(:,:,l) !DRAGAN 21.09. ( 1134) !!!avg2017 enddo ( 1135) ( 1136) do l=1,lsm ( 1137) write(9)usp(:,:,l) !DRAGAN 21.09. ( 1138) enddo ( 1139) ( 1140) do l=1,lsm ( 1141) write(9)vsp(:,:,l) !DRAGAN 21.09. ( 1142) enddo ( 1143) ( 1144) ( 1145) != = = = = = = = = = = = = = = = = = = = = = = = = = ( 1146) ( 1147) ( 1148) ( 1149) ( 1150) ! write(10)hgt_ll(:,:,10) !DRAGAN 17.09 ( 1151) ! write(10)hgt_ll(:,:,4) ( 1152) !DRAGAN 17.09 write(9)tsl_ll_avg ( 1153) !DRAGAN 17.09. write(9)usp_avg ( 1154) ( 1155) !DRAGAN 20.09. print *,'igm=',igm, 'jgm=',jgm ( 1156) ( 1157) ( 1158) DEALLOCATE(fsl,usl,vsl,ull,vll,qsl,tsl,q2sl,tsfc) ( 1159) DEALLOCATE(fsl_ll,hgt_ll,usp,vsp,qsl_ll,tsl_ll,q2sl_ll) ( 1160) ! DEALLOCATE(usl,vsl,ull,vll,qsl,tsl,tsfc) ( 1161) ! DEALLOCATE(hgt_ll,usp,vsp,qsl_ll,tsl_ll) ( 1162) DEALLOCATE(SMSTAV_ll,BGROFF_ll,SSROFF_ll) ( 1163) print *, 'leaving qu2ll2 .... ' ( 1164) ( 1165) end subroutine qu2ll2