Skip to content

Commit

Permalink
Merge pull request #107 from noaa-oar-arl/array_temp
Browse files Browse the repository at this point in the history
Fixed array temporary warnings by explicitly creating the arrays.
  • Loading branch information
drnimbusrain authored Feb 2, 2024
2 parents 2d65723 + 2d5f5d7 commit 516da0d
Show file tree
Hide file tree
Showing 5 changed files with 81 additions and 35 deletions.
2 changes: 2 additions & 0 deletions src/canopy_alloc.F90
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,8 @@ SUBROUTINE canopy_alloc
if(.not.allocated(variables_3d)) allocate(variables_3d(nlon,nlat,var3d_set))
if(.not.allocated(variables_1d)) allocate(variables_1d(var3d_set))
if(.not.allocated(variables_can)) allocate(variables_can(nlat*nlon))
if(.not.allocated(pavdref)) allocate(pavdref(var3d_set))
if(.not.allocated(levref)) allocate(levref(var3d_set))
if(.not.allocated(pavd_arr)) allocate(pavd_arr(var3d_set))
if(.not.allocated(lev_arr)) allocate(lev_arr(var3d_set))
end if
Expand Down
19 changes: 13 additions & 6 deletions src/canopy_calcs.F90
Original file line number Diff line number Diff line change
Expand Up @@ -35,18 +35,23 @@ SUBROUTINE canopy_calcs(nn)
REAL(rk), save :: currentlai ! Current LAI [cm2/cm2] (saved from one timestep to the next)
REAL(rk) :: tsteplai !Number of days between the past and current LAI
!REAL(rk) :: tabovecanopy ! Above Canopy Temp (assigned = tmp2mref ), done in canopy_bioemi_mod.F90

REAL(rk) :: lat2d(nlon,nlat), lon2d(nlon,nlat), lat1d(nlon*nlat), lon1d(nlon*nlat)



write(*,*) 'Calculating Canopy Parameters'
write(*,*) '-------------------------------'

lat2d = variables_2d%lat
lon2d = variables_2d%lon
lat1d = variables%lat
lon1d = variables%lon

if (infmt_opt .eq. 0) then !Main input format is 2D NetCDF and output will be 2D NetCDf

if (ifcanwind .or. ifcanwaf) then !only calculate if canopy wind or WAF option
call canopy_calcdx_2d(dx_opt, dx_set, nlat, nlon, variables_2d%lat, &
variables_2d%lon, dx_2d)
call canopy_calcdx_2d(dx_opt, dx_set, nlat, nlon, lat2d, &
lon2d, dx_2d)
end if

if (href_opt .eq. 0 ) then !setting entire array = href_set value from user NL
Expand Down Expand Up @@ -151,11 +156,13 @@ SUBROUTINE canopy_calcs(nn)
call canopy_foliage(modlays, zhc, zcanmax, sigmau, sigma1, &
fafraczInt)
else
pavdref = variables_3d(i,j,:)%pavd
levref = variables_1d%lev
! ... derive canopy/foliage distribution shape profile from interpolated GEDI PAVD profile - bottom up total in-canopy and fraction at z
if (variables_2d(i,j)%lat .gt. (-1.0_rk*pavd_set) .and. &
variables_2d(i,j)%lat .lt. pavd_set) then !use GEDI PAVD
call canopy_pavd2fafrac(zcanmax, sigmau, sigma1, hcmref, zhc, &
variables_3d(i,j,:)%pavd, variables_1d%lev, fafraczInt)
pavdref, levref, fafraczInt)
!check if there is observed canopy height but no PAVD profile
if (hcmref .gt. 0.0 .and. maxval(fafraczInt) .le. 0.0) then !revert to prescribed shape profile
call canopy_foliage(modlays, zhc, zcanmax, sigmau, sigma1, &
Expand Down Expand Up @@ -423,8 +430,8 @@ SUBROUTINE canopy_calcs(nn)
else if (infmt_opt .eq. 1) then !Main input format is 1D/2D text and output will be 1D/2D text

if (ifcanwind .or. ifcanwaf) then !only calculate if canopy wind or WAF option
call canopy_calcdx(dx_opt, dx_set, nlat, nlon, variables%lat, &
variables%lon, dx)
call canopy_calcdx(dx_opt, dx_set, nlat, nlon, lat1d, &
lon1d, dx)
end if

if (href_opt .eq. 0 ) then !setting entire array = href_set value from user NL
Expand Down
4 changes: 2 additions & 2 deletions src/canopy_canmet_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -123,7 +123,7 @@ MODULE canopy_canmet_mod
! real(rk) :: pavd01ref, pavd02ref, pavd03ref, pavd04ref, pavd05ref, & !Input canopy PAVD profile
! pavd06ref, pavd07ref, pavd08ref, pavd09ref, pavd10ref, &
! pavd11ref, pavd12ref, pavd13ref, pavd14ref
real(rk), allocatable :: pavd_arr ( : )
real(rk), allocatable :: lev_arr ( : )
real(rk), allocatable :: pavdref ( : ), pavd_arr ( : ) !plant area volume density (m2/m3)
real(rk), allocatable :: levref ( : ), lev_arr ( : ) !reference vertical levels with 3d input data

END MODULE canopy_canmet_mod
6 changes: 5 additions & 1 deletion src/canopy_dealloc.F90
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,11 @@ SUBROUTINE canopy_dealloc
if(allocated(variables_1d)) deallocate(variables_1d)
if(allocated(variables_2d)) deallocate(variables_2d)
if(allocated(variables_3d)) deallocate(variables_3d)
if(allocated(variables_can)) deallocate(variables_can)
if(allocated(variables_can)) deallocate(variables_can)
if(allocated(pavdref)) deallocate(pavdref)
if(allocated(levref)) deallocate(levref)
if(allocated(pavd_arr)) deallocate(pavd_arr)
if(allocated(lev_arr)) deallocate(lev_arr)

!-------------------------------------------------------------------------------
! Dellocate arrays for Canopy Distribution
Expand Down
Loading

0 comments on commit 516da0d

Please sign in to comment.