diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 1e2f97a1a..5530b61e6 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -9,6 +9,7 @@ submodule (encounter_classes) s_encounter_io use swiftest + use netcdf contains module subroutine encounter_io_dump_storage_list(self, param) @@ -26,12 +27,70 @@ module subroutine encounter_io_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF encounter file system and defines all variables. + use, intrinsic :: ieee_arithmetic implicit none ! Arguments class(encounter_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + ! Check if the file exists, and if it does, delete it + inquire(file=param%outfile, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=self%outfile, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + call check( nf90_create(self%outfile, NF90_NETCDF4, self%ncid), "encounter_io_initialize_output nf90_create" ) + + call check( nf90_def_dim(self%ncid, ENCID_DIMNAME, NF90_UNLIMITED, self%encid_dimid), "encounter_io_initialize_output nf90_def_dim encid_dimid" ) + call check( nf90_def_dim(self%ncid, STR_DIMNAME, NAMELEN, self%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(self%ncid, TIME_DIMNAME, NF90_UNLIMITED, self%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select + + call check( nf90_def_var(self%ncid, TIME_DIMNAME, self%out_type, self%time_dimid, self%time_varid), "encounter_io_initialize_output nf90_def_var time_varid" ) + call check( nf90_def_var(self%ncid, ENCID_DIMNAME, NF90_INT, self%encid_dimid, self%encid_varid), "encounter_io_initialize_output nf90_def_var encid_varid" ) + call check( nf90_def_var(self%ncid, NENC_VARNAME, NF90_INT, self%time_dimid, self%nenc_varid), "encounter_io_initialize_output nf90_def_var nenc_varid" ) + call check( nf90_def_var(self%ncid, ID1_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%id1_varid), "encounter_io_initialize_output nf90_def_var id1_varid" ) + call check( nf90_def_var(self%ncid, ID2_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%id2_varid), "encounter_io_initialize_output nf90_def_var id2_varid" ) + call check( nf90_def_var(self%ncid, X1X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x1x_varid), "encounter_io_initialize_output nf90_def_var x1x_varid" ) + call check( nf90_def_var(self%ncid, X1Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x1y_varid), "encounter_io_initialize_output nf90_def_var x1y_varid" ) + call check( nf90_def_var(self%ncid, X1Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x1z_varid), "encounter_io_initialize_output nf90_def_var x1z_varid" ) + call check( nf90_def_var(self%ncid, X2X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x2x_varid), "encounter_io_initialize_output nf90_def_var x2x_varid" ) + call check( nf90_def_var(self%ncid, X2Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x2y_varid), "encounter_io_initialize_output nf90_def_var x2y_varid" ) + call check( nf90_def_var(self%ncid, X2Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x2z_varid), "encounter_io_initialize_output nf90_def_var x2z_varid" ) + call check( nf90_def_var(self%ncid, V1X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v1x_varid), "encounter_io_initialize_output nf90_def_var v1x_varid" ) + call check( nf90_def_var(self%ncid, V1Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v1y_varid), "encounter_io_initialize_output nf90_def_var v1y_varid" ) + call check( nf90_def_var(self%ncid, V1Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v1z_varid), "encounter_io_initialize_output nf90_def_var v1z_varid" ) + call check( nf90_def_var(self%ncid, V2X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v2x_varid), "encounter_io_initialize_output nf90_def_var v2x_varid" ) + call check( nf90_def_var(self%ncid, V2Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v2y_varid), "encounter_io_initialize_output nf90_def_var v2y_varid" ) + call check( nf90_def_var(self%ncid, V2Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v2z_varid), "encounter_io_initialize_output nf90_def_var v2z_varid" ) + call check( nf90_def_var(self%ncid, LEVEL_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%level_varid), "encounter_io_initialize_output nf90_def_var level_varid" ) + + + ! Take the file out of define mode + call check( nf90_enddef(self%ncid), "encounter_io_initialize_output nf90_enddef" ) return + + 667 continue + write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) end subroutine encounter_io_initialize_output @@ -44,6 +103,18 @@ module subroutine encounter_io_open_file(self, param, readonly) class(encounter_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only + ! Internals + integer(I4B) :: mode, status + character(len=NF90_MAX_NAME) :: str_dim_name + character(len=STRMAX) :: errmsg + + mode = NF90_WRITE + if (present(readonly)) then + if (readonly) mode = NF90_NOWRITE + end if + + write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) + call check( nf90_open(self%outfile, mode, self%ncid), errmsg) return end subroutine encounter_io_open_file diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index f41c350e0..144369346 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -17,6 +17,24 @@ module encounter_classes public integer(I4B), parameter :: SWEEPDIM = 3 + !! NetCDF dimension and variable names for the enounter save object + character(*), parameter :: ENCID_DIMNAME = "encounter" + character(*), parameter :: NENC_VARNAME = "nenc" + character(*), parameter :: ID1_VARNAME = "id1" + character(*), parameter :: ID2_VARNAME = "id2" + character(*), parameter :: X1X_VARNAME = "x1x" + character(*), parameter :: X1Y_VARNAME = "x1y" + character(*), parameter :: X1Z_VARNAME = "x1z" + character(*), parameter :: X2X_VARNAME = "x2x" + character(*), parameter :: X2Y_VARNAME = "x2y" + character(*), parameter :: X2Z_VARNAME = "x2z" + character(*), parameter :: V1X_VARNAME = "v1x" + character(*), parameter :: V1Y_VARNAME = "v1y" + character(*), parameter :: V1Z_VARNAME = "v1z" + character(*), parameter :: V2X_VARNAME = "v2x" + character(*), parameter :: V2Y_VARNAME = "v2y" + character(*), parameter :: V2Z_VARNAME = "v2z" + character(*), parameter :: LEVEL_VARNAME = "level" type :: encounter_list integer(I8B) :: nenc = 0 !! Total number of encounters @@ -48,6 +66,26 @@ module encounter_classes end type encounter_storage type, extends(netcdf_parameters) :: encounter_io_parameters + character(STRMAX) :: outfile = "encounter.nc" !! Encounter output file name + integer(I4B) :: encid_dimid !! NetCDF ID for the encounter pair index dimension + integer(I4B) :: encid_varid !! NetCDF ID for the encounter pair index variable + integer(I4B) :: nenc_varid !! NetCDF ID for the number of encounters variable + integer(I4B) :: id1_varid !! NetCDF ID for the id1 of the encounter variable + integer(I4B) :: id2_varid !! NetCDF ID for the id2 of the encounter variable + integer(I4B) :: x1x_varid !! NetCDF ID for the body1 x position variable + integer(I4B) :: x1y_varid !! NetCDF ID for the body1 y position variable + integer(I4B) :: x1z_varid !! NetCDF ID for the body1 z position variable + integer(I4B) :: x2x_varid !! NetCDF ID for the body2 x position variable + integer(I4B) :: x2y_varid !! NetCDF ID for the body2 y position variable + integer(I4B) :: x2z_varid !! NetCDF ID for the body2 z position variable + integer(I4B) :: v1x_varid !! NetCDF ID for the body1 x velocity variable + integer(I4B) :: v1y_varid !! NetCDF ID for the body1 y velocity variable + integer(I4B) :: v1z_varid !! NetCDF ID for the body1 z velocity variable + integer(I4B) :: v2x_varid !! NetCDF ID for the body2 x velocity variable + integer(I4B) :: v2y_varid !! NetCDF ID for the body2 y velocity variable + integer(I4B) :: v2z_varid !! NetCDF ID for the body2 z velocity variable + integer(I4B) :: level_varid !! NetCDF ID for the recursion level variable + contains procedure :: initialize => encounter_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object procedure :: open => encounter_io_open_file !! Opens a NetCDF file diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index f23a3c76e..fe35c647c 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -496,6 +496,13 @@ end subroutine abstract_step_system end interface interface + + module subroutine check(status, call_identifier) + implicit none + integer, intent (in) :: status !! The status code returned by a NetCDF function + character(len=*), intent(in), optional :: call_identifier + end subroutine check + module subroutine discard_pl(self, system, param) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 1dd114f92..d0098765d 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -12,7 +12,7 @@ use netcdf contains - subroutine check(status, call_identifier) + module subroutine check(status, call_identifier) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! !! Checks the status of all NetCDF operations to catch errors