From 84918d3f1fe0fe6e46da0e1569113b0b540056b3 Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Sun, 14 Jan 2024 18:26:33 -0700 Subject: [PATCH 1/6] Fixed GNU warning 'Warning: Missing '&' in continued character constant at (1) [-Wampersand]' --- physics/SFC_Models/Lake/CLM/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.f90 b/physics/SFC_Models/Lake/CLM/clm_lake.f90 index 6dd973c8d..59cec6222 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.f90 +++ b/physics/SFC_Models/Lake/CLM/clm_lake.f90 @@ -2305,7 +2305,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! unlike eflx_gnet if(abs(errsoi(c)) > .001_kind_lake) then ! 1.e-5_kind_lake) then WRITE( message,* )'Primary soil energy conservation error in shlake & - column during Tridiagonal Solution,', 'error (W/m^2):', c, errsoi(c) + &column during Tridiagonal Solution,', 'error (W/m^2):', c, errsoi(c) errmsg=trim(message) errflg=1 return From 8fd9a18c803d3a42e9b647d519b2a4d35ec32cc0 Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Sat, 13 Jan 2024 22:56:51 -0700 Subject: [PATCH 2/6] Fixed GNU warnings 'Warning: Nonconforming tab character at (1) [-Wtabs]' --- physics/CONV/Grell_Freitas/cu_gf_deep.F90 | 2 +- physics/GWD/cires_tauamf_data.F90 | 76 +++++------ physics/GWD/ugwp_driver_v0.F | 2 +- physics/PBL/MYNN_EDMF/module_bl_mynn.F90 | 2 +- physics/SFC_Models/Lake/CLM/clm_lake.f90 | 20 +-- physics/SFC_Models/Land/Noah/set_soilveg.f | 40 +++--- physics/SFC_Models/Land/Noah/sflx.f | 2 +- .../Land/Noahmp/module_sf_noahmp_glacier.F90 | 128 +++++++++--------- .../Land/Noahmp/module_sf_noahmplsm.F90 | 106 +++++++-------- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 6 +- .../SFC_Models/Land/RUC/set_soilveg_ruc.F90 | 36 ++--- 11 files changed, 210 insertions(+), 210 deletions(-) diff --git a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 index 5780272c6..d54105f22 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 @@ -5534,7 +5534,7 @@ subroutine get_partition_liq_ice(ierr,tn,po_cup, p_liq_ice,melting_layer ,itf,ktf,its,ite, kts,kte, cumulus ) implicit none character *(*), intent (in) :: cumulus - integer ,intent (in ) :: itf,ktf, its,ite, kts,kte + integer ,intent (in ) :: itf,ktf, its,ite, kts,kte real(kind=kind_phys), intent (in ), dimension(its:ite,kts:kte) :: tn,po_cup real(kind=kind_phys), intent (inout), dimension(its:ite,kts:kte) :: p_liq_ice,melting_layer !$acc declare copyin(tn,po_cup) copy(p_liq_ice,melting_layer) diff --git a/physics/GWD/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 index 364c79409..323cea9a8 100644 --- a/physics/GWD/cires_tauamf_data.F90 +++ b/physics/GWD/cires_tauamf_data.F90 @@ -36,7 +36,7 @@ subroutine read_tau_amf(me, master, errmsg, errflg) if(iernc.ne.0) then write(errmsg,'(*(a))') "read_tau_amf: cannot open file_limb_tab data-file ", & trim(ugwp_taufile) - print *, 'cannot open ugwp-v1 tau-file=',trim(ugwp_taufile) + print *, 'cannot open ugwp-v1 tau-file=',trim(ugwp_taufile) errflg = 1 return else @@ -51,26 +51,26 @@ subroutine read_tau_amf(me, master, errmsg, errflg) status = nf90_inquire_dimension(ncid, DimID, len =ntau_d2t ) if (me == master) print *, ntau_d1y, ntau_d2t, ' dimd of tau_ngw ugwp-v1 ' - if (ntau_d2t .le. 0 .or. ntau_d1y .le. 0) then - print *, 'ugwp-v1 tau-file=', trim(ugwp_taufile) - print *, ' ugwp-v1: ', 'ntau_d2t=',ntau_d2t, 'ntau_d2t=',ntau_d1y - stop - endif + if (ntau_d2t .le. 0 .or. ntau_d1y .le. 0) then + print *, 'ugwp-v1 tau-file=', trim(ugwp_taufile) + print *, ' ugwp-v1: ', 'ntau_d2t=',ntau_d2t, 'ntau_d2t=',ntau_d1y + stop + endif if (.not.allocated(ugwp_taulat)) allocate (ugwp_taulat(ntau_d1y )) if (.not.allocated(days_limb)) allocate (days_limb(ntau_d2t)) - if (.not.allocated(tau_limb)) allocate (tau_limb(ntau_d1y, ntau_d2t )) + if (.not.allocated(tau_limb)) allocate (tau_limb(ntau_d1y, ntau_d2t )) - iernc=nf90_inq_varid( ncid, 'DAYS', vid ) + iernc=nf90_inq_varid( ncid, 'DAYS', vid ) iernc= nf90_get_var( ncid, vid, days_limb) - iernc=nf90_inq_varid( ncid, 'LATS', vid ) + iernc=nf90_inq_varid( ncid, 'LATS', vid ) iernc= nf90_get_var( ncid, vid, ugwp_taulat) - iernc=nf90_inq_varid( ncid, 'ABSMF', vid ) + iernc=nf90_inq_varid( ncid, 'ABSMF', vid ) iernc= nf90_get_var( ncid, vid, tau_limb) - iernc=nf90_close(ncid) + iernc=nf90_close(ncid) - endif + endif end subroutine read_tau_amf @@ -102,22 +102,22 @@ subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j j2_tau(j) = min(j2_tau(j),ntau_d1y) - j1_tau(j) = max(j2_tau(j)-1,1) + j1_tau(j) = max(j2_tau(j)-1,1) if (j1_tau(j) /= j2_tau(j) ) then w2_j2tau(j) = (dlat(j) - ugwp_taulat(j1_tau(j))) & - / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j))) + / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j))) else w2_j2tau(j) = 1.0 endif - w1_j1tau(j) = 1.0 - w2_j2tau(j) + w1_j1tau(j) = 1.0 - w2_j2tau(j) enddo return end subroutine cires_indx_ugwp !> subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, ddy_j2, tau_ddd) - use machine, only: kind_phys + use machine, only: kind_phys implicit none !input @@ -141,30 +141,30 @@ subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, d it1 = 2 do iday=1, ntau_d2t - if (fddd .lt. days_limb(iday) ) then - it2 = iday - exit - endif - enddo + if (fddd .lt. days_limb(iday) ) then + it2 = iday + exit + endif + enddo - it2 = min(it2,ntau_d2t) - it1 = max(it2-1,1) - if (it2 > ntau_d2t ) then - print *, ' Error in time-interpolation for tau_amf_interp ' - print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t - print *, ' Error in time-interpolation see cires_tauamf_data.F90 ' - stop - endif + it2 = min(it2,ntau_d2t) + it1 = max(it2-1,1) + if (it2 > ntau_d2t ) then + print *, ' Error in time-interpolation for tau_amf_interp ' + print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t + print *, ' Error in time-interpolation see cires_tauamf_data.F90 ' + stop + endif - w2 = (fddd-days_limb(it1))/(days_limb(it2)-days_limb(it1)) - w1 = 1.0-w2 + w2 = (fddd-days_limb(it1))/(days_limb(it2)-days_limb(it1)) + w1 = 1.0-w2 - do i=1, im - j1 = j1_tau(i) - j2 = j2_tau(i) - tx1 = tau_limb(j1, it1)*ddy_j1(i)+tau_limb(j2, it1)*ddy_j2(i) - tx2 = tau_limb(j1, it2)*ddy_j1(i)+tau_limb(j2, it2)*ddy_j2(i) - tau_ddd(i) = tx1*w1 + w2*tx2 + do i=1, im + j1 = j1_tau(i) + j2 = j2_tau(i) + tx1 = tau_limb(j1, it1)*ddy_j1(i)+tau_limb(j2, it1)*ddy_j2(i) + tx2 = tau_limb(j1, it2)*ddy_j1(i)+tau_limb(j2, it2)*ddy_j2(i) + tau_ddd(i) = tx1*w1 + w2*tx2 enddo end subroutine tau_amf_interp @@ -172,7 +172,7 @@ end subroutine tau_amf_interp !> subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) - use machine, only: kind_phys + use machine, only: kind_phys implicit none ! input integer, intent(in) :: idate(4) diff --git a/physics/GWD/ugwp_driver_v0.F b/physics/GWD/ugwp_driver_v0.F index 1bbb2770d..417e6042d 100644 --- a/physics/GWD/ugwp_driver_v0.F +++ b/physics/GWD/ugwp_driver_v0.F @@ -815,7 +815,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, IF( do_tofd ) then axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 - + DO I = 1,npt J = ipt(i) zpbl =rgrav*phil( j, kpbl(j) ) diff --git a/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 index 7971ddc35..78f400c58 100644 --- a/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 +++ b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 @@ -2628,7 +2628,7 @@ SUBROUTINE mym_turbulence ( & & sh, sm, & & El, & & Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & - & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D, & + & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D, & & tke_budget, & & Psig_bl,Psig_shcu,cldfra_bl1D, & & bl_mynn_mixlength, & diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.f90 b/physics/SFC_Models/Lake/CLM/clm_lake.f90 index 59cec6222..028f7444a 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.f90 +++ b/physics/SFC_Models/Lake/CLM/clm_lake.f90 @@ -607,7 +607,7 @@ SUBROUTINE clm_lake_run( & enddo do k = -nlevsnow+1,nlevsoil t_soisno(c,k) = t_soisno3d(i,k) - h2osoi_ice(c,k) = h2osoi_ice3d(i,k) + h2osoi_ice(c,k) = h2osoi_ice3d(i,k) h2osoi_liq(c,k) = h2osoi_liq3d(i,k) h2osoi_vol(c,k) = h2osoi_vol3d(i,k) z(c,k) = z3d(i,k) @@ -678,20 +678,20 @@ SUBROUTINE clm_lake_run( & savedtke12d(i) = savedtke1(c) snowdp2d(i) = snowdp(c) h2osno2d(i) = h2osno(c) - snl2d(i) = snl(c) + snl2d(i) = snl(c) t_grnd2d(i) = t_grnd(c) do k = 1,nlevlake t_lake3d(i,k) = t_lake(c,k) - lake_icefrac3d(i,k) = lake_icefrac(c,k) + lake_icefrac3d(i,k) = lake_icefrac(c,k) enddo - do k = -nlevsnow+1,nlevsoil - z3d(i,k) = z(c,k) - dz3d(i,k) = dz(c,k) - t_soisno3d(i,k) = t_soisno(c,k) - h2osoi_liq3d(i,k) = h2osoi_liq(c,k) - h2osoi_ice3d(i,k) = h2osoi_ice(c,k) + do k = -nlevsnow+1,nlevsoil + z3d(i,k) = z(c,k) + dz3d(i,k) = dz(c,k) + t_soisno3d(i,k) = t_soisno(c,k) + h2osoi_liq3d(i,k) = h2osoi_liq(c,k) + h2osoi_ice3d(i,k) = h2osoi_ice(c,k) h2osoi_vol3d(i,k) = h2osoi_vol(c,k) - enddo + enddo do k = -nlevsnow+0,nlevsoil zi3d(i,k) = zi(c,k) enddo diff --git a/physics/SFC_Models/Land/Noah/set_soilveg.f b/physics/SFC_Models/Land/Noah/set_soilveg.f index 35f4ace37..8f9c4e782 100644 --- a/physics/SFC_Models/Land/Noah/set_soilveg.f +++ b/physics/SFC_Models/Land/Noah/set_soilveg.f @@ -52,35 +52,35 @@ subroutine set_soilveg(me,isot,ivet,nlunit,errmsg,errflg) !using umd veg table slope_data =(/0.1, 0.6, 1.0, 0.35, 0.55, 0.8, - & 0.63, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0/) + & 0.63, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0/) rsmtbl =(/300.0, 175.0, 175.0, 300.0, 300.0, 70.0, - & 20.0, 225.0, 225.0, 225.0, 400.0, 20.0, - & 150.0, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) + & 20.0, 225.0, 225.0, 225.0, 400.0, 20.0, + & 150.0, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) c----------------------------- rgltbl =(/30.0, 30.0, 30.0, 30.0, 30.0, 65.0, - & 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, - & 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) + & 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, + & 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) hstbl =(/41.69, 54.53, 51.93, 47.35, 47.35, 54.53, - & 36.35, 42.00, 42.00, 42.00, 42.00, 36.35, - & 42.00, 0.00, 0.00, 0.00, 0.00, 0.00, - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/) + & 36.35, 42.00, 42.00, 42.00, 42.00, 36.35, + & 42.00, 0.00, 0.00, 0.00, 0.00, 0.00, + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/) ! changed for version 2.6 on june 2nd 2003 ! data snupx /0.080, 0.080, 0.080, 0.080, 0.080, 0.080, ! & 0.040, 0.040, 0.040, 0.040, 0.025, 0.040, ! & 0.025, 0.000, 0.000, 0.000, 0.000, 0.000, snupx =(/0.040, 0.040, 0.040, 0.040, 0.040, 0.040, - * 0.020, 0.020, 0.020, 0.020, 0.013, 0.020, - * 0.013, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) + * 0.020, 0.020, 0.020, 0.020, 0.013, 0.020, + * 0.013, 0.000, 0.000, 0.000, 0.000, 0.000, + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) bare =11 diff --git a/physics/SFC_Models/Land/Noah/sflx.f b/physics/SFC_Models/Land/Noah/sflx.f index 5f0c6c747..c6822c0eb 100644 --- a/physics/SFC_Models/Land/Noah/sflx.f +++ b/physics/SFC_Models/Land/Noah/sflx.f @@ -2662,7 +2662,7 @@ subroutine snopac ! t1 = tfreez * sncovr**snoexp + t12 * (1.0 - sncovr**snoexp) t1 = tfreez * max(0.01,sncovr**snoexp) + & - & t12 * (1.0 - max(0.01,sncovr**snoexp)) + & t12 * (1.0 - max(0.01,sncovr**snoexp)) beta = 1.0 ssoil = df1 * (t1 - stc(1)) / dtot diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 index bcb157c54..63df49d7c 100644 --- a/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 @@ -326,7 +326,7 @@ subroutine noahmp_glacier (& isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout dzsnso ,sh2o ,sice ,ponding ,zsnso ,fsh , & !inout runsrf ,runsub ,qsnow ,ponding1 ,ponding2 ,qsnbot , & !out - fpice ,esnow) !out + fpice ,esnow) !out if(opt_gla == 2) then edir = qvap - qdew @@ -638,7 +638,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair call tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in ssoil ,snowh ,zbot ,zsnso ,df , & !in - hcpct , & !in + hcpct , & !in stc ) !inout ! adjusting snow surface temperature @@ -1338,11 +1338,11 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso end if csh = rhoair*cpair/rahb - if(snowh > 0.0 .or. opt_gla == 1) then + if(snowh > 0.0 .or. opt_gla == 1) then cev = rhoair*cpair/gamma/(rsurf+rawb) - else - cev = 0.0 ! don't allow any sublimation of glacier in opt_gla=2 - end if + else + cev = 0.0 ! don't allow any sublimation of glacier in opt_gla=2 + end if ! surface fluxes and dtg @@ -1728,7 +1728,7 @@ end subroutine sfcdif1_glacier !>\ingroup NoahMP_LSM subroutine tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in ssoil ,snowh ,zbot ,zsnso ,df , & !in - hcpct , & !in + hcpct , & !in stc ) !inout ! -------------------------------------------------------------------------------------------------- !> compute snow (up to 3l) and soil (4l) temperature. note that snow temperatures @@ -2220,11 +2220,11 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (heatr(1) > 0.) then xm(1) = heatr(1)*dt/hfus hm(1) = heatr(1) - imelt(1) = 1 + imelt(1) = 1 else xm(1) = 0. hm(1) = 0. - imelt(1) = 0 + imelt(1) = 0 endif qmelt = max(0.,(temp1-sneqv))/dt xmf = hfus*qmelt @@ -2271,21 +2271,21 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (any(stc(1:4) > tfrz) .and. any(stc(1:4) < tfrz)) then do j = 1,nsoil if ( stc(j) > tfrz ) then - heatr(j) = (stc(j)-tfrz)/fact(j) + heatr(j) = (stc(j)-tfrz)/fact(j) do k = 1,nsoil - if (j .ne. k .and. stc(k) < tfrz .and. heatr(j) > 0.1) then - heatr(k) = (stc(k)-tfrz)/fact(k) - if (abs(heatr(k)) > heatr(j)) then ! layer absorbs all - heatr(k) = heatr(k) + heatr(j) - stc(k) = tfrz + heatr(k)*fact(k) - heatr(j) = 0.0 + if (j .ne. k .and. stc(k) < tfrz .and. heatr(j) > 0.1) then + heatr(k) = (stc(k)-tfrz)/fact(k) + if (abs(heatr(k)) > heatr(j)) then ! layer absorbs all + heatr(k) = heatr(k) + heatr(j) + stc(k) = tfrz + heatr(k)*fact(k) + heatr(j) = 0.0 else - heatr(j) = heatr(j) + heatr(k) - heatr(k) = 0.0 - stc(k) = tfrz + heatr(j) = heatr(j) + heatr(k) + heatr(k) = 0.0 + stc(k) = tfrz end if - end if - end do + end if + end do stc(j) = tfrz + heatr(j)*fact(j) end if end do @@ -2296,21 +2296,21 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (any(stc(1:4) > tfrz) .and. any(stc(1:4) < tfrz)) then do j = 1,nsoil if ( stc(j) < tfrz ) then - heatr(j) = (stc(j)-tfrz)/fact(j) + heatr(j) = (stc(j)-tfrz)/fact(j) do k = 1,nsoil - if (j .ne. k .and. stc(k) > tfrz .and. heatr(j) < -0.1) then - heatr(k) = (stc(k)-tfrz)/fact(k) - if (heatr(k) > abs(heatr(j))) then ! layer absorbs all - heatr(k) = heatr(k) + heatr(j) - stc(k) = tfrz + heatr(k)*fact(k) - heatr(j) = 0.0 + if (j .ne. k .and. stc(k) > tfrz .and. heatr(j) < -0.1) then + heatr(k) = (stc(k)-tfrz)/fact(k) + if (heatr(k) > abs(heatr(j))) then ! layer absorbs all + heatr(k) = heatr(k) + heatr(j) + stc(k) = tfrz + heatr(k)*fact(k) + heatr(j) = 0.0 else - heatr(j) = heatr(j) + heatr(k) - heatr(k) = 0.0 - stc(k) = tfrz + heatr(j) = heatr(j) + heatr(k) + heatr(k) = 0.0 + stc(k) = tfrz end if - end if - end do + end if + end do stc(j) = tfrz + heatr(j)*fact(j) end if end do @@ -2321,25 +2321,25 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (any(stc(1:4) > tfrz) .and. any(mice(1:4) > 0.)) then do j = 1,nsoil if ( stc(j) > tfrz ) then - heatr(j) = (stc(j)-tfrz)/fact(j) + heatr(j) = (stc(j)-tfrz)/fact(j) xm(j) = heatr(j)*dt/hfus do k = 1,nsoil - if (j .ne. k .and. mice(k) > 0. .and. xm(j) > 0.1) then - if (mice(k) > xm(j)) then ! layer absorbs all - mice(k) = mice(k) - xm(j) - xmf = xmf + hfus * xm(j)/dt - stc(k) = tfrz - xm(j) = 0.0 + if (j .ne. k .and. mice(k) > 0. .and. xm(j) > 0.1) then + if (mice(k) > xm(j)) then ! layer absorbs all + mice(k) = mice(k) - xm(j) + xmf = xmf + hfus * xm(j)/dt + stc(k) = tfrz + xm(j) = 0.0 else - xm(j) = xm(j) - mice(k) - xmf = xmf + hfus * mice(k)/dt - mice(k) = 0.0 - stc(k) = tfrz + xm(j) = xm(j) - mice(k) + xmf = xmf + hfus * mice(k)/dt + mice(k) = 0.0 + stc(k) = tfrz end if mliq(k) = max(0.,wmass0(k)-mice(k)) - end if - end do - heatr(j) = xm(j)*hfus/dt + end if + end do + heatr(j) = xm(j)*hfus/dt stc(j) = tfrz + heatr(j)*fact(j) end if end do @@ -2350,25 +2350,25 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (any(stc(1:4) < tfrz) .and. any(mliq(1:4) > 0.)) then do j = 1,nsoil if ( stc(j) < tfrz ) then - heatr(j) = (stc(j)-tfrz)/fact(j) + heatr(j) = (stc(j)-tfrz)/fact(j) xm(j) = heatr(j)*dt/hfus do k = 1,nsoil - if (j .ne. k .and. mliq(k) > 0. .and. xm(j) < -0.1) then - if (mliq(k) > abs(xm(j))) then ! layer absorbs all - mice(k) = mice(k) - xm(j) - xmf = xmf + hfus * xm(j)/dt - stc(k) = tfrz - xm(j) = 0.0 + if (j .ne. k .and. mliq(k) > 0. .and. xm(j) < -0.1) then + if (mliq(k) > abs(xm(j))) then ! layer absorbs all + mice(k) = mice(k) - xm(j) + xmf = xmf + hfus * xm(j)/dt + stc(k) = tfrz + xm(j) = 0.0 else - xm(j) = xm(j) + mliq(k) - xmf = xmf - hfus * mliq(k)/dt - mice(k) = wmass0(k) - stc(k) = tfrz + xm(j) = xm(j) + mliq(k) + xmf = xmf - hfus * mliq(k)/dt + mice(k) = wmass0(k) + stc(k) = tfrz end if mliq(k) = max(0.,wmass0(k)-mice(k)) - end if - end do - heatr(j) = xm(j)*hfus/dt + end if + end do + heatr(j) = xm(j)*hfus/dt stc(j) = tfrz + heatr(j)*fact(j) end if end do @@ -2400,7 +2400,7 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout dzsnso ,sh2o ,sice ,ponding ,zsnso ,fsh , & !inout runsrf ,runsub ,qsnow ,ponding1 ,ponding2 ,qsnbot , & !out - fpice ,esnow) !out + fpice ,esnow) !out ! ---------------------------------------------------------------------- ! code history: ! initial code: guo-yue niu, oct. 2007 @@ -2571,7 +2571,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in ficeold ,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq , & !inout sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout - fsh , & !inout + fsh , & !inout qsnbot ,snoflow ,ponding1 ,ponding2) !out ! ---------------------------------------------------------------------- implicit none @@ -2651,7 +2651,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in qrain , & !in isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout snliq ,sh2o ,sice ,stc , & !inout - ponding1 ,ponding2 ,fsh , & !inout + ponding1 ,ponding2 ,fsh , & !inout qsnbot ) !out !to obtain equilibrium state of snow in glacier region diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 index a76a354e6..eff02e535 100644 --- a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 @@ -424,7 +424,7 @@ subroutine noahmp_sflx (parameters, & sfctmp , sfcprs , psfc , uu , vv , q2, garea1 , & ! in : forcing qc , soldn , lwdn,thsfc_loc, prslkix,prsik1x,prslk1x,& ! in : forcing pblhx , iz0tlnd , itime ,psi_opt ,& - prcpconv, prcpnonc, prcpshcv, prcpsnow, prcpgrpl, prcphail, & ! in : forcing + prcpconv, prcpnonc, prcpshcv, prcpsnow, prcpgrpl, prcphail, & ! in : forcing tbot , co2air , o2air , foln , ficeold , zlvl , & ! in : forcing ep_1 , ep_2 , epsm1 , cp , & ! in : constants albold , sneqvo , & ! in/out : @@ -436,7 +436,7 @@ subroutine noahmp_sflx (parameters, & cm , ch , tauss , & ! in/out : grain , gdd , pgs , & ! in/out smcwtd ,deeprech , rech , ustarx , & ! in/out : - z0wrf , z0hwrf , ts , & ! out : + z0wrf , z0hwrf , ts , & ! out : fsa , fsr , fira , fsh , ssoil , fcev , & ! out : fgev , fctr , ecan , etran , edir , trad , & ! out : tgb , tgv , t2mv , t2mb , q2v , q2b , & ! out : @@ -445,9 +445,9 @@ subroutine noahmp_sflx (parameters, & qsnbot , ponding , ponding1, ponding2, rssun , rssha , & ! out : albd , albi , albsnd , albsni , & ! out : bgap , wgap , chv , chb , emissi , & ! out : - shg , shc , shb , evg , evb , ghv , & ! out : - ghb , irg , irc , irb , tr , evc , & ! out : - chleaf , chuc , chv2 , chb2 , fpice , pahv , & + shg , shc , shb , evg , evb , ghv , & ! out : + ghb , irg , irc , irb , tr , evc , & ! out : + chleaf , chuc , chv2 , chb2 , fpice , pahv , & pahg , pahb , pah , esnow , canhs , laisun , & laisha , rb , qsfcveg , qsfcbare & #ifdef CCPP @@ -819,7 +819,7 @@ subroutine noahmp_sflx (parameters, & canliq ,canice ,tv ,sfctmp ,tg , & !in qintr ,qdripr ,qthror ,qints ,qdrips ,qthros , & !out pahv ,pahg ,pahb ,qrain ,qsnow ,snowhin, & !out - fwet ,cmc ) !out + fwet ,cmc ) !out ! compute energy budget (momentum & energy fluxes and phase changes) @@ -833,7 +833,7 @@ subroutine noahmp_sflx (parameters, & qsnow ,dzsnso ,lat ,canliq ,canice ,iloc, jloc , & !in thsfc_loc, prslkix,prsik1x,prslk1x,garea1, & !in pblhx ,iz0tlnd, itime ,psi_opt, ep_1, ep_2, epsm1,cp, & - z0wrf ,z0hwrf , & !out + z0wrf ,z0hwrf , & !out imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out @@ -854,7 +854,7 @@ subroutine noahmp_sflx (parameters, & fsrg ,rssun ,rssha ,albd ,albi ,albsnd,albsni, bgap ,wgap, tgv,tgb,& q1 ,q2v ,q2b ,q2e ,chv ,chb , & !out emissi ,pah ,canhs, & - shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out + shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out qsfcveg = eah*ep_2/(sfcprs + epsm1*eah) qsfcbare = qsfc @@ -877,7 +877,7 @@ subroutine noahmp_sflx (parameters, & esai ,sfctmp ,qvap ,qdew ,zsoil ,btrani , & !in ficeold,ponding,tg ,ist ,fveg ,iloc,jloc , smceq , & !in bdfall ,fp ,rain ,snow , & !in mb/an: v3.7 - qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb + qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb isnow ,canliq ,canice ,tv ,snowh ,sneqv , & !inout snice ,snliq ,stc ,zsnso ,sh2o ,smc , & !inout sice ,zwt ,wa ,wt ,dzsnso ,wslake , & !inout @@ -911,9 +911,9 @@ subroutine noahmp_sflx (parameters, & if (opt_crop == 1 .and. crop_active) then call carbon_crop (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil ,julian , & !in dzsnso ,stc ,smc ,tv ,psn ,foln ,btran , & !in - soldn ,t2m , & !in + soldn ,t2m , & !in lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp ,grain , & !inout - lai ,sai ,gdd , & !inout + lai ,sai ,gdd , & !inout gpp ,npp ,nee ,autors ,heters ,totsc ,totlb, pgs ) !out end if @@ -964,7 +964,7 @@ subroutine atm (parameters,ep_2,epsm1,sfcprs ,sfctmp ,q2 , & prcpconv,prcpnonc ,prcpshcv,prcpsnow,prcpgrpl,prcphail , & soldn ,cosz ,thair ,qair , & eair ,rhoair ,qprecc ,qprecl ,solad , solai , & - swdown ,bdfall ,rain ,snow ,fp , fpice ,prcp ) + swdown ,bdfall ,rain ,snow ,fp , fpice ,prcp ) ! -------------------------------------------------------------------------------------------------- ! re-process atmospheric forcing ! ---------------------------------------------------------------------- @@ -1037,7 +1037,7 @@ subroutine atm (parameters,ep_2,epsm1,sfcprs ,sfctmp ,q2 , & if(opt_snf == 4) then qprecc = prcpconv + prcpshcv - qprecl = prcpnonc + qprecl = prcpnonc else qprecc = 0.10 * prcp ! should be from the atmospheric model qprecl = 0.90 * prcp ! should be from the atmospheric model @@ -1090,13 +1090,13 @@ subroutine atm (parameters,ep_2,epsm1,sfcprs ,sfctmp ,q2 , & if(opt_snf == 4 .or. opt_snf == 5) then prcp_frozen = prcpsnow + prcpgrpl + prcphail if(prcpnonc > 0. .and. prcp_frozen > 0.) then - fpice = min(1.0,prcp_frozen/prcpnonc) - fpice = max(0.0,fpice) + fpice = min(1.0,prcp_frozen/prcpnonc) + fpice = max(0.0,fpice) if(opt_snf==4) bdfall = bdfall*(prcpsnow/prcp_frozen) + rho_grpl*(prcpgrpl/prcp_frozen) + & rho_hail*(prcphail/prcp_frozen) if(opt_snf==5) bdfall = parameters%prcpiceden - else - fpice = 0.0 + else + fpice = 0.0 endif endif @@ -1233,8 +1233,8 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv bdfall ,rain ,snow ,fp , & !in canliq ,canice ,tv ,sfctmp ,tg , & !in qintr ,qdripr ,qthror ,qints ,qdrips ,qthros , & !out - pahv ,pahg ,pahb ,qrain ,qsnow ,snowhin, & !out - fwet ,cmc ) !out + pahv ,pahg ,pahb ,qrain ,qsnow ,snowhin, & !out + fwet ,cmc ) !out ! ------------------------ code history ------------------------------ ! michael barlage: oct 2013 - split canwater to calculate precip movement for @@ -1336,10 +1336,10 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv qintr = 0. qdripr = 0. qthror = rain - if(canliq > 0.) then ! for case of canopy getting buried - qdripr = qdripr + canliq/dt - canliq = 0.0 - end if + if(canliq > 0.) then ! for case of canopy getting buried + qdripr = qdripr + canliq/dt + canliq = 0.0 + end if end if ! heat transported by liquid water @@ -1363,7 +1363,7 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv ft = max(0.0,(tv - 270.15) / 1.87e5) fv = sqrt(uu*uu + vv*vv) / 1.56e5 ! mb: changed below to reflect the rain assumption that all precip gets intercepted - icedrip = max(0.,canice) * (fv+ft) !mb: removed /dt + icedrip = max(0.,canice) * (fv+ft) !mb: removed /dt qdrips = (fveg * snow - qints) + icedrip qthros = (1.0-fveg) * snow canice= max(0.,canice + (qints - icedrip)*dt) @@ -1371,10 +1371,10 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv qints = 0. qdrips = 0. qthros = snow - if(canice > 0.) then ! for case of canopy getting buried - qdrips = qdrips + canice/dt - canice = 0.0 - end if + if(canice > 0.) then ! for case of canopy getting buried + qdrips = qdrips + canice/dt + canice = 0.0 + end if endif ! print*, "precip_heat canopy through:",3600.0*(fveg * snow - qints) ! print*, "precip_heat canopy drip:",3600.0*max(0.,canice) * (fv+ft) @@ -1404,13 +1404,13 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv if (fveg > 0.0 .and. fveg < 1.0) then pahg = pahg / fveg ! these will be multiplied by fraction later - pahb = pahb / (1.0-fveg) + pahb = pahb / (1.0-fveg) elseif (fveg <= 0.0) then pahb = pahg + pahb ! for case of canopy getting buried pahg = 0.0 - pahv = 0.0 + pahv = 0.0 elseif (fveg >= 1.0) then - pahb = 0.0 + pahb = 0.0 end if pahv = max(pahv,-20.0) ! put some artificial limits here for stability @@ -1677,7 +1677,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in qsnow ,dzsnso ,lat ,canliq ,canice ,iloc , jloc, & !in thsfc_loc, prslkix,prsik1x,prslk1x,garea1, & !in pblhx , iz0tlnd, itime,psi_opt,ep_1, ep_2, epsm1, cp, & - z0wrf ,z0hwrf , & !out + z0wrf ,z0hwrf , & !out imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out @@ -1697,7 +1697,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in t2mv ,t2mb ,fsrv , & fsrg ,rssun ,rssha ,albd ,albi,albsnd ,albsni,bgap ,wgap,tgv,tgb,& q1 ,q2v ,q2b ,q2e ,chv ,chb, emissi,pah,canhs,& - shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out + shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out !jref:end ! -------------------------------------------------------------------------------------------------- @@ -2211,19 +2211,19 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in if (tv .gt. tfrz) then ! barlage: add distinction between ground and latheav = hvap ! vegetation in v3.6 - frozen_canopy = .false. + frozen_canopy = .false. else latheav = hsub - frozen_canopy = .true. + frozen_canopy = .true. end if gammav = cpair*sfcprs/(ep_2*latheav) if (tg .gt. tfrz) then latheag = hvap - frozen_ground = .false. + frozen_ground = .false. else latheag = hsub - frozen_ground = .true. + frozen_ground = .true. end if gammag = cpair*sfcprs/(ep_2*latheag) @@ -2334,7 +2334,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in ssoil = fveg * ghv + (1.0 - fveg) * ghb fcev = evc fctr = tr - pah = fveg * pahg + (1.0 - fveg) * pahb + pahv + pah = fveg * pahg + (1.0 - fveg) * pahb + pahv tg = fveg * tgv + (1.0 - fveg) * tgb t2m = fveg * t2mv + (1.0 - fveg) * t2mb ts = fveg * tah + (1.0 - fveg) * tgb @@ -2364,7 +2364,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in t2m = t2mb fcev = 0. fctr = 0. - pah = pahb + pah = pahb ts = tg cm = cmb ch = chb @@ -3535,7 +3535,7 @@ subroutine twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & ! kopen = 1.0 else if(opt_rad == 1) then - denfveg = -log(max(1.0-fveg,0.01))/(pai*parameters%rc**2) + denfveg = -log(max(1.0-fveg,0.01))/(pai*parameters%rc**2) hd = parameters%hvt - parameters%hvb bb = 0.5 * hd thetap = atan(bb/parameters%rc * tan(acos(max(0.01,cosz))) ) @@ -4247,11 +4247,11 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & shc = fveg*rhoair*cpair*cvh * ( tv-tah) evc = fveg*rhoair*cpair*cew * (estv-eah) / gammav ! barlage: change to v in v3.6 tr = fveg*rhoair*cpair*ctw * (estv-eah) / gammav - if (tv > tfrz) then + if (tv > tfrz) then evc = min(canliq*latheav/dt,evc) ! barlage: add if block for canice in v3.6 - else + else evc = min(canice*latheav/dt,evc) - end if + end if ! canopy heat capacity hcv = fveg*(parameters%cbiom*vaie*cwat + canliq*cwat/denh2o + canice*cice/denice) !j/m2/k @@ -7018,7 +7018,7 @@ subroutine water (parameters,vegtyp ,nsnow ,nsoil ,imelt ,dt ,uu , & esai ,sfctmp ,qvap ,qdew ,zsoil ,btrani , & !in ficeold,ponding,tg ,ist ,fveg ,iloc ,jloc ,smceq , & !in bdfall ,fp ,rain ,snow, & !in mb/an: v3.7 - qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb + qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb isnow ,canliq ,canice ,tv ,snowh ,sneqv , & !inout snice ,snliq ,stc ,zsnso ,sh2o ,smc , & !inout sice ,zwt ,wa ,wt ,dzsnso ,wslake , & !inout @@ -7647,19 +7647,19 @@ subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in snice(j-1) = snice(j-1) + snice(j) dzsnso(j-1) = dzsnso(j-1) + dzsnso(j) else - if(snice(j) >= 0.) then + if(snice(j) >= 0.) then ponding1 = snliq(j) ! isnow will get set to zero below; ponding1 will get sneqv = snice(j) ! added to ponding from phasechange ponding should be snowh = dzsnso(j) ! zero here because it was calculated for thin snow - else ! snice over-sublimated earlier - ponding1 = snliq(j) + snice(j) - if(ponding1 < 0.) then ! if snice and snliq sublimates remove from soil - sice(1) = max(0.0,sice(1)+ponding1/(dzsnso(1)*1000.)) + else ! snice over-sublimated earlier + ponding1 = snliq(j) + snice(j) + if(ponding1 < 0.) then ! if snice and snliq sublimates remove from soil + sice(1) = max(0.0,sice(1)+ponding1/(dzsnso(1)*1000.)) ponding1 = 0.0 - end if + end if sneqv = 0.0 snowh = 0.0 - end if + end if snliq(j) = 0.0 snice(j) = 0.0 dzsnso(j) = 0.0 @@ -9748,7 +9748,7 @@ subroutine carbon_crop (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil ,julia dzsnso ,stc ,smc ,tv ,psn ,foln ,btran , & !in soldn ,t2m , & !in lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp ,grain , & !inout - xlai ,xsai ,gdd , & !inout + xlai ,xsai ,gdd , & !inout gpp ,npp ,nee ,autors ,heters ,totsc ,totlb, pgs ) !out ! ------------------------------------------------------------------------------------------ ! initial crop version created by xing liu @@ -10427,7 +10427,7 @@ end subroutine psn_crop !! subroutine noahmp_options(idveg , iopt_crs , iopt_btr , iopt_run , iopt_sfc , iopt_frz , & iopt_inf, iopt_rad , iopt_alb , iopt_snf , iopt_tbot, iopt_stc , & - iopt_rsf, iopt_soil, iopt_pedo, iopt_crop, iopt_trs , iopt_diag, & + iopt_rsf, iopt_soil, iopt_pedo, iopt_crop, iopt_trs , iopt_diag, & iopt_z0m ) implicit none diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 1313e9ff3..b82a386e4 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -859,7 +859,7 @@ subroutine noahmpdrv_run & call noahmp_options(idveg ,iopt_crs, iopt_btr , iopt_run, iopt_sfc, & iopt_frz, iopt_inf , iopt_rad, iopt_alb, & iopt_snf, iopt_tbot, iopt_stc, iopt_rsf, & - iopt_soil,iopt_pedo, iopt_crop,iopt_trs, & + iopt_soil,iopt_pedo, iopt_crop,iopt_trs, & iopt_diag,iopt_z0m) if ( vegetation_category == isice_table ) then @@ -884,7 +884,7 @@ subroutine noahmpdrv_run & temperature_soil_bot ,forcing_height ,snow_ice_frac_old ,zsoil , & thsfc_loc ,prslkix ,prsik1x ,prslk1x , & air_pressure_surface ,pblhx ,iz0tlnd ,itime , & - vegetation_frac ,area_grid ,psi_opt , & + vegetation_frac ,area_grid ,psi_opt , & con_fvirt ,con_eps ,con_epsm1 ,con_cp , & snowfall ,snow_water_equiv_old ,snow_albedo_old , & cm_noahmp ,ch_noahmp ,snow_levels ,snow_water_equiv , & @@ -1366,7 +1366,7 @@ subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & parameters%den = den_table(vegtype) !tree density (no. of trunks per m2) parameters%rc = rc_table(vegtype) !tree crown radius (m) parameters%mfsno = mfsno_table(vegtype) !snowmelt m parameter () - parameters%scffac = scffac_table(vegtype) !snow cover factor + parameters%scffac = scffac_table(vegtype) !snow cover factor parameters%cbiom = cbiom_table(vegtype) !canopy biomass heat capacity parameter (m) parameters%saim = saim_table(vegtype,:) !monthly stem area index, one-sided parameters%laim = laim_table(vegtype,:) !monthly leaf area index, one-sided diff --git a/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 index 012c81323..8e2f3f54a 100644 --- a/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 +++ b/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 @@ -45,36 +45,36 @@ subroutine set_soilveg_ruc(me,isot,ivet,nlunit,errmsg,errflg) if(ivet.eq.2) then ! Using umd veg classification slope_data =(/0.1, 0.6, 1.0, 0.35, 0.55, 0.8, & - & 0.63, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0/) + & 0.63, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0/) ! ---------------------------------------------------------------------- ! vegetation class-related arrays ! ---------------------------------------------------------------------- rstbl =(/300.0, 175.0, 175.0, 300.0, 300.0, 70.0, & - & 20.0, 225.0, 225.0, 225.0, 400.0, 20.0, & - & 150.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) + & 20.0, 225.0, 225.0, 225.0, 400.0, 20.0, & + & 150.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) rgltbl =(/30.0, 30.0, 30.0, 30.0, 30.0, 65.0, & - & 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, & - & 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) + & 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, & + & 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) hstbl =(/41.69, 54.53, 51.93, 47.35, 47.35, 54.53, & - & 36.35, 42.00, 42.00, 42.00, 42.00, 36.35, & - & 42.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/) + & 36.35, 42.00, 42.00, 42.00, 42.00, 36.35, & + & 42.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/) snuptbl =(/0.040, 0.040, 0.040, 0.040, 0.040, 0.040, & & 0.020, 0.020, 0.020, 0.020, 0.013, 0.020, & & 0.013, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) bare =11 From dde436461abdd6c48bc39c3942ea9e3a55d25f6c Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Sun, 14 Jan 2024 11:53:26 -0700 Subject: [PATCH 3/6] Fixed GNU 'Warning: Line truncated at (1) [-Wline-truncation]' warnings --- physics/SFC_Models/SeaIce/CICE/sfc_sice.f | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_sice.f b/physics/SFC_Models/SeaIce/CICE/sfc_sice.f index a5904d67c..e5f2deae9 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_sice.f +++ b/physics/SFC_Models/SeaIce/CICE/sfc_sice.f @@ -137,7 +137,8 @@ subroutine sfc_sice_run & ! ! - Define constant parameters integer, parameter :: kmi = 2 !< 2-layer of ice - real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys real(kind=kind_phys), parameter :: himax = 8.0_kind_phys !< maximum ice thickness allowed real(kind=kind_phys), parameter :: himin = 0.1_kind_phys !< minimum ice thickness required real(kind=kind_phys), parameter :: hsmax = 2.0_kind_phys !< maximum snow depth allowed @@ -541,8 +542,8 @@ subroutine ice3lay real (kind=kind_phys), parameter :: dili = di*li real (kind=kind_phys), parameter :: dsli = ds*li real (kind=kind_phys), parameter :: ki4 = ki*4.0_kind_phys - real (kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys - + real (kind=kind_phys), parameter :: zero = 0.0_kind_phys + real (kind=kind_phys), parameter :: one = 1.0_kind_phys ! --- inputs: integer, intent(in) :: im, kmi, ipr logical :: lprnt From 143a6e584f03d1f42df10aae135f931beac2911e Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Sat, 13 Jan 2024 18:15:43 -0700 Subject: [PATCH 4/6] Fix 'Warning: CHARACTER expression will be truncated in assignment' --- physics/MP/GFDL/module_gfdl_cloud_microphys.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 b/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 index 72f3211b5..09e3c4b31 100644 --- a/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 +++ b/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 @@ -57,7 +57,7 @@ module gfdl_cloud_microphys_mod logical :: module_is_initialized = .false. logical :: qsmith_tables_initialized = .false. - character (len = 17) :: mod_name = 'gfdl_cloud_microphys' + character (len = 20) :: mod_name = 'gfdl_cloud_microphys' real, parameter :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 real, parameter :: rhos = 0.1e3, rhog = 0.4e3 From 6abaa2d82a4598e6b4293c7b15048721ee981ac5 Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Wed, 17 Jan 2024 16:47:40 -0700 Subject: [PATCH 5/6] Fix GNU warning "Warning: Return value err_message of function declared at (1) not set [-Wreturn-type]" --- .../UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 index 45d3dd4e0..56d1d0666 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 @@ -121,7 +121,7 @@ function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err this%tend1d%q = this%tend2d%q(:,1) endif end select - + err_message = "" end function linterp_1D !> Type-bound procedure to compute tendency profile for time-of-day. @@ -153,6 +153,7 @@ function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) case("q") this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) end select + err_message = "" end function linterp_2D !> Type-bound procedure to find nearest location. From add0661f60199fd50211c97273fa15b7de8af0f2 Mon Sep 17 00:00:00 2001 From: Soren Rasmussen Date: Thu, 9 May 2024 13:11:44 -0600 Subject: [PATCH 6/6] After rebase switching tab to spaces --- physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 index 59837037c..bcf415835 100644 --- a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 +++ b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 @@ -1520,7 +1520,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia GSW,GSWnew,GLW,SOILT,EMISS,ALB,ALBice,SNWE ENDIF - if(snhei.gt.0.0081_kind_phys*rhowater/rhosn) then + if(snhei.gt.0.0081_kind_phys*rhowater/rhosn) then !*** Update snow density for current temperature (Koren et al 1999,doi:10.1029/1999JD900232.) BSN=delt/3600._kind_phys*c1sn*exp(0.08_kind_phys*min(zero,tsnav)-c2sn*rhosn*1.e-3_kind_phys) if(bsn*snwe*100._kind_phys.lt.1.e-4_kind_phys) goto 777