FDTD | Feature | Add point wire bulk and far-field outputs

src_output/bulkProbeOutput.F90

@@ -0,0 +1,183 @@
+module bulkProbeOutput_m
+   use FDETYPES_m
+   use utils_m
+   use outputTypes_m
+   use outputUtils_m
+   implicit none
+
+contains
+
+   subroutine init_bulk_probe_output(this, lowerBound, upperBound, field, domain, outputTypeExtension, mpidir)
+      type(bulk_current_probe_output_t), intent(out) :: this
+      type(cell_coordinate_t), intent(in) :: lowerBound, upperBound
+      integer(kind=SINGLE), intent(in) :: mpidir, field
+      character(len=BUFSIZE), intent(in) :: outputTypeExtension
+      type(domain_t), intent(in) :: domain
+
+      integer(kind=SINGLE) :: i
+
+      this%mainCoords = lowerBound
+      this%auxCoords = upperBound
+      this%component = field
+
+      this%domain = domain
+      this%path = get_output_path()
+
+      call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo)
+      call alloc_and_init(this%valueForTime, BuffObse, 0.0_RKIND)
+      call create_data_file(this%filePathTime, this%path, timeExtension, datFileExtension)
+
+   contains
+
+      function get_output_path() result(outputPath)
+         character(len=BUFSIZE)  :: probeBoundsExtension, prefixFieldExtension
+         character(len=BUFSIZE) :: outputPath
+         probeBoundsExtension = get_coordinates_extension(this%mainCoords, this%auxCoords, mpidir)
+         prefixFieldExtension = get_prefix_extension(field, mpidir)
+         outputPath = &
+            trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension))
+         return
+      end function get_output_path
+
+   end subroutine init_bulk_probe_output
+
+   subroutine update_bulk_probe_output(this, step, field)
+      type(bulk_current_probe_output_t), intent(inout) :: this
+      real(kind=RKIND_tiempo), intent(in) :: step
+      type(field_data_t), intent(in) :: field
+
+      integer(kind=SINGLE) :: i1_m, i2_m, j1_m, j2_m, k1_m, k2_m
+      integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2
+      integer(kind=SINGLE) :: iii, jjj, kkk
+
+      real(kind=RKIND), pointer, dimension(:, :, :) :: xF, yF, zF
+      real(kind=RKIND), pointer, dimension(:) :: dx, dy, dz
+
+      i1_m = this%mainCoords%x
+      j1_m = this%mainCoords%y
+      k1_m = this%mainCoords%z
+      i2_m = this%auxCoords%x
+      j2_m = this%auxCoords%y
+      k2_m = this%auxCoords%z
+
+      i1 = i1_m
+      j1 = j1_m
+      k1 = k1_m
+      i2 = i2_m
+      j2 = j2_m
+      k2 = k2_m
+
+      xF => field%x
+      yF => field%y
+      zF => field%z
+      dx => field%deltaX
+      dy => field%deltaY
+      dz => field%deltaZ
+
+      this%nTime = this%nTime + 1
+      this%timeStep(this%nTime) = step
+      this%valueForTime(this%nTime) = 0.0_RKIND !Clear uninitialized value
+      selectcase (this%component)
+      case (iBloqueJx)
+         do JJJ = j1, j2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (yF(i1_m, JJJ, k1_m - 1) - yF(i1_m, JJJ, k2_m))*dy(JJJ)
+         end do
+         do KKK = k1, k2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (-zF(i1_m, j1_m - 1, KKK) + zF(i1_m, j2_m, KKK))*dz(KKK)
+         end do
+
+      case (iBloqueJy)
+         do KKK = k1, k2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (-zF(i2_m, j1_m, KKK) + zF(i1_m - 1, j1_m, KKK))*dz(KKK)
+         end do
+         do III = i1, i2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (xF(III, j1_m, k2_m) - xF(III, j1_m, k1_m - 1))*dx(III)
+         end do
+
+      case (iBloqueJz)
+         do III = i1, i2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (xF(III, j1_m - 1, k1_m) - xF(III, j2_m, k1_m))*dx(III)
+         end do
+         do JJJ = j1, j2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (-yF(i1_m - 1, JJJ, k1_m) + yF(i2_m, JJJ, k1_m))*dy(JJJ)
+         end do
+
+      case (iBloqueMx)
+         do JJJ = j1, j2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (-yF(i1_m, JJJ, k1_m) + yF(i1_m, JJJ, k2_m + 1))*dy(JJJ)
+         end do
+         do KKK = k1, k2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (zF(i1_m, j1_m, KKK) - zF(i1_m, j2_m + 1, KKK))*dz(KKK)
+         end do
+
+      case (iBloqueMy)
+         do KKK = k1, k2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (zF(i2_m + 1, j1_m, KKK) - zF(i1_m, j1_m, KKK))*dz(KKK)
+         end do
+         do III = i1, i2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (-xF(III, j1_m, k2_m + 1) + xF(III, j1_m, k1_m))*dx(III)
+         end do
+
+      case (iBloqueMz)
+         do III = i1, i2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (-xF(III, j1_m, k1_m) + xF(III, j2_m + 1, k1_m))*dx(III)
+         end do
+         do JJJ = j1, j2
+            this%valueForTime(this%nTime) = &
+               this%valueForTime(this%nTime) + &
+               (yF(i1_m, JJJ, k1_m) - yF(i2_m + 1, JJJ, k1_m))*dy(JJJ)
+         end do
+
+      end select
+
+   end subroutine update_bulk_probe_output
+
+   subroutine flush_bulk_probe_output(this)
+      type(bulk_current_probe_output_t), intent(inout) :: this
+      integer :: i
+      integer :: unit
+      if (this%nTime <= 0) then
+         print *, "No data to write."
+         return
+      end if
+
+      open (unit=unit, file=this%filePathTime, status="old", action="write", position="append")
+
+      do i = 1, this%nTime
+         write (unit, fmt) this%timeStep(i), this%valueForTime(i)
+      end do
+
+      close (unit)
+      call clear_time_data()
+   contains
+      subroutine clear_time_data()
+         this%timeStep = 0.0_RKIND_tiempo
+         this%valueForTime = 0.0_RKIND
+
+         this%nTime = 0
+      end subroutine clear_time_data
+   end subroutine flush_bulk_probe_output
+
+end module bulkProbeOutput_m

src_output/farFieldProbeOutput.F90

@@ -0,0 +1,94 @@
+module farFieldOutput_m
+   use outputTypes_m
+   use report_m
+   use outputUtils_m
+   use farfield_m
+   implicit none
+   private
+   !===========================
+   !  Public interface summary
+   !===========================
+   public :: init_farField_probe_output
+   !public :: create_farField_probe_output
+   public :: update_farField_probe_output
+   public :: flush_farField_probe_output
+   !===========================
+contains
+
+  subroutine init_farField_probe_output(this, sgg, lowerBound, upperBound, field, domain, sphericRange, outputTypeExtension, fileNormalize,control, problemInfo, eps0, mu0)
+      type(far_field_probe_output_t), intent(out) :: this
+      type(domain_t), intent(in) :: domain
+      type(SGGFDTDINFO_t), intent(in) :: sgg
+      type(cell_coordinate_t), intent(in) :: lowerBound, upperBound
+      integer(kind=SINGLE), intent(in) :: field
+      type(spheric_domain_t), intent(in) :: sphericRange
+      type(sim_control_t), intent(in) :: control
+      character(len=*), intent(in) :: fileNormalize, outputTypeExtension
+      type(problem_info_t), intent(in) :: problemInfo
+      real(kind=RKIND), intent(in) :: mu0, eps0
+
+      if (domain%domainType /= TIME_DOMAIN) call StopOnError(0, 0, "Unexpected domain type for farField probe")
+
+      this%domain = domain
+      this%sphericRange = sphericRange
+      this%component = field
+      this%path = get_output_path()
+      call InitFarField(sgg, &
+         problemInfo%geometryToMaterialData%sggMiEx, problemInfo%geometryToMaterialData%sggMiEy, problemInfo%geometryToMaterialData%sggMiEz, &
+         problemInfo%geometryToMaterialData%sggMiHx, problemInfo%geometryToMaterialData%sggMiHy, problemInfo%geometryToMaterialData%sggMiHz, &
+                        control%layoutnumber, control%num_procs, problemInfo%simulationBounds, control%resume, &
+                        2025, this%path, &
+                        lowerBound%x, upperBound%x, &
+                        lowerBound%y, upperBound%y, &
+                        lowerBound%z, upperBound%z, &
+                        domain%fstart, domain%fstop, domain%fstep, &
+                        sphericRange%phiStart, sphericRange%phiStop, sphericRange%phiStep, &
+                        sphericRange%thetaStart, sphericRange%thetaStop, sphericRange%thetaStep, &
+                        fileNormalize, problemInfo%problemDimension, &
+                        control%facesNF2FF, control%NF2FFDecim, &
+#ifdef CompileWithMPI
+                        0, 0, &
+#endif
+                        eps0, mu0)
+
+   contains
+      function get_output_path() result(outputPath)
+         character(len=BUFSIZE)  :: probeBoundsExtension, prefixFieldExtension
+         character(len=BUFSIZE) :: outputPath
+         probeBoundsExtension = get_coordinates_extension(this%mainCoords, this%auxCoords, control%mpidir)
+         prefixFieldExtension = get_prefix_extension(field, control%mpidir)
+         outputPath = &
+            trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension))
+         return
+      end function get_output_path
+
+   end subroutine init_farField_probe_output
+
+   subroutine update_farField_probe_output(this, ntime, bounds, fieldsReference)
+    type(far_field_probe_output_t), intent(inout) :: this
+    type(fields_reference_t), intent(in) :: fieldsReference
+    integer(kind=SINGLE), intent(in) :: ntime
+    type(bounds_t), intent(in) :: bounds
+    call UpdateFarField(ntime, bounds, &
+      fieldsReference%E%x, fieldsReference%E%y, fieldsReference%E%z, &
+      fieldsReference%H%x, fieldsReference%H%y, fieldsReference%H%z)
+   end subroutine update_farField_probe_output
+
+   subroutine flush_farField_probe_output(this, simlulationTimeArray, timeIndex, control, fieldsReference, bounds)
+    type(far_field_probe_output_t), intent(out) :: this
+    integer, intent(in) :: timeIndex
+    real(KIND=RKIND_tiempo), pointer, dimension(:), intent(in) :: simlulationTimeArray
+    type(sim_control_t), intent(in) :: control
+    type(fields_reference_t), pointer, intent(in) :: fieldsReference
+    type(bounds_t), intent(in) :: bounds
+
+    real(kind=RKIND_tiempo) :: flushTime
+
+    flushTime = simlulationTimeArray(timeIndex)
+    call FlushFarfield(control%layoutnumber, control%num_procs, bounds, &
+    fieldsReference%E%deltaX, fieldsReference%E%deltaY, fieldsReference%E%deltaZ, &
+    fieldsReference%H%deltaX, fieldsReference%H%deltaY, fieldsReference%H%deltaZ, &
+    control%facesNF2FF, flushTime)
+    end subroutine flush_farfield_probe_output
+
+end module farFieldOutput_m