diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index cbab52377..14b728631 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -169,16 +169,16 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain du3dt(i,k) = du3dt(i,k) + (gu0(i,k)-save_u(i,k)) * frain dv3dt(i,k) = dv3dt(i,k) + (gv0(i,k)-save_v(i,k)) * frain - ! convective mass fluxes - upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) - dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) - det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) enddo enddo if(qdiag3d) then do k=1,levs do i=1,im dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k)-save_qv(i,k)) * frain + ! convective mass fluxes + upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) + dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) + det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) enddo enddo endif diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 026e91416..cd13e2721 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -538,8 +538,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, tem = prsl(i,1) / (rd*t1(i)*(one+fvirt*max(q1(i), qmin))) ushfsfci(i) = -cp * tem * hflx(i) ! upward sensible heat flux enddo - ! dkt_cpl has dimensions (1:im,1:levs), but dkt has (1:im,1:levs-1) - dkt_cpl(1:im,1:levs-1) = dkt(1:im,1:levs-1) + dkt_cpl(1:im,1:levs) = dkt(1:im,1:levs) endif diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 8f4bc90fc..3cf93d54e 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -1327,9 +1327,9 @@ optional = F [dkt] standard_name = atmosphere_heat_diffusivity - long_name = diffusivity for heat + long_name = atmospheric heat diffusivity units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 0c9eaf3f0..e3ae929ba 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -204,7 +204,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & real(kind=kind_phys), dimension(im,lm+LTP,NF_VGAS) :: gasvmr real(kind=kind_phys), dimension(im,lm+LTP,NBDSW,NF_AESW) :: faersw real(kind=kind_phys), dimension(im,lm+LTP,NBDLW,NF_AELW) :: faerlw - + ! for stochastic cloud perturbations real(kind=kind_phys), dimension(im) :: cldp1d real (kind=kind_phys) :: alpha0,beta0,m,s,cldtmp,tmp_wt,cdfz @@ -352,7 +352,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & if ( plvl(i,lla) <= prsmin ) plvl(i,lla) = 2.0*prsmin plyr(i,lyb) = 0.5 * plvl(i,lla) tlyr(i,lyb) = tlyr(i,lya) - prslk1(i,lyb) = (plyr(i,lyb)*0.001) ** rocp ! plyr in Pa + prslk1(i,lyb) = (plyr(i,lyb)*0.001) ** rocp ! plyr in hPa rhly(i,lyb) = rhly(i,lya) qstl(i,lyb) = qstl(i,lya) enddo @@ -638,12 +638,12 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & enddo enddo ! for Thompson MP - prepare variables for calc_effr - if (imp_physics == imp_physics_thompson .and. ltaerosol) then + if_thompson: if (imp_physics == imp_physics_thompson .and. ltaerosol) then do k=1,LMK do i=1,IM - qvs = qgrs(i,k,ntqv) + qvs = qlyr(i,k) qv_mp (i,k) = qvs/(1.-qvs) - rho (i,k) = con_eps*prsl(i,k)/(con_rd*tgrs(i,k)*(qv_mp(i,k)+con_eps)) + rho (i,k) = con_eps*plyr(i,k)*100./(con_rd*tlyr(i,k)*(qv_mp(i,k)+con_eps)) orho (i,k) = 1.0/rho(i,k) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) @@ -656,9 +656,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & elseif (imp_physics == imp_physics_thompson) then do k=1,LMK do i=1,IM - qvs = qgrs(i,k,ntqv) + qvs = qlyr(i,k) qv_mp (i,k) = qvs/(1.-qvs) - rho (i,k) = con_eps*prsl(i,k)/(con_rd*tgrs(i,k)*(qv_mp(i,k)+con_eps)) + rho (i,k) = con_eps*plyr(i,k)*100./(con_rd*tlyr(i,k)*(qv_mp(i,k)+con_eps)) orho (i,k) = 1.0/rho(i,k) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) @@ -667,7 +667,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ni_mp (i,k) = tracer1(i,k,ntinc)/(1.-qvs) enddo enddo - endif + endif if_thompson endif do n=1,ncndl do k=1,LMK @@ -903,8 +903,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & do i =1, im do k =1, lmk - qc_save(i,k) = ccnd(i,k,1) - qi_save(i,k) = ccnd(i,k,2) + qc_save(i,k) = ccnd(i,k,1) + qi_save(i,k) = ccnd(i,k,2) qs_save(i,k) = ccnd(i,k,4) enddo enddo diff --git a/physics/cires_orowam2017.F90 b/physics/cires_orowam2017.F90 deleted file mode 100644 index d5fda5cc0..000000000 --- a/physics/cires_orowam2017.F90 +++ /dev/null @@ -1,354 +0,0 @@ -module cires_orowam2017 - - -contains - - - subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, & - & dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL, & - & grav, omega, con_rd, del, sigma, hprime, gamma, theta, & - & sinlat, xlatd, taup, taud, pkdis) -! - USE MACHINE , ONLY : kind_phys -! - implicit none - - integer :: im, levs - integer :: npt - integer :: kdt, me, master - integer :: kref(im), ipt(im) - real(kind=kind_phys), intent(in) :: dtp, dxres - real(kind=kind_phys), intent(in) :: taub(im) - - real(kind=kind_phys), intent(in) :: sinlat(im), xlatd(im) - real(kind=kind_phys), intent(in), dimension(im) :: sigma, & - & hprime, gamma, theta - - real(kind=kind_phys), intent(in), dimension(im) :: xn, yn - - real(kind=kind_phys), intent(in), dimension(im, levs) :: & - & u1, v1, t1, bn2, rho, prsl, del - real(kind=kind_phys), intent(in) :: grav, omega, con_rd - - real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi -! -! out : taup, taud, pkdis -! - real(kind=kind_phys), intent(inout), dimension(im, levs+1) :: taup - real(kind=kind_phys), intent(inout), dimension(im, levs) :: taud - real(kind=kind_phys), intent(inout), dimension(im, levs) :: pkdis - real(kind=kind_phys) :: belps, aelps, nhills, selps -! -! multiwave oro-spectra -! locals -! - integer :: i, j, k, isp, iw - - integer, parameter :: nworo = 30 - real(kind=kind_phys), parameter :: fc_flag = 0.0 - real(kind=kind_phys), parameter :: mkzmin = 6.28e-3/50.0 - real(kind=kind_phys), parameter :: mkz2min = mkzmin* mkzmin - real(kind=kind_phys), parameter :: kedmin = 1.e-3 - real(kind=kind_phys), parameter :: kedmax = 350.,axmax=250.e-5 - real(kind=kind_phys), parameter :: rtau = 0.01 ! nonlin-OGW scale 1/10sec - real(kind=kind_phys), parameter :: Linsat2 =0.5 - real(kind=kind_phys), parameter :: kxmin = 6.28e-3/100. - real(kind=kind_phys), parameter :: kxmax = 6.28e-3/5.0 - real(kind=kind_phys), parameter :: dkx = (kxmax -kxmin)/(nworo-1) - real(kind=kind_phys), parameter :: kx_slope= -5./3. - real(kind=kind_phys), parameter :: hps =7000., rhp2 = .5/hps - real(kind=kind_phys), parameter :: cxmin=0.5, cxmin2=cxmin*cxmin - - real :: akx(nworo), cxoro(nworo), akx2(nworo) - real :: aspkx(nworo), c2f2(nworo) , cdf2(nworo) - real :: tau_sp(nworo,levs+1), wkdis(nworo, levs+1) - real :: tau_kx(nworo),taub_kx(nworo) - real, dimension(nworo, levs+1) :: wrms, akzw - - real :: tauz(levs+1), rms_wind(levs+1) - real :: wave_act(nworo,levs+1) - - real :: kxw, kzw, kzw2, kzw3, kzi, dzmet, rhoint - real :: rayf, kturb - real :: uz, bv, bv2,kxsp, fcor2, cf2 - - real :: fdis - real :: wfdm, wfdt, wfim, wfit - real :: betadis, betam, betat, kds, cx, rhofac - real :: etwk, etws, tauk, cx2sat - real :: cdf1, tau_norm -! -! mean flow -! - real, dimension(levs+1) :: uzi,rhoi,ktur, kalp, dzi - - integer :: nw, nzi, ksrc - taud (:, :) = 0.0 ; pkdis(:,:) = 0.0 ; taup (:,:) = 0.0 - tau_sp (:,:) = 0.0 ; wrms(:,:) = 0.0 - nw = nworo - nzi = levs+1 - - do iw = 1, nw -! !kxw = 0.25/(dxres)*iw - kxw = kxmin+(iw-1)*dkx - akx(iw) = kxw - akx2(iw) = kxw*kxw - aspkx(iw) = kxw ** (kx_slope) - tau_kx(iw) = aspkx(iw)*dkx - enddo - - tau_norm = sum(tau_kx) - tau_kx(:) = tau_kx(:)/tau_norm - - if (kdt == 1) then -771 format( 'vay-oro19 ', 3(2x,F8.3)) - write(6,771) & - & maxval(tau_kx)*maxval(taub)*1.e3, & - & minval(tau_kx), maxval(tau_kx) - endif -! -! main loop over oro-points -! - do i =1, npt - j = ipt(i) - -! -! estimate "nhills" => stochastic choices for OGWs -! - if (taub(i) > 0.) then -! -! max_kxridge =min( .5*sigma(j)/hprime(j), kmax) -! ridge-dependent dkx = (max_kxridge -kxmin)/(nw-1) -! option to make grid-box variable kx-spectra kxw = kxmin+(iw-1)*dkx -! - wave_act(1:nw, 1:levs+1) = 1.0 - ksrc = kref(i) - tauz(1:ksrc) = taub(i) - taub_kx(1:nw) = tau_kx(1:nw) * taub(i) - wkdis(:,:) = kedmin - - call oro_meanflow(levs, nzi, u1(j,:), v1(j,:), t1(j,:), & - & prsi(j,:), prsL(j,:), grav, con_rd, & - & del(j,:), rho(i,:), & - & bn2(i,:), uzi, rhoi,ktur, kalp,dzi, & - & xn(i), yn(i)) - - fcor2 = (2*omega*sinlat(j))*(2*omega*sinlat(j))*fc_flag - - k = ksrc - - bv2 = bn2(i,k) - uz = uzi(k) !u1(j,ksrc)*xn(i)+v1(j,ksrc)*yn(i)! - kturb = ktur(k) - rayf = kalp(k) - rhoint = rhoi(k) - dzmet = dzi(k) - kzw = max(sqrt(bv2)/max(cxmin, uz), mkzmin) -! -! specify oro-kx spectra and related variables k=ksrc -! - do iw = 1, nw - kxw = akx(iw) - cxoro(iw) = 0.0 - uz - c2f2(iw) = fcor2/akx2(iw) - wrms(iw,k)= taub_kx(iw)/rhoint*kzw/kxw - tau_sp(iw, k) = taub_kx(iw) -! -! - if (cxoro(iw) > cxmin) then - wave_act(iw,k:levs+1) = 0. ! crit-level - else - cdf2(iw) = cxoro(iw)*cxoro(iw) -c2f2(iw) - if ( cdf2(iw) < cxmin2) then - wave_act(iw,k:levs+1) = 0. ! coriolis cut-off - else - kzw2 = max(Bv2/Cdf2(iw) - akx2(iw), mkz2min) - kzw = sqrt(kzw2) - akzw(iw,k)= kzw - wrms(iw,k)= taub_kx(iw)/rhoint * kzw/kxw - endif - endif - enddo ! nw-spectral loop -! -! defined abobe, k = ksrc: akx(nworo), cxoro(nworo), tau_sp(ksrc, nworo) -! propagate upward multiwave-spectra are filtered by dissipation & instability -! -! tau_sp(:,ksrc+1:levs+1) = tau_sp(:, ksrc) - do k= ksrc+1, levs - uz = uzi(k) - bv2 =bn2(i,k) - bv = sqrt(bv2) - rayf = kalp(k) - rhoint= rhoi(k) - dzmet = dzi(k) - rhofac = rhoi(k-1)/rhoi(k) - - do iw = 1, nworo -! - if (wave_act(iw, k-1) <= 0.0) cycle - cxoro(iw)= 0.0 - uz - if ( cxoro(iw) > cxmin) then - wave_act(iw,k:levs+1) = 0.0 ! crit-level - else - cdf2(iw) = cxoro(iw)*cxoro(iw) -c2f2(iw) - if ( cdf2(iw) < cxmin2) wave_act(iw,k:levs+1) = 0.0 - endif - if ( wave_act(iw,k) <= 0.0) cycle -! -! upward propagation -! - kzw2 = Bv2/Cdf2(iw) - akx2(iw) - - if (kzw2 < mkz2min) then - wave_act(iw,k:levs+1) = 0.0 - else -! -! upward propagation w/o reflection -! - kxw = akx(iw) - kzw = sqrt(kzw2) - akzw(iw,k) = kzw - kzw3 = kzw2*kzw - - cx = cxoro(iw) - betadis = cdf2(iw) / (Cx*Cx+c2f2(iw)) - betaM = 1.0 / (1.0+betadis) - betaT = 1.0 - BetaM - kds = wkdis(iw,k-1) - - etws = wrms(iw,k-1)*rhofac * kzw/akzw(iw,k-1) - - kturb = ktur(k)+pkdis(j,k-1) - wfiM = kturb*kzw2 +rayf - wfiT = wfiM ! do updates with Pr-numbers Kv/Kt - cdf1 = sqrt(Cdf2(iw)) - wfdM = wfiM/(kxw*Cdf1)*BetaM - wfdT = wfiT/(kxw*Cdf1)*BetaT - kzi = 2.*kzw*(wfdM+wfdT)*dzmet - Fdis = exp(-kzi) - - etwk = etws*Fdis - Cx2sat = Linsat2*Cdf2(iw) - - if (etwk > cx2sat) then - Kds = kxw*Cdf1*rhp2/kzw3 - etwk = cx2sat - wfiM = kds*kzw2 - wfdM = wfiM/(kxw*Cdf1) - kzi = 2.*kzw*(wfdm + wfdm)*dzmet - etwk = cx2sat*exp(-kzi) - endif -! if( lat(j) eq 40.5 ) then stop - wkdis(iw,k) = kds - wrms(iw,k) = etwk - tauk = etwk*kxw/kzw - tau_sp(iw,k) = tauk *rhoint - if ( tau_sp(iw,k) > tau_sp(iw,k-1)) & - & tau_sp(iw,k) = tau_sp(iw,k-1) - - ENDIF ! upward - ENDDO ! spectral - -!......... do spectral sum of rms, wkdis, tau - - tauz(k) = sum( tau_sp(:,k)*wave_act(:,k) ) - rms_wind(k) = sum( wrms(:,k)*wave_act(:,k) ) - - pkdis(j,k) = sum(wkdis(:,k)*wave_act(:,k))+rms_wind(k)*rtau - - if (pkdis(j,k) > kedmax) pkdis(j,k) = kedmax - - ENDDO ! k=ksrc+1, levs - - k = ksrc - tauz(k) = sum(tau_sp(:,k)*wave_act(:,k)) - tauz(k) = tauz(k+1) ! zero momentum dep-n at k=ksrc - - pkdis(j,k) = sum(wkdis(:,k)*wave_act(:,k)) - rms_wind(k) = sum(wrms(:,k)*wave_act(:,k)) - tauz(levs+1) = tauz(levs) - taup(i, 1:levs+1) = tauz(1:levs+1) - do k=ksrc, levs - taud(i,k) = ( tauz(k+1) - tauz(k))*grav/del(j,k) -! if (taud(i,k) .gt. 0)taud(i,k)=taud(i,k)*.01 -! if (abs(taud(i,k)).ge.axmax)taud(i,k)=sign(taud(i,k),axmax) - enddo - endif ! taub > 0 - enddo ! oro-points (i, j, ipt) -!23456 - end subroutine oro_wam_2017 -!------------------------------------------------------------- -! -! define mean flow and dissipation for OGW-kx spectrum -! -!------------------------------------------------------------- - subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & - & grav, con_rd, & - & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) - - use ugwp_common_v1 , only : velmin, dw2min - implicit none - - integer :: nz, nzi - real, dimension(nz ) :: u1, v1, t1, delp, rho, pmid - real, dimension(nz ) :: bn2 ! define at the interfaces - real, dimension(nz+1) :: pint - real :: xn, yn - real,intent(in) :: grav, con_rd -! output - - real, dimension(nz+1) :: dzi, uzi, rhoi, ktur, kalp - -! locals - integer :: i, j, k - real :: ui, vi, ti, uz, vz, shr2, rdz, kamp - real :: zgrow, zmet, rdpm, ritur, kmol, w1 - real :: rgrav, rdi -! paremeters - real, parameter :: hps = 7000., rpspa = 1.e-5 - real, parameter :: rhps=1.0/hps - real, parameter :: h4= 0.25/hps - real, parameter :: rimin = 1.0/8.0, kedmin = 0.01 - real, parameter :: lturb = 30. , uturb = 150.0 - real, parameter :: lsc2 = lturb*lturb,usc2 = uturb*uturb - kalp(1:nzi) = 2.e-7 ! radiative damping - - rgrav = 1.0/grav - rdi = 1.0/con_rd - - do k=2, nz - rdpm = grav/(pmid(k-1)-pmid(k)) - ui = .5*(u1(k-1)+u1(k)) - vi = .5*(v1(k-1)+v1(k)) - uzi(k) = Ui*xn + Vi*yn - ti = .5*(t1(k-1)+t1(k)) - rhoi(k) = rdi*pint(k)/ti - rdz = rdpm *rhoi(k) - dzi(k) = 1./rdz - uz = u1(k)-u1(k-1) - vz = v1(k)-v1(k-1) - shr2 = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) - zmet = -hps*alog(pint(k)*rpspa) - zgrow = exp(zmet*h4) - kmol = 2.e-5*exp(zmet*rhps)+kedmin - ritur = max(bn2(k)/shr2, rimin) - kamp = sqrt(shr2)*lsc2 *zgrow - w1 = 1./(1. + 5*ritur) - ktur(k) = kamp * w1 * w1 +kmol - enddo - - k = 1 - uzi(k) = uzi(k+1) - ktur(k) = ktur(k+1) - rhoi(k) = rdi*pint(k)/t1(k+1) - dzi(k) = rgrav*delp(k)/rhoi(k) - - k = nzi - uzi(k) = uzi(k-1) - ktur(k) = ktur(k-1) - rhoi(k) = rhoi(k-1)*.5 - dzi(k) = dzi(k-1) - - end subroutine oro_meanflow - -end module cires_orowam2017 diff --git a/physics/cires_ugwpv1_oro.F90 b/physics/cires_ugwpv1_oro.F90 index 46191f404..904731b16 100644 --- a/physics/cires_ugwpv1_oro.F90 +++ b/physics/cires_ugwpv1_oro.F90 @@ -848,7 +848,6 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & call oro_spectral_solver(im, km, npt, ipt, kref, kdt, me, master, & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsl, & - grav, omega1, rd, & del, sigma, hprime, gamma, theta, sinlat, xlatd, taup, taud, pkdis) endif ! oro_linsat - linsatdis-solver for stationary OGWs diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index 5924de96f..240dfdc3c 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -111,7 +111,7 @@ SUBROUTINE myjpbl_wrapper_run( & ! dudt, dvdt, dtdt, dkt real(kind=kind_phys),dimension(im,levs),intent(inout) :: & dudt, dvdt, dtdt - real(kind=kind_phys),dimension(im,levs-1),intent(out) :: & + real(kind=kind_phys),dimension(im,levs),intent(out) :: & dkt real(kind=kind_phys),dimension(:,:),intent(inout) :: & du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index 758dfb77b..877301cc4 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -535,9 +535,9 @@ optional = F [dkt] standard_name = atmosphere_heat_diffusivity - long_name = diffusivity for heat + long_name = atmospheric heat diffusivity units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/moninedmf.f b/physics/moninedmf.f index dfd1e7774..1344eab56 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -116,7 +116,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & dtsfc(im), dqsfc(im), & & hpbl(im) real(kind=kind_phys), intent(out) :: & - & dkt(im,km-1), dku(im,km-1) + & dkt(im,km), dku(im,km) real(kind=kind_phys), intent(inout) :: & & hgamt(im), hgamq(im) ! diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index b94515931..7cda18a5c 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -421,18 +421,18 @@ optional = F [dkt] standard_name = atmosphere_heat_diffusivity - long_name = diffusivity for heat + long_name = atmospheric heat diffusivity units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out optional = F [dku] standard_name = atmosphere_momentum_diffusivity - long_name = diffusivity for momentum + long_name = atmospheric momentum diffusivity units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/moninshoc.f b/physics/moninshoc.f index eb9a5d963..2c18887d9 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -71,7 +71,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, real(kind=kind_phys), dimension(im), intent(out) :: dusfc, & dvsfc, dtsfc, dqsfc, hpbl real(kind=kind_phys), dimension(im,km), intent(out) :: prnum - real(kind=kind_phys), dimension(im,km-1), intent(out) :: dkt + real(kind=kind_phys), dimension(im,km), intent(out) :: dkt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index f550c5b59..5cff902d7 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -362,9 +362,9 @@ optional = F [dkt] standard_name = atmosphere_heat_diffusivity - long_name = diffusivity for heat + long_name = atmospheric heat diffusivity units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 062c36b3e..d6de1a065 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -110,7 +110,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & dtsfc(im), dqsfc(im), & & hpbl(im) real(kind=kind_phys), intent(out) :: & - & dkt(im,km-1), dku(im,km-1) + & dkt(im,km), dku(im,km) ! logical, intent(in) :: dspheat character(len=*), intent(out) :: errmsg diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 862290cb2..5ea52a5a3 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -533,18 +533,18 @@ optional = F [dkt] standard_name = atmosphere_heat_diffusivity - long_name = diffusivity for heat + long_name = atmospheric heat diffusivity units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out optional = F [dku] standard_name = atmosphere_momentum_diffusivity - long_name = diffusivity for momentum + long_name = atmospheric momentum diffusivity units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 93e2bb11e..067e5ad4e 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -2684,8 +2684,8 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & close(lugb) call baopenr(lugb,fngrib,iret) if (iret .ne. 0) then - write(6,*) ' error in opening file ',trim(fngrib) - print *,'error in opening file ',trim(fngrib) + write(6,*) ' FATAL ERROR: in opening file ',trim(fngrib) + print *,'FATAL ERROR: in opening file ',trim(fngrib) call abort endif if (me .eq. 0) write(6,*) ' file ',trim(fngrib), @@ -2712,8 +2712,8 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & kpds0(4)=-1 kpds0(18)=-1 if(iret.ne.0) then - write(6,*) ' error in getgbh. iret: ', iret - if (iret == 99) write(6,*) ' field not found.' + write(6,*) ' FATAL ERROR: in getgbh. iret: ', iret + if (iret == 99) write(6,*) ' Field not found.' call abort endif ! @@ -2731,13 +2731,13 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & data8 = real(data4, kind=kind_io8) deallocate(data4) else - write(0,*)' Invalid w3kindreal --- aborting' + write(0,*)' FATAL ERROR: Invalid w3kindreal' call abort endif ! if(jret == 0) then if(ndata.eq.0) then - write(6,*) ' error in getgb' + write(6,*) ' FATAL ERROR: in getgb' write(6,*) ' kpds=',kpds write(6,*) ' kgds=',kgds call abort @@ -2753,7 +2753,7 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & else if (me ==. 0) write(6,*) 'idim,jdim=',idim,jdim &, ' gaus=',gaus,' blno=',blno,' blto=',blto - write(6,*) ' error in getgb : jret=',jret + write(6,*) ' FATAL ERROR in getgb : jret=',jret write(6,*) ' kpds(13)=',kpds(13),' kpds(15)=',kpds(15) call abort endif @@ -2828,18 +2828,18 @@ subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr,me) return ! elseif(kgds(1).eq.1) then ! mercator projection - write(6,*) 'mercator grid' - write(6,*) 'cannot process' + write(6,*) 'FATAL ERROR: cannot process' + write(6,*) 'mercator grid.' call abort ! elseif(kgds(1).eq.2) then ! gnomonic projection - write(6,*) 'gnomonic grid' - write(6,*) 'error!! gnomonic projection not coded' + write(6,*) 'FATAL ERROR: cannot process' + write(6,*) 'gnomonic grid.' call abort ! elseif(kgds(1).eq.3) then ! lambert conformal - write(6,*) 'lambert conformal' - write(6,*) 'cannot process' + write(6,*) 'FATAL ERROR: cannot process' + write(6,*) 'lambert conformal grid.' call abort elseif(kgds(1).eq.4) then ! gaussian grid ! @@ -2881,33 +2881,33 @@ subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr,me) return ! elseif(kgds(1).eq.5) then ! polar strereographic - write(6,*) 'polar stereographic grid' - write(6,*) 'cannot process' + write(6,*) 'FATAL ERROR: cannot process' + write(6,*) 'polar stereographic grid.' call abort return ! elseif(kgds(1).eq.13) then ! oblique lambert conformal - write(6,*) 'oblique lambert conformal grid' - write(6,*) 'cannot process' + write(6,*) 'FATAL ERROR: cannot process' + write(6,*) 'oblique lambert conformal grid.' call abort ! elseif(kgds(1).eq.50) then ! spherical coefficient - write(6,*) 'spherical coefficient' - write(6,*) 'cannot process' + write(6,*) 'FATAL ERROR: cannot process' + write(6,*) 'spherical coefficient grid.' call abort return ! elseif(kgds(1).eq.90) then ! space view perspective ! (orthographic grid) - write(6,*) 'space view perspective grid' - write(6,*) 'cannot process' + write(6,*) 'FATAL ERROR: cannot process' + write(6,*) 'space view perspective grid.' call abort return ! else ! unknown projection. abort. - write(6,*) 'error!! unknown map projection' + write(6,*) 'FATAL ERROR: Unknown map projection.' write(6,*) 'kgds(1)=',kgds(1) - print *,'error!! unknown map projection' + print *,'FATAL ERROR: Unknown map projection.' print *,'kgds(1)=',kgds(1) call abort endif @@ -3428,9 +3428,11 @@ subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp,& i2 = iindx2(i) if(wrk(i) .eq. 0.0) then if(.not.lmask) then - if (num_threads == 1) - & write(6,*) ' la2ga called with lmask=.true. but bad', - & ' rslmsk or slmask given' + if (num_threads == 1) then + write(6,*) ' FATAL ERROR: la2ga called' + write(6,*) ' with lmask=true. But bad rslmsk' + write(6,*) ' or slmask given.' + endif call abort endif ifill(it) = ifill(it) + 1 @@ -3478,7 +3480,8 @@ subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp,& enddo ! if (num_threads == 1) then - write(6,*) ' error!!! no filling value found in la2ga' + write(6,*) ' FATAL ERROR: no filling value' + write(6,*) ' found in routine la2ga.' ! write(6,*) ' i ix jx slmask(i) rslmsk ', ! & i,ix,jx,slmask(i),rslmsk(ix,jx) endif @@ -3707,7 +3710,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irttsf = iret if(iret == 1) then - write(6,*) 't surface analysis read error' + write(6,*) 'FATAL ERROR: t surface analysis read error.' call abort elseif(iret == -1) then if (me == 0) then @@ -3733,11 +3736,13 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, imsk, jmsk, slmskh, gaus,blno, blto &, outlat, outlon, me) if(iret == 1) then - write(6,*) 't surface at ft=0 analysis read error' + write(6,*) 'FATAL ERROR: t surface at ft=0 analysis' + write(6,*) 'read error.' call abort elseif(iret == -1) then if (me == 0) then - write(6,*) 'could not find t surface analysis at ft=0' + write(6,*) 'FATAL ERROR: Could not find t surface' + write(6,*) 'analysis at ft=0.' endif call abort else @@ -3760,7 +3765,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtalb = iret if(iret == 1) then - write(6,*) 'albedo analysis read error' + write(6,*) 'FATAL ERROR: albedo analysis read error.' call abort elseif(iret == -1) then if (me == 0) then @@ -3791,7 +3796,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtalf = iret if(iret == 1) then - write(6,*) 'albedo analysis read error' + write(6,*) 'FATAL ERROR: albedo analysis read error.' call abort elseif(iret == -1) then if (me == 0) then @@ -3822,7 +3827,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtwet=iret if(iret.eq.1) then - write(6,*) 'bucket wetness analysis read error' + write(6,*) 'FATAL ERROR: bucket wetness analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -3844,7 +3849,8 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtsmc=iret if(iret.eq.1) then - write(6,*) 'layer soil wetness analysis read error' + write(6,*) 'FATAL ERROR: layer soil wetness analysis' + write(6,*) 'read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -3879,8 +3885,8 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & !cggg the grib parameter id number. call baopenr(lugb,fnsnoa,iret) if (iret .ne. 0) then - write(6,*) ' error in opening file ',trim(fnsnoa) - print *,'error in opening file ',trim(fnsnoa) + write(6,*) 'FATAL ERROR: in opening file ',trim(fnsnoa) + print *,'FATAL ERROR: in opening file ',trim(fnsnoa) call abort endif lugi=0 @@ -3892,8 +3898,9 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & & lskip,kpds,kgds,iret) close(lugb) if (iret .ne. 0) then - write(6,*) ' error reading header of file: ',trim(fnsnoa) - print *,'error reading header of file: ',trim(fnsnoa) + write(6,*) ' FATAL ERROR: reading header' + write(6,*) ' of file: ',trim(fnsnoa) + print *,'FATAL ERROR: reading header of file: ',trim(fnsnoa) call abort endif if (kgds(1) == 4) then ! gaussian data is depth @@ -3912,7 +3919,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & !cggg snow mods end irtscv=iret if(iret.eq.1) then - write(6,*) 'snow depth analysis read error' + write(6,*) 'FATAL ERROR: snow depth analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -3934,7 +3941,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtsno=iret if(iret.eq.1) then - write(6,*) 'snow cover analysis read error' + write(6,*) 'FATAL ERROR: snow cover analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -3963,7 +3970,8 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtacn=iret if(iret.eq.1) then - write(6,*) 'ice concentration analysis read error' + write(6,*) 'FATAL ERROR: ice concentration' + write(6,*) 'analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -3982,7 +3990,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtais=iret if(iret.eq.1) then - write(6,*) 'ice mask analysis read error' + write(6,*) 'FATAL ERROR: ice mask analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4010,7 +4018,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtzor=iret if(iret.eq.1) then - write(6,*) 'roughness analysis read error' + write(6,*) 'FATAL ERROR: roughness analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4039,7 +4047,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irttg3=iret if(iret.eq.1) then - write(6,*) 'deep soil tmp analysis read error' + write(6,*) 'FATAL ERROR: deep soil tmp analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4062,7 +4070,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtstc=iret if(iret.eq.1) then - write(6,*) 'layer soil tmp analysis read error' + write(6,*) 'FATAL ERROR: layer soil tmp analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4091,7 +4099,8 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtveg=iret if(iret.eq.1) then - write(6,*) 'vegetation cover analysis read error' + write(6,*) 'FATAL ERROR: vegetation cover analysis' + write(6,*) 'read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4120,7 +4129,8 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtvet=iret if(iret.eq.1) then - write(6,*) 'vegetation type analysis read error' + write(6,*) 'FATAL ERROR: vegetation type analysis' + write(6,*) 'read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4149,7 +4159,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtsot=iret if(iret.eq.1) then - write(6,*) 'soil type analysis read error' + write(6,*) 'FATAL ERROR: soil type analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4180,7 +4190,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtvmn=iret if(iret.eq.1) then - write(6,*) 'shdmin analysis read error' + write(6,*) 'FATAL ERROR: shdmin analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4210,7 +4220,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtvmx=iret if(iret.eq.1) then - write(6,*) 'shdmax analysis read error' + write(6,*) 'FATAL ERROR: shdmax analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4240,7 +4250,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtslp=iret if(iret.eq.1) then - write(6,*) 'slope type analysis read error' + write(6,*) 'FATAL ERROR: slope type analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4270,7 +4280,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & &, outlat, outlon, me) irtabs=iret if(iret.eq.1) then - write(6,*) 'snoalb analysis read error' + write(6,*) 'FATAL ERROR: snoalb analysis read error.' call abort elseif(iret.eq.-1) then if (me .eq. 0) then @@ -4451,7 +4461,8 @@ subroutine rof01(aisfld, len, op, crit) endif enddo else - write(6,*) ' illegal operator in rof01. op=',op + write(6,*) ' FATAL ERROR: illegal operator' + write(6,*) ' in rof01. op=',op call abort endif ! @@ -4507,7 +4518,8 @@ subroutine rof01_len(aisfld, len, op, lake, critl, crits) endif enddo else - write(6,*) ' illegal operator in rof01. op=',op + write(6,*) ' FATAL ERROR: illegal operator' + write(6,*) ' in rof01_len. op=',op call abort endif ! @@ -5071,7 +5083,7 @@ subroutine newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil, & do i=1,len if(slifcs(i).ne.slianl(i)) then if(slifcs(i).eq.1..or.slianl(i).eq.1.) then - print *,'inconsistency in slifcs or slianl' + print *,'FATAL ERROR: inconsistency in slifcs or slianl.' print 910,rla(i),rlo(i),slifcs(i),slianl(i), & tsffcs(i),tsfanl(i) 910 format(2x,'at lat=',f5.1,' lon=',f5.1,' slifcs=',f4.1, @@ -5203,7 +5215,8 @@ subroutine qcsice(ais,glacir,amxice,aicice,aicsea,sllnd,slmask, & kount1 = 0 do i=1,len if(ais(i).ne.aicice.and.ais(i).ne.aicsea) then - print *,'sea ice mask not ',aicice,' or ',aicsea + print *,'FATAL ERROR: sea ice' + print *,'mask not ',aicice,' or ',aicsea print *,'ais(i),aicice,aicsea,rla(i),rlo(i,=', & ais(i),aicice,aicsea,rla(i),rlo(i) call abort @@ -6109,6 +6122,8 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, & rltout(j) = rnlat + (j-1) * dlat enddo else ! grib file on some other grid + write(6,*) ' FATAL ERROR: Mask data on' + write(6,*) ' unsupported grid.' call abort endif dlon = 360.0 / imax @@ -7069,7 +7084,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & go to 10 endif enddo - print *,'wrong rjday',rjday + print *,'FATAL ERROR: wrong rjday',rjday call abort 10 continue wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1)) @@ -7148,7 +7163,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & go to 20 endif enddo - print *,'wrong rjday',rjday + print *,'FATAL ERROR: wrong rjday',rjday call abort 20 continue wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1)) @@ -7172,7 +7187,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & go to 30 endif enddo - print *,'wrong rjday',rjday + print *,'FATAL ERROR: wrong rjday',rjday call abort 30 continue wei1s = (dayhf(sea2)-rjday)/(dayhf(sea2)-dayhf(sea1)) @@ -7196,7 +7211,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & go to 31 endif enddo - print *,'wrong rjday',rjday + print *,'FATAL ERROR: wrong rjday',rjday call abort 31 continue wei1y = (dayhf(hyr2)-rjday)/(dayhf(hyr2)-dayhf(hyr1)) @@ -7284,9 +7299,11 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & if (me .eq. 0) write(6,*) 'climatological vegetation', & ' type read in.' elseif(index(fnsmcc,'soilmgldas') /= 0) then ! new soil moisture climo - if (me .eq. 0) write(6,*) 'fatal error: must choose' - if (me .eq. 0) write(6,*) 'climatological veg type when' - if (me .eq. 0) write(6,*) 'using new gldas soil moisture.' + if (me .eq. 0) then + write(6,*) 'FATAL ERROR: must choose' + write(6,*) 'climatological veg type when' + write(6,*) 'using new gldas soil moisture.' + endif call abort endif ! @@ -7499,7 +7516,8 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & deallocate(slmask_noice) endif else - write(6,*) 'climatological soil wetness file not given' + write(6,*) 'FATAL ERROR: climatological soil wetness' + write(6,*) 'file not given.' call abort endif ! @@ -7532,7 +7550,8 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & &, imsk, jmsk, slmskh, gaus,blno, blto &, outlat, outlon, me) else - write(6,*) 'climatological ice cover file not given' + write(6,*) 'FATAL ERROR: climatological ice cover' + write(6,*) 'file not given.' call abort endif ! @@ -7768,7 +7787,8 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & deallocate(slmask_noice) endif else - write(6,*) 'climatological soil wetness file not given' + write(6,*) 'FATAL ERROR: climatological soil wetness' + write(6,*) 'file not given.' call abort endif ! @@ -7786,7 +7806,8 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & &, imsk, jmsk, slmskh, gaus,blno, blto &, outlat, outlon, me) else - write(6,*) 'climatological ice cover file not given' + write(6,*) 'FATAL ERROR: climatological ice cover' + write(6,*) 'file not given.' call abort endif ! @@ -7853,7 +7874,10 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & ! set to point at the proper vegetation type file. if (fnzorc(1:3) == 'sib') then if (fnvetc(1:4) == ' ') then - if (me==0) write(6,*) "must choose sib veg type climo file" + if (me==0) then + write(6,*) "FATAL ERROR: must choose sib" + write(6,*) "vegetation type climo file." + endif call abort endif zorclm = 0.0 @@ -7865,7 +7889,10 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & enddo elseif(fnzorc(1:4) == 'igbp') then if (fnvetc(1:4) == ' ') then - if (me == 0) write(6,*) "must choose igbp veg type climo file" + if (me == 0) then + write(6,*) "FATAL ERROR: must choose igbp" + write(6,*) "vegetation type climo file." + endif call abort endif zorclm = 0.0 @@ -8107,8 +8134,8 @@ subroutine fixrdc_tile(filename_raw, tile_num_ch, & case(256:257) error=nf90_inq_varid(ncid, 'vegetation_greenness', id_var) case default - print*,'fatal error in fixrdc_tile of sfcsub.F.' - print*,'unknown variable.' + print*,'FATAL ERROR in fixrdc_tile of sfcsub.F.' + print*,'Unknown variable.' call abort end select if (error /= nf90_noerr) call netcdf_err(error) @@ -8181,7 +8208,7 @@ subroutine netcdf_err(error) character(len=256) :: errmsg errmsg = nf90_strerror(error) - print*,'fatal error in sfcsub.F: ', trim(errmsg) + print*,'FATAL ERROR in sfcsub.F: ', trim(errmsg) call abort end subroutine netcdf_err @@ -8239,8 +8266,8 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & close(lugb) call baopenr(lugb,fngrib,iret) if (iret .ne. 0) then - write(6,*) ' error in opening file ',trim(fngrib) - print *,'error in opening file ',trim(fngrib) + write(6,*) ' FATAL ERROR: in opening file ',trim(fngrib) + print *,'FATAL ERROR: in opening file ',trim(fngrib) call abort endif if (me .eq. 0) write(6,*) ' file ',trim(fngrib), @@ -8267,8 +8294,8 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & kpds0(4) = -1 kpds0(18) = -1 if(iret.ne.0) then - write(6,*) ' error in getgbh. iret: ', iret - if (iret==99) write(6,*) ' field not found.' + write(6,*) ' FATAL ERROR: in getgbh. iret: ', iret + if (iret==99) write(6,*) ' Field not found.' call abort endif ! @@ -8294,7 +8321,7 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & & (kpds(i),i=8,11) if(jret.eq.0) then if(ndata.eq.0) then - write(6,*) ' error in getgb' + write(6,*) ' FATAL ERROR: in getgb' write(6,*) ' kpds=',kpds write(6,*) ' kgds=',kgds call abort @@ -8311,7 +8338,7 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & enddo if (me .eq. 0) write(6,*) 'imax,jmax,ijmax=',imax,jmax,ijmax else - write(6,*) ' error in getgb - jret=', jret + write(6,*) ' FATAL ERROR: in getgb - jret=', jret call abort endif ! @@ -8470,8 +8497,8 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & close(lugb) call baopenr(lugb,fngrib,iret) if (iret .ne. 0) then - write(6,*) ' error in opening file ',trim(fngrib) - print *,'error in opening file ',trim(fngrib) + write(6,*) ' FATAL ERROR: in opening file ',trim(fngrib) + print *,'FATAL ERROR in opening file ',trim(fngrib) call abort endif if (me .eq. 0) write(6,*) ' file ',trim(fngrib), @@ -8497,8 +8524,8 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & kpds0(4)=-1 kpds0(18)=-1 if(iret.ne.0) then - write(6,*) ' error in getgbh. iret: ', iret - if(iret==99) write(6,*) ' field not found.' + write(6,*) ' FATAL ERROR: in getgbh. iret: ', iret + if(iret==99) write(6,*) ' Field not found.' call abort endif ! @@ -8541,7 +8568,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & & (kpds(i),i=8,11) if(jret.eq.0) then if(ndata.eq.0) then - write(6,*) ' error in getgb' + write(6,*) ' FATAL ERROR: in getgb' write(6,*) ' kpds=',kpds write(6,*) ' kgds=',kgds call abort diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 1f0f02406..844acf722 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -794,7 +794,6 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, - & con_g, con_omega, & del, sigma, hprime, gamma, theta, & sinlat, xlatd, taup, taud, pkdis) diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 649d994a8..2bfb2948d 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -496,16 +496,21 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd !=============================================================== ! ORO-diag - dudt_ogw(:,:) = 0. ; dvdt_ogw(:,:)=0. ; dudt_obl(:,:)=0. ; dvdt_obl(:,:)=0. - dudt_oss(:,:) = 0. ; dvdt_oss(:,:)=0. ; dudt_ofd(:,:)=0. ; dvdt_ofd(:,:)=0. + if (do_ugwp_v1 .or. gwd_opt==33 .or. gwd_opt==22) then + dudt_ogw(:,:)= 0.; dvdt_ogw(:,:)=0.; dudt_obl(:,:)=0.; dvdt_obl(:,:)=0. + dudt_oss(:,:)= 0.; dvdt_oss(:,:)=0.; dudt_ofd(:,:)=0.; dvdt_ofd(:,:)=0. + du_ogwcol(:)=0. ; dv_ogwcol(:)=0. ; du_oblcol(:)=0. ; dv_oblcol(:)=0. + du_osscol(:)=0. ; dv_osscol(:)=0. ;du_ofdcol(:)=0. ; dv_ofdcol(:)=0. + else + dudt_ogw(:,:) = 0. + end if - dusfcg (:) = 0. ; dvsfcg(:) =0. - - du_ogwcol(:)=0. ; dv_ogwcol(:)=0. ; du_oblcol(:)=0. ; dv_oblcol(:)=0. - du_osscol(:)=0. ; dv_osscol(:)=0. ;du_ofdcol(:)=0. ; dv_ofdcol(:)=0. + dusfcg (:) = 0. ; dvsfcg(:) =0. ! - dudt_ngw(:,:)=0. ; dvdt_ngw(:,:)=0. ; dtdt_ngw(:,:)=0. ; kdis_ngw(:,:)=0. + if (do_ugwp_v1) then + dudt_ngw(:,:)=0.; dvdt_ngw(:,:)=0.; dtdt_ngw(:,:)=0.; kdis_ngw(:,:)=0. + end if ! ngw+ogw - diag @@ -703,16 +708,23 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! ! get total sso-OGW + NGW ! - dudt_gw = Pdudt +dudt_ngw - dvdt_gw = Pdvdt +dvdt_ngw - dtdt_gw = Pdtdt +dtdt_ngw - kdis_gw = Pkdis +kdis_ngw + if (do_ugwp_v1) then + dudt_gw = Pdudt + dudt_ngw + dvdt_gw = Pdvdt + dvdt_ngw + dtdt_gw = Pdtdt + dtdt_ngw + kdis_gw = Pkdis + kdis_ngw + else + dudt_gw = Pdudt + dvdt_gw = Pdvdt + dtdt_gw = Pdtdt + kdis_gw = Pkdis + end if ! ! accumulate "tendencies" as in the GFS-ipd (pbl + ugwp + zero-RF) ! - dudt = dudt + dudt_ngw - dvdt = dvdt + dvdt_ngw - dtdt = dtdt + dtdt_ngw + dudt = dudt + dudt_gw + dvdt = dvdt + dvdt_gw + dtdt = dtdt + dtdt_gw end subroutine ugwpv1_gsldrag_run !! @}