Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • gwu479/Summa-Actors
  • numerical_simulations_lab/actors/Summa-Actors
2 results
Show changes
Showing
with 4428 additions and 1241 deletions
module summaActors_deallocateOuptutStruct
USE nrtype
implicit none
public::deallocateOutputStruc
contains
subroutine deallocateOutputStruc(err)
USE globalData,only:outputStructure
implicit none
integer(i4b), intent(inout) :: err
err = 0
! Time
call deallocateData_output(outputStructure(1)%timeStruct(1)); deallocate(outputStructure(1)%timeStruct)
! Forc
call deallocateData_output(outputStructure(1)%forcStat(1)); deallocate(outputStructure(1)%forcStat)
call deallocateData_output(outputStructure(1)%forcStruct(1)); deallocate(outputStructure(1)%forcStruct)
! prog
call deallocateData_output(outputStructure(1)%progStat(1)); deallocate(outputStructure(1)%progStat)
call deallocateData_output(outputStructure(1)%progStruct(1)); deallocate(outputStructure(1)%progStruct)
! diag
call deallocateData_output(outputStructure(1)%diagStat(1)); deallocate(outputStructure(1)%diagStat)
call deallocateData_output(outputStructure(1)%diagStruct(1)); deallocate(outputStructure(1)%diagStruct)
! flux
call deallocateData_output(outputStructure(1)%fluxStat(1)); deallocate(outputStructure(1)%fluxStat)
call deallocateData_output(outputStructure(1)%fluxStruct(1)); deallocate(outputStructure(1)%fluxStruct)
! indx
call deallocateData_output(outputStructure(1)%indxStat(1)); deallocate(outputStructure(1)%indxStat)
call deallocateData_output(outputStructure(1)%indxStruct(1)); deallocate(outputStructure(1)%indxStruct)
! bvar
call deallocateData_output(outputStructure(1)%bvarStat(1)); deallocate(outputStructure(1)%bvarStat)
call deallocateData_output(outputStructure(1)%bvarStruct(1)); deallocate(outputStructure(1)%bvarStruct)
! id
call deallocateData_output(outputStructure(1)%idStruct(1)); deallocate(outputStructure(1)%idStruct)
! attr
call deallocateData_output(outputStructure(1)%attrStruct(1)); deallocate(outputStructure(1)%attrStruct)
! type
call deallocateData_output(outputStructure(1)%typeStruct(1)); deallocate(outputStructure(1)%typeStruct)
! mpar
call deallocateData_output(outputStructure(1)%mparStruct(1)); deallocate(outputStructure(1)%mparStruct)
! bpar
call deallocateData_output(outputStructure(1)%bparStruct(1)); deallocate(outputStructure(1)%bparStruct)
! finalize stats
call deallocateData_output(outputStructure(1)%finalizeStats(1)); deallocate(outputStructure(1)%finalizeStats)
end subroutine deallocateOutputStruc
subroutine deallocateData_output(dataStruct)
USE data_types,only:gru_hru_time_doubleVec, &
gru_hru_time_intVec, &
gru_hru_time_flagVec, &
gru_hru_time_int, &
gru_hru_int, &
gru_hru_time_int8, &
gru_hru_time_double, &
gru_hru_double, &
gru_double
implicit none
class(*),intent(inout) :: dataStruct
! local variables
integer(i4b) :: iGRU
integer(i4b) :: iHRU
integer(i4b) :: iVar
integer(i4b) :: iTim
select type(dataStruct)
class is (gru_hru_time_doubleVec)
do iGRU = 1, size(dataStruct%gru(:))
do iHRU = 1, size(dataStruct%gru(iGRU)%hru(:))
do iVar = 1, size(dataStruct%gru(iGRU)%hru(iHRU)%var(:))
do iTim = 1, size(dataStruct%gru(iGRU)%hru(iHRU)%var(iVar)%tim(:))
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var(iVar)%tim(iTim)%dat)
end do ! Time
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var(iVar)%tim)
end do ! var
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var)
end do ! hru
deallocate(dataStruct%gru(iGRU)%hru)
end do ! gru
deallocate(dataStruct%gru)
class is (gru_hru_time_intVec)
do iGRU = 1, size(dataStruct%gru(:))
do iHRU = 1, size(dataStruct%gru(iGRU)%hru(:))
do iVar = 1, size(dataStruct%gru(iGRU)%hru(iHRU)%var(:))
do iTim = 1, size(dataStruct%gru(iGRU)%hru(iHRU)%var(iVar)%tim(:))
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var(iVar)%tim(iTim)%dat)
end do ! Time
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var(iVar)%tim)
end do ! var
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var)
end do ! hru
deallocate(dataStruct%gru(iGRU)%hru)
end do ! gru
deallocate(dataStruct%gru)
class is (gru_hru_time_flagVec)
do iGRU = 1, size(dataStruct%gru(:))
do iHRU = 1, size(dataStruct%gru(iGRU)%hru(:))
do iTim = 1, size(dataStruct%gru(iGRU)%hru(iHRU)%tim(:))
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%tim(iTim)%dat)
end do ! Time
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%tim)
end do ! hru
deallocate(dataStruct%gru(iGRU)%hru)
end do ! gru
deallocate(dataStruct%gru)
class is (gru_hru_time_int)
do iGRU = 1, size(dataStruct%gru(:))
do iHRU = 1, size(dataStruct%gru(iGRU)%hru(:))
do iVar = 1, size(dataStruct%gru(iGRU)%hru(iHRU)%var(:))
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var(iVar)%tim)
end do ! var
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var)
end do ! hru
deallocate(dataStruct%gru(iGRU)%hru)
end do ! gru
deallocate(dataStruct%gru)
class is (gru_hru_int)
do iGRU = 1, size(dataStruct%gru(:))
do iHRU = 1, size(dataStruct%gru(iGRU)%hru(:))
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var)
end do ! hru
deallocate(dataStruct%gru(iGRU)%hru)
end do ! gru
deallocate(dataStruct%gru)
class is (gru_hru_time_int8)
do iGRU = 1, size(dataStruct%gru(:))
do iHRU = 1, size(dataStruct%gru(iGRU)%hru(:))
do iVar = 1, size(dataStruct%gru(iGRU)%hru(iHRU)%var(:))
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var(iVar)%tim)
end do ! var
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var)
end do ! hru
deallocate(dataStruct%gru(iGRU)%hru)
end do ! gru
deallocate(dataStruct%gru)
class is (gru_hru_time_double)
do iGRU = 1, size(dataStruct%gru(:))
do iHRU = 1, size(dataStruct%gru(iGRU)%hru(:))
do iVar = 1, size(dataStruct%gru(iGRU)%hru(iHRU)%var(:))
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var(iVar)%tim)
end do ! var
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var)
end do ! hru
deallocate(dataStruct%gru(iGRU)%hru)
end do ! gru
deallocate(dataStruct%gru)
class is (gru_hru_double)
do iGRU = 1, size(dataStruct%gru(:))
do iHRU = 1, size(dataStruct%gru(iGRU)%hru(:))
deallocate(dataStruct%gru(iGRU)%hru(iHRU)%var)
end do ! hru
deallocate(dataStruct%gru(iGRU)%hru)
end do ! gru
deallocate(dataStruct%gru)
class is (gru_double)
do iGRU = 1, size(dataStruct%gru(:))
deallocate(dataStruct%gru(iGRU)%var)
end do ! gru
deallocate(dataStruct%gru)
end select
end subroutine
end module
\ No newline at end of file
......@@ -18,10 +18,10 @@
! You should have received a copy of the GNU General Public License
! along with this program. If not, see <http://www.gnu.org/licenses/>.
module def_output_module
module def_output_actors_module
USE, intrinsic :: iso_c_binding
USE data_types,only:var_i
USE data_types,only:var_i
USE actor_data_types,only:netcdf_gru_actor_info
USE netcdf
USE netcdf_util_module,only:netcdf_err ! netcdf error handling function
USE netcdf_util_module,only:nc_file_close ! close NetCDF files
......@@ -72,7 +72,7 @@ contains
! **********************************************************************************************************
! public subroutine def_output: define model output file
! **********************************************************************************************************
subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,err) bind(C, name='def_output')
subroutine def_output(ncid,startGRU,nGRU,nHRU,actor_info,err,message)
USE globalData,only:structInfo ! information on the data structures
USE globalData,only:forc_meta,attr_meta,type_meta ! metaData structures
USE globalData,only:prog_meta,diag_meta,flux_meta,deriv_meta ! metaData structures
......@@ -80,9 +80,7 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,err) bind(C, name='def_outp
USE globalData,only:bpar_meta,bvar_meta,time_meta ! metaData structures
USE globalData,only:model_decisions ! model decisions
USE globalData,only:outFreq ! output frequencies
USE globalData,only:fname
! Some global variabels required in the writing process
USE globalData,only:outputTimeStep
USE globalData,only:nHRUrun
USE globalData,only:nGRUrun
USE globalData,only:gru_struc
......@@ -90,24 +88,23 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,err) bind(C, name='def_outp
! modules that are not globalData
USE var_lookup,only:maxVarFreq ! # of available output frequencies
USE get_ixname_module,only:get_freqName ! get name of frequency from frequency index
USE summaActors_FileManager,only:OUTPUT_PATH,OUTPUT_PREFIX ! define output file
USE summaFileManager,only:OUTPUT_PATH,OUTPUT_PREFIX ! define output file
USE globalData,only:outputTimeStep ! output time step
! ---------------------------------------------------------------------------------------
! * variables from C++
! * Dummy Variables
! ---------------------------------------------------------------------------------------
type(c_ptr),intent(in), value :: handle_ncid ! ncid of the output file
integer(c_int),intent(in) :: startGRU ! startGRU for the entire job (for file creation)
integer(c_int),intent(in) :: nGRU ! number of GRUs
integer(c_int),intent(in) :: nHRU ! number of HRUs
integer(c_int),intent(out) :: err ! error code
! ---------------------------------------------------------------------------------------
! * Fortran Variables For Conversion
! ---------------------------------------------------------------------------------------
type(var_i),pointer :: ncid ! id of output file
type(var_i),pointer :: ncid ! id of output file
integer(i4b),intent(in) :: startGRU ! startGRU for the entire job (for file creation)
integer(i4b),intent(in) :: nGRU ! number of GRUs
integer(i4b),intent(in) :: nHRU ! number of HRUs
type(netcdf_gru_actor_info),intent(out):: actor_info ! netcdf actor information
character(*),intent(out) :: message ! error message
integer(i4b),intent(out) :: err ! error code
! ---------------------------------------------------------------------------------------
! * Local Subroutine Variables
! ---------------------------------------------------------------------------------------
character(len=256) :: message ! error message
integer(i4b) :: ivar ! loop through model decisions
integer(i4b) :: iFreq ! loop through output frequencies
integer(i4b) :: iStruct ! loop through structure types
......@@ -116,10 +113,7 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,err) bind(C, name='def_outp
integer(i4b) :: iGRU
character(LEN=256) :: startGRUString ! String Variable to convert startGRU
character(LEN=256) :: numGRUString ! String Varaible to convert numGRU
! ---------------------------------------------------------------------------------------
! * Convert From C++ to Fortran
! ---------------------------------------------------------------------------------------
call c_f_pointer(handle_ncid, ncid)
character(len=1024) :: fname ! temporary filename
! initialize errors
......@@ -130,15 +124,7 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,err) bind(C, name='def_outp
allocate(ncid%var(maxVarFreq))
ncid%var(:) = integerMissing
endif
! initalize outputTimeStep - keeps track of the step the GRU is writing for
if (.not.allocated(outputTimeStep))then
allocate(outputTimeStep(nGRU))
do iGRU = 1, nGRU
allocate(outputTimeStep(iGRU)%dat(maxVarFreq))
outputTimeStep(iGRU)%dat(:) = 1
end do
end if
! Set the global variable for the number of HRU and GRU in run
nGRUrun = nGRU
......@@ -154,10 +140,17 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,err) bind(C, name='def_outp
do iFreq=1,maxvarFreq
if (ncid%var(iFreq)/=integerMissing) then
call nc_file_close(ncid%var(iFreq),err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
if(err/=0)then
message=trim(message)//trim(cmessage)
print*, message
return
end if
endif
end do
! create initial file
! each file will have a master name with a frequency appended at the end:
! e.g., xxxxxxxxx_timestep.nc (for output at every model timestep)
......@@ -171,39 +164,67 @@ subroutine def_output(handle_ncid,startGRU,nGRU,nHRU,err) bind(C, name='def_outp
fstring = get_freqName(iFreq)
fname = trim(fileout)//'_'//trim(fstring)//'.nc'
call ini_create(nGRU,nHRU,gru_struc(1)%hruInfo(1)%nSoil,trim(fname),ncid%var(iFreq),err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
if(err/=0)then; message=trim(message)//trim(cmessage); print*, message; return; end if
! define model decisions
do iVar = 1,size(model_decisions)
if(model_decisions(iVar)%iDecision.ne.integerMissing)then
call put_attrib(ncid%var(iFreq),model_decisions(iVar)%cOption,model_decisions(iVar)%cDecision,err,cmessage)
if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
if(err/=0)then
message=trim(message)//trim(cmessage)
print*, message
return
end if
end if
end do
! define variables
do iStruct = 1,size(structInfo)
select case (trim(structInfo(iStruct)%structName))
case('attr' ); call def_variab(ncid%var(iFreq),iFreq,needHRU, noTime,attr_meta, outputPrecision, err,cmessage) ! local attributes HRU
case('type' ); call def_variab(ncid%var(iFreq),iFreq,needHRU, noTime,type_meta, nf90_int, err,cmessage) ! local classification
case('mpar' ); call def_variab(ncid%var(iFreq),iFreq,needHRU, noTime,mpar_meta, outputPrecision, err,cmessage) ! model parameters
case('bpar' ); call def_variab(ncid%var(iFreq),iFreq,needGRU, noTime,bpar_meta, outputPrecision, err,cmessage) ! basin-average param
case('indx' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,indx_meta, nf90_int, err,cmessage) ! model variables
case('deriv'); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,deriv_meta,outputPrecision, err,cmessage) ! model derivatives
case('time' ); call def_variab(ncid%var(iFreq),iFreq, noHRU,needTime,time_meta, nf90_int, err,cmessage) ! model derivatives
case('forc' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,forc_meta, outputPrecision, err,cmessage) ! model forcing data
case('prog' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,prog_meta, outputPrecision, err,cmessage) ! model prognostics
case('diag' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,diag_meta, outputPrecision, err,cmessage) ! model diagnostic variables
case('flux' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,flux_meta, outputPrecision, err,cmessage) ! model fluxes
case('bvar' ); call def_variab(ncid%var(iFreq),iFreq,needGRU,needTime,bvar_meta, outputPrecision, err,cmessage) ! basin-average variables
case('id' ); cycle ! ids -- see write_hru_info()
case('attr' ); call def_variab(ncid%var(iFreq),iFreq,needHRU, noTime,attr_meta, outputPrecision, err,cmessage) ! local attributes HRU
case('type' ); call def_variab(ncid%var(iFreq),iFreq,needHRU, noTime,type_meta, nf90_int, err,cmessage) ! local classification
case('mpar' ); call def_variab(ncid%var(iFreq),iFreq,needHRU, noTime,mpar_meta, outputPrecision, err,cmessage) ! model parameters
case('bpar' ); call def_variab(ncid%var(iFreq),iFreq,needGRU, noTime,bpar_meta, outputPrecision, err,cmessage) ! basin-average param
case('indx' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,indx_meta, nf90_int, err,cmessage) ! model variables
case('deriv' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,deriv_meta,outputPrecision, err,cmessage) ! model derivatives
case('time' ); call def_variab(ncid%var(iFreq),iFreq, noHRU,needTime,time_meta, nf90_int, err,cmessage) ! model derivatives
case('forc' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,forc_meta, outputPrecision, err,cmessage) ! model forcing data
case('prog' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,prog_meta, outputPrecision, err,cmessage) ! model prognostics
case('diag' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,diag_meta, outputPrecision, err,cmessage) ! model diagnostic variables
case('flux' ); call def_variab(ncid%var(iFreq),iFreq,needHRU,needTime,flux_meta, outputPrecision, err,cmessage) ! model fluxes
case('bvar' ); call def_variab(ncid%var(iFreq),iFreq,needGRU,needTime,bvar_meta, outputPrecision, err,cmessage) ! basin-average variables
case('id' ); cycle
case('lookup'); cycle ! ids -- see write_hru_info()
case default; err=20; message=trim(message)//'unable to identify lookup structure';
end select
! error handling
if(err/=0)then;err=20;message=trim(message)//trim(cmessage)//'[structure = '//trim(structInfo(iStruct)%structName);return;end if
if(err/=0)then
err=20
message=trim(message)//trim(cmessage)//'[structure = '//trim(structInfo(iStruct)%structName)
print*, message
return
end if
end do ! iStruct
! write HRU dimension and ID for each output file
call write_hru_info(ncid%var(iFreq), err, cmessage); if(err/=0) then; message=trim(message)//trim(cmessage); return; end if
call write_hru_info(ncid%var(iFreq), err, cmessage)
if(err/=0) then
message=trim(message)//trim(cmessage)
print*, message
return
end if
! define timing variables for actors code
! TODO: Add attributes to these variables
err = nf90_def_var(ncid%var(iFreq),"run_time",outputPrecision,(/gru_DimID/),actor_info%run_time_var_id)
err = nf90_def_var(ncid%var(iFreq),"init_duration",outputPrecision,(/gru_DimID/),actor_info%init_duration_var_id)
err = nf90_def_var(ncid%var(iFreq),"forcing_duration",outputPrecision,(/gru_DimID/),actor_info%forcing_duration_var_id)
err = nf90_def_var(ncid%var(iFreq),"run_physics_duration",outputPrecision,(/gru_DimID/),actor_info%run_physics_duration_var_id)
err = nf90_def_var(ncid%var(iFreq),"write_output_duration",outputPrecision,(/gru_DimID/),actor_info%write_output_duration_var_id)
err = nf90_def_var(ncid%var(iFreq),"successful",nf90_int,(/gru_DimID/),actor_info%state_var_id)
err = nf90_def_var(ncid%var(iFreq),"num_attempts",nf90_int,(/gru_DimID/),actor_info%num_attempts_var_id)
err = nf90_def_var(ncid%var(iFreq),"rel_tol",outputPrecision,(/gru_DimID/),actor_info%rel_tol_var_id)
err = nf90_def_var(ncid%var(iFreq),"abs_tol",outputPrecision,(/gru_DimID/),actor_info%abs_tol_var_id)
if(err/=0) then; message=trim(message)//trim(cmessage); print*, message; return; end if
end do
end subroutine def_output
......@@ -515,4 +536,4 @@ subroutine ini_create(nGRU,nHRU,nSoil,infile,ncid,err,message)
end subroutine
end module def_output_module
end module def_output_actors_module
This diff is collapsed.
This diff is collapsed.
character(len=64), parameter :: summaVersion = ''
character(len=64), parameter :: buildTime = ''
character(len=64), parameter :: gitBranch = ''
character(len=64), parameter :: gitHash = ''
\ No newline at end of file
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.