Started to flesh out the fraggle netcdf output

src/fraggle/fraggle_io.f90

@@ -13,18 +13,108 @@
 contains
 
 
-   module subroutine fraggle_io_encounter_initialize_output(self, param)
+   module subroutine fraggle_io_initialize_output(self, param)
+      !! author: David A. Minton
+      !!
+      !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables.
+      use, intrinsic :: ieee_arithmetic
+      use netcdf
       implicit none
-      class(fraggle_io_encounter_parameters), intent(inout) :: self    !! Parameters used to identify a particular NetCDF dataset
+      ! Arguments
+      class(fraggle_io_parameters), intent(inout) :: self    !! Parameters used to identify a particular NetCDF dataset
       class(swiftest_parameters),             intent(in)    :: param   
-   end subroutine fraggle_io_encounter_initialize_output
+      ! Internals
+      integer(I4B) :: i, nvar, varid, vartype
+      real(DP) :: dfill
+      real(SP) :: sfill
+      logical :: fileExists
+      character(len=STRMAX) :: errmsg
+      integer(I4B) :: ndims
+
+      associate(nc => self)
+         dfill = ieee_value(dfill, IEEE_QUIET_NAN)
+         sfill = ieee_value(sfill, IEEE_QUIET_NAN)
+
+
+         select case (param%out_type)
+         case("NETCDF_FLOAT")
+            self%out_type = NF90_FLOAT
+         case("NETCDF_DOUBLE")
+            self%out_type = NF90_DOUBLE
+         end select
+
+         ! Check if the file exists, and if it does, delete it
+         inquire(file=nc%frag_file, exist=fileExists)
+         if (fileExists) then
+            open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg)
+            close(unit=LUN, status="delete")
+         end if
+
+
+         call check( nf90_create(nc%frag_file, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" )
+
+         ! Dimensions
+         call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "fraggle_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension
+         call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" )           ! 3D space dimension
+         call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" )       ! dimension to store particle id numbers
+         call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid"  )          ! Dimension for string variables (aka character arrays)
+         call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid"  )          ! Dimension for stage variables (aka "before" vs. "after"
+
+         ! Variables
+         call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid"  )
+         call check( nf90_def_var(nc%id, nc%rh_varname,  nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid"  )
+         call check( nf90_def_var(nc%id, nc%vh_varname,  nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid"  )
+         call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid"  )
+         call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid"  )
+         if (param%lclose) then
+            call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid"  )
+         end if
+         if (param%lrotation) then
+            call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid"  )
+            call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid"  )
+         end if
+
+         call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables"  )
+         do varid = 1, nvar
+            call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable"  )
+            select case(vartype)
+            case(NF90_INT)
+               call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT"  )
+            case(NF90_FLOAT)
+               call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT"  )
+            case(NF90_DOUBLE)
+               call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE"  )
+            case(NF90_CHAR)
+               call check( nf90_def_var_fill(nc%id, varid, 0, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR"  )
+            end select
+         end do
+         ! Take the file out of define mode
+         call check( nf90_enddef(nc%id), "fraggle_io_initialize nf90_enddef"  )
+
+         ! Add in the space and stage dimension coordinates
+         call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space"  )
+         call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords, start=[1], count=[2]), "fraggle_io_initialize nf90_put_var stage"  )
+
+         ! Pre-fill id slots with ids
+         call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_var pl id_varid"  )
+      end associate
+
+      return
 
-   module subroutine fraggle_io_encounter_write_frame(self, nc, param)
+      667 continue
+      write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg))
+      call util_exit(FAILURE)
+   end subroutine fraggle_io_initialize_output
+
+
+   module subroutine fraggle_io_write_frame(self, nc, param)
       implicit none
       class(fraggle_encounter_snapshot), intent(in)    :: self   !! Swiftest encounter structure
       class(encounter_io_parameters),    intent(inout) :: nc     !! Parameters used to identify a particular encounter io NetCDF dataset
       class(swiftest_parameters),        intent(inout) :: param  !! Current run configuration parameters
-   end subroutine fraggle_io_encounter_write_frame
+
+      return
+   end subroutine fraggle_io_write_frame
 
    module subroutine fraggle_io_log_generate(frag)
       !! author: David A. Minton

src/modules/encounter_classes.f90

@@ -68,7 +68,7 @@ module encounter_classes
 
    !> A class that that is used to store simulation history data between file output
    type, extends(swiftest_storage) :: encounter_storage
-      type(encounter_io_parameters) :: nc  !! NetCDF parameter object containing the details about the file attached to this storage object
+      class(encounter_io_parameters), allocatable :: nc  !! NetCDF parameter object containing the details about the file attached to this storage object
    contains
       procedure :: dump   => encounter_io_dump !! Dumps contents of encounter history to file
       final     ::           encounter_util_final_storage

src/modules/fraggle_classes.f90

@@ -110,17 +110,28 @@ module fraggle_classes
    end type fraggle_fragments
 
    !! NetCDF dimension and variable names for the enounter save object
-   type, extends(encounter_io_parameters) :: fraggle_io_encounter_parameters
+   type, extends(encounter_io_parameters) :: fraggle_io_parameters
+      character(STRMAX)  :: frag_file                 !! Encounter output file name
+      integer(I4B)       :: stage_dimid                                     !! ID for the name variable  
+      integer(I4B)       :: stage_varid                                     !! ID for the name variable  
+      character(NAMELEN) :: stage_dimname            = "stage"              !! name of the stage dimension (before/after)
+      character(len=6), dimension(2) :: stage_coords = ["before", "after "] !! The stage coordinate labels
+
+      character(NAMELEN) :: Qloss_varname  = "Qloss"  !! name of the energy loss variable
+      integer(I4B)       :: Qloss_varid               !! ID for the energy loss variable 
+      character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable
+      integer(I4B)       :: regime_varid              !! ID for the collision regime variable 
+
    contains
-      procedure :: initialize => fraggle_io_encounter_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object
-   end type fraggle_io_encounter_parameters
+      procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object
+   end type fraggle_io_parameters
 
    type, extends(encounter_snapshot)  :: fraggle_encounter_snapshot
       logical                               :: lcollision !! Indicates that this snapshot contains at least one collision
       class(fraggle_colliders), allocatable :: colliders  !! Colliders object at this snapshot
       class(fraggle_fragments), allocatable :: fragments  !! Fragments object at this snapshot
    contains
-      procedure :: write_frame => fraggle_io_encounter_write_frame !! Writes a frame of encounter data to file 
+      procedure :: write_frame => fraggle_io_write_frame !! Writes a frame of encounter data to file 
       final     ::                fraggle_util_final_snapshot
    end type fraggle_encounter_snapshot
 
@@ -135,18 +146,18 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa
          logical,                      intent(out)   :: lfailure  !! Answers the question: Should this have been a merger instead?
       end subroutine fraggle_generate_fragments
 
-      module subroutine fraggle_io_encounter_initialize_output(self, param)
+      module subroutine fraggle_io_initialize_output(self, param)
          implicit none
-         class(fraggle_io_encounter_parameters), intent(inout) :: self    !! Parameters used to identify a particular NetCDF dataset
+         class(fraggle_io_parameters), intent(inout) :: self    !! Parameters used to identify a particular NetCDF dataset
          class(swiftest_parameters),             intent(in)    :: param   
-      end subroutine fraggle_io_encounter_initialize_output
+      end subroutine fraggle_io_initialize_output
 
-      module subroutine fraggle_io_encounter_write_frame(self, nc, param)
+      module subroutine fraggle_io_write_frame(self, nc, param)
          implicit none
          class(fraggle_encounter_snapshot), intent(in)    :: self   !! Swiftest encounter structure
          class(encounter_io_parameters),    intent(inout) :: nc     !! Parameters used to identify a particular encounter io NetCDF dataset
          class(swiftest_parameters),        intent(inout) :: param  !! Current run configuration parameters
-      end subroutine fraggle_io_encounter_write_frame
+      end subroutine fraggle_io_write_frame
 
       module subroutine fraggle_io_log_generate(frag)
          implicit none

src/modules/swiftest_classes.f90

@@ -45,7 +45,7 @@ module swiftest_classes
       character(NAMELEN) :: ptype_varname           = "particle_type"   !! name of the particle type variable
       integer(I4B)       :: ptype_varid                                 !! ID for the particle type variable
       character(NAMELEN) :: name_varname            = "name"            !! name of the particle name variable
-      integer(I4B)       :: name_varid                                  !! ID for the namevariable 
+      integer(I4B)       :: name_varid                                  !! ID for the name variable 
       character(NAMELEN) :: npl_varname             = "npl"             !! name of the number of active massive bodies variable
       integer(I4B)       :: npl_varid                                   !! ID for the number of active massive bodies variable
       character(NAMELEN) :: ntp_varname             = "ntp"             !! name of the number of active test particles variable

src/setup/setup.f90

@@ -73,6 +73,7 @@ module subroutine setup_construct_system(system, param)
             class is (symba_parameters)
                if (param%lencounter_save) then
                   if (.not. allocated(system%encounter_history)) allocate(encounter_storage :: system%encounter_history)
+                  allocate(fraggle_io_parameters :: system%encounter_history%nc)
                   call system%encounter_history%reset()
                   system%encounter_history%nc%file_number = param%iloop / param%dump_cadence
                end if

src/symba/symba_io.f90

@@ -26,6 +26,10 @@ module subroutine symba_io_dump_encounter(self, param)
       ! Create and save the output file for this encounter
       self%encounter_history%nc%time_dimsize = maxval(self%encounter_history%tslot(:))
       write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') self%encounter_history%nc%file_number
+      select type(nc => self%encounter_history%nc)
+      class is (fraggle_io_parameters)
+         write(nc%frag_file, '("fragmentation_",I0.6,".nc")') nc%file_number
+      end select
       call self%encounter_history%nc%initialize(param)
       call self%encounter_history%dump(param)
       call self%encounter_history%nc%close()

src/symba/symba_util.f90

@@ -903,6 +903,7 @@ subroutine symba_util_save_storage(system, snapshot, t)
          tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold)
          tmp%tslot(nold+1:nbig) = 0
          tmp%iframe = system%encounter_history%iframe
+         call move_alloc(system%encounter_history%nc, tmp%nc)
 
          do i = 1, nold
             if (allocated(system%encounter_history%frame(i)%item)) call move_alloc(system%encounter_history%frame(i)%item, tmp%frame(i)%item)