From 2f959c65960e3fb8bb1eda3e3aee1b0d31614ebb Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 27 Nov 2025 09:38:45 +0100 Subject: [PATCH 01/67] Create new output module --- src_output/output.F90 | 228 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 228 insertions(+) create mode 100644 src_output/output.F90 diff --git a/src_output/output.F90 b/src_output/output.F90 new file mode 100644 index 00000000..d93af20a --- /dev/null +++ b/src_output/output.F90 @@ -0,0 +1,228 @@ +module output + use FDETYPES + implicit none + character(len=4) :: datFileExtension = '.dat' + + type solver_output_t + type(point_probe_output_t ), allocatable :: pointProbe + type(wire_probe_output_t ), allocatable :: wireProbe + type(bulk_current_probe_output_t ), allocatable :: bulkCurrentProbe + type(far_field_t ), allocatable :: farField + type(time_movie_output_t ), allocatable :: timeMovie + type(frequency_slice_output_t ), allocatable :: frequencySlice + end type solver_output_t + + type point_probe_output_t + integer(kind=SINGLE) :: columnas = 2_SINGLE + character(len=BUFSIZE) :: path + + end type point_probe_output_t + + + interface init_solver_output + module procedure & + init_point_probe_output , & + init_wire_probe_output , & + init_bulk_current_probe_output , & + init_far_field , & + initime_movie_output , & + init_frequency_slice_output + end interface + + interface update_solver_output + module procedure & + update_point_probe_output , & + update_wire_probe_output , & + update_bulk_current_probe_output , & + update_far_field , & + updateime_movie_output , & + update_frequency_slice_output + end interface + + interface flush_solver_output + module procedure & + flush_point_probe_output , & + flush_wire_probe_output , & + flush_bulk_current_probe_output , & + flush_far_field , & + flushime_movie_output , & + flush_frequency_slice_output + end interface + + interface delete_solver_output + module procedure & + delete_point_probe_output , & + delete_wire_probe_output , & + delete_bulk_current_probe_output , & + delete_far_field , & + deleteime_movie_output , & + delete_frequency_slice_output + end interface +contains + + subroutine init_point_probe_output(probeOutput, iCoord, jCoord, kCoord, field, outputTypeExtension, mpidir) + type(point_probe_output_t), intent(out) :: probeOutput + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord + integer(kind=SINGLE), intent(in) :: mpidir, field + character(len=BUFSIZE), intent(in) :: outputTypeExtension + + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + + probeBoundsExtension = get_probe_bounds_extension(iCoord, jCoord, kCoord, mpidir) + prefixFieldExtension = get_prefix_extension(field, mpidir) + probeOutput%path = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension))//trim(adjustl(datFileExtension)) + + end subroutine init_point_probe_output + + function get_probe_bounds_extension(iCoord, jCoord, kCoord) result(probeBoundsExtension) + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord + character(len=BUFSIZE) :: probeBoundsExtension + + character(len=BUFSIZE) :: chari, charj, chark + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + + #if CompileWithMPI + if (mpidir == 3) then + probeBoundsExtension = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + elseif (mpidir == 2) then + probeBoundsExtension = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) + elseif (mpidir == 1) then + probeBoundsExtension = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) + else + call stoponerror(layoutnumber, size, 'Buggy error in mpidir. ') + end if + #else + probeBoundsExtension = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + #endif + + return + end function get_probe_bounds_extension + + function get_prefix_extension(field, mpidir) result(prefixExtension) + integer(kind=SINGLE), intent(in) :: field, mpidir + character(len=BUFSIZE) :: prefixExtension + + #if CompileWithMPI + prefixExtension = get_rotated_prefix(field, mpidir) + #else + prefixExtension = prefix(field) + #endif + end function get_prefix_extension + + function get_rotated_prefix(field, mpidir) result(prefixExtension) + integer(kind=SINGLE), intent(in) :: field, mpidir + character(len=BUFSIZE) :: prefixExtension + if (mpidir == 3) then + select case (field) + case (iEx); prefixExtension = prefix(iEx) + case (iEy); prefixExtension = prefix(iEy) + case (iEz); prefixExtension = prefix(iEz) + case (iJx); prefixExtension = prefix(iJx) + case (iJy); prefixExtension = prefix(iJy) + case (iJz); prefixExtension = prefix(iJz) + case (iQx); prefixExtension = prefix(iQx) + case (iQy); prefixExtension = prefix(iQy) + case (iQz); prefixExtension = prefix(iQz) + case (iVx); prefixExtension = prefix(iVx) + case (iVy); prefixExtension = prefix(iVy) + case (iVz); prefixExtension = prefix(iVz) + case (iHx); prefixExtension = prefix(iHx) + case (iHy); prefixExtension = prefix(iHy) + case (iHz); prefixExtension = prefix(iHz) + case default; prefixExtension = prefix(field) + end select + elseif (mpidir == 2) then + select case (field) + case (iEx); prefixExtension = prefix(iEz) + case (iEy); prefixExtension = prefix(iEx) + case (iEz); prefixExtension = prefix(iEy) + case (iJx); prefixExtension = prefix(iJz) + case (iJy); prefixExtension = prefix(iJx) + case (iJz); prefixExtension = prefix(iJy) + case (iQx); prefixExtension = prefix(iQz) + case (iQy); prefixExtension = prefix(iQx) + case (iQz); prefixExtension = prefix(iQy) + case (iVx); prefixExtension = prefix(iVz) + case (iVy); prefixExtension = prefix(iVx) + case (iVz); prefixExtension = prefix(iVy) + case (iHx); prefixExtension = prefix(iHz) + case (iHy); prefixExtension = prefix(iHx) + case (iHz); prefixExtension = prefix(iHy) + case default; prefixExtension = prefix(field) + end select + elseif (mpidir == 1) then + select case (field) + case (iEx); prefixExtension = prefix(iEy) + case (iEy); prefixExtension = prefix(iEz) + case (iEz); prefixExtension = prefix(iEx) + case (iJx); prefixExtension = prefix(iJy) + case (iJy); prefixExtension = prefix(iJz) + case (iJz); prefixExtension = prefix(iJx) + case (iQx); prefixExtension = prefix(iQy) + case (iQy); prefixExtension = prefix(iQz) + case (iQz); prefixExtension = prefix(iQx) + case (iVx); prefixExtension = prefix(iVy) + case (iVy); prefixExtension = prefix(iVz) + case (iVz); prefixExtension = prefix(iVx) + case (iHx); prefixExtension = prefix(iHy) + case (iHy); prefixExtension = prefix(iHz) + case (iHz); prefixExtension = prefix(iHx) + case default; prefixExtension = prefix(field) + end select + else + call stoponerror(layoutnumber, size, 'Buggy error in mpidir. ') + end if + return + end function get_rotated_prefix + + function prefix(campo) result(ext) + integer(kind=SINGLE), intent(in) :: campo + character(len=BUFSIZE) :: ext + + select case (campo) + case (iEx); ext = 'Ex' + case (iEy); ext = 'Ey' + case (iEz); ext = 'Ez' + case (iVx); ext = 'Vx' + case (iVy); ext = 'Vy' + case (iVz); ext = 'Vz' + case (iHx); ext = 'Hx' + case (iHy); ext = 'Hy' + case (iHz); ext = 'Hz' + case (iBloqueJx); ext = 'Jx' + case (iBloqueJy); ext = 'Jy' + case (iBloqueJz); ext = 'Jz' + case (iBloqueMx); ext = 'Mx' + case (iBloqueMy); ext = 'My' + case (iBloqueMz); ext = 'Mz' + case (iJx); ext = 'Wx' + case (iJy); ext = 'Wy' + case (iJz); ext = 'Wz' + case (iQx); ext = 'Qx' + case (iQy); ext = 'Qy' + case (iQz); ext = 'Qz' + case (iExC); ext = 'ExC' + case (iEyC); ext = 'EyC' + case (iEzC); ext = 'EzC' + case (iHxC); ext = 'HxC' + case (iHyC); ext = 'HyC' + case (iHzC); ext = 'HzC' + case (iMEC); ext = 'ME' + case (iMHC); ext = 'MH' + case (iCur); ext = 'BC' + case (mapvtk); ext = 'MAP' + case (iCurX); ext = 'BCX' + case (iCurY); ext = 'BCY' + case (iCurZ); ext = 'BCZ' + case (farfield); ext = 'FF' + case (lineIntegral); ext = 'LI' + end select + return + end function prefix + + +end module output \ No newline at end of file From 79504b9df6d5a2fc5deee3618b443431a832be1a Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 27 Nov 2025 12:20:52 +0100 Subject: [PATCH 02/67] Added point probe flush --- src_output/domain.F90 | 70 +++++++ src_output/output.F90 | 388 +++++++++++++++++-------------------- src_output/outputUtils.F90 | 147 ++++++++++++++ 3 files changed, 390 insertions(+), 215 deletions(-) create mode 100644 src_output/domain.F90 create mode 100644 src_output/outputUtils.F90 diff --git a/src_output/domain.F90 b/src_output/domain.F90 new file mode 100644 index 00000000..9363334b --- /dev/null +++ b/src_output/domain.F90 @@ -0,0 +1,70 @@ +module mod_domain + use FDETYPES + implicit none + + integer, parameter :: UNDEFINED_DOMAIN = -1 + integer, parameter :: TIME_DOMAIN = 0 + integer, parameter :: FREQUENCY_DOMAIN = 1 + integer, parameter :: BOTH_DOMAIN = 2 + + ! Definición del tipo derivado + type :: domain_t + real(kind=RKIND_tiempo) :: tstart = 0.0_RKIND_tiempo, tstop = 0.0_RKIND_tiempo, tstep = 0.0_RKIND_tiempo + real(kind=RKIND) :: fstart = 0.0_RKIND, fstop = 0.0_RKIND + integer(kind=SINGLE) :: fnum = 0 + integer(kind=SINGLE) :: domainType = UNDEFINED_DOMAIN + logical :: logarithmicSpacing = .false. + + contains + generic :: domain_t => new_domain_time, new_domain_freq, new_domain_both + end type domain_t + +contains + function new_domain_time(tstart, tstop, tstep) result(new_domain) + real(kind=RKIND_tiempo), intent(in) :: tstart, tstop, tstep + type(domain_t) :: new_domain + + new_domain%tstart = tstart + new_domain%tstop = tstop + new_domain%tstep = tstep + new_domain%domainType = TIME_DOMAIN + end function new_domain_time + + function new_domain_freq(fstart, fstop, fnum, logarithmicSpacing) result(new_domain) + real(kind=RKIND), intent(in) :: fstart, fstop + integer(kind=SINGLE), intent(in) :: fnum + logical, intent(in), optional :: logarithmicSpacing + type(domain_t) :: new_domain + + new_domain%fstart = fstart + new_domain%fstop = fstop + new_domain%fnum = fnum + new_domain%domainType = FREQUENCY_DOMAIN + + if (present(logarithmicSpacing)) then + new_domain%logarithmicSpacing = logarithmicSpacing + end if + end function new_domain_freq + + function new_domain_both(tstart, tstop, tstep, fstart, fstop, fnum, logarithmicSpacing) result(new_domain) + real(kind=RKIND_tiempo), intent(in) :: tstart, tstop, tstep + real(kind=RKIND), intent(in) :: fstart, fstop + integer(kind=SINGLE), intent(in) :: fnum + logical, intent(in), optional :: logarithmicSpacing + type(domain_t) :: new_domain + + new_domain%tstart = tstart + new_domain%tstop = tstop + new_domain%tstep = tstep + + new_domain%fstart = fstart + new_domain%fstop = fstop + new_domain%fnum = fnum + new_domain%domainType = BOTH_DOMAIN + + if (present(logarithmicSpacing)) then + new_domain%logarithmicSpacing = logarithmicSpacing + end if + end function new_domain_both + +end module mod_domain diff --git a/src_output/output.F90 b/src_output/output.F90 index d93af20a..95ed06ad 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -1,228 +1,186 @@ module output - use FDETYPES - implicit none - character(len=4) :: datFileExtension = '.dat' - - type solver_output_t - type(point_probe_output_t ), allocatable :: pointProbe - type(wire_probe_output_t ), allocatable :: wireProbe - type(bulk_current_probe_output_t ), allocatable :: bulkCurrentProbe - type(far_field_t ), allocatable :: farField - type(time_movie_output_t ), allocatable :: timeMovie - type(frequency_slice_output_t ), allocatable :: frequencySlice - end type solver_output_t - - type point_probe_output_t - integer(kind=SINGLE) :: columnas = 2_SINGLE - character(len=BUFSIZE) :: path - - end type point_probe_output_t - - - interface init_solver_output - module procedure & - init_point_probe_output , & - init_wire_probe_output , & - init_bulk_current_probe_output , & - init_far_field , & - initime_movie_output , & - init_frequency_slice_output - end interface - - interface update_solver_output - module procedure & - update_point_probe_output , & - update_wire_probe_output , & - update_bulk_current_probe_output , & - update_far_field , & - updateime_movie_output , & - update_frequency_slice_output - end interface - - interface flush_solver_output - module procedure & - flush_point_probe_output , & - flush_wire_probe_output , & - flush_bulk_current_probe_output , & - flush_far_field , & - flushime_movie_output , & - flush_frequency_slice_output - end interface - - interface delete_solver_output - module procedure & - delete_point_probe_output , & - delete_wire_probe_output , & - delete_bulk_current_probe_output , & - delete_far_field , & - deleteime_movie_output , & - delete_frequency_slice_output - end interface + use FDETYPES + use mod_domain + use mod_outputUtils + implicit none + character(len=4) :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' + integer(kind=SINGLE) :: MAX_SERIALIZED_COUNT = 500, FILE_UNIT = 400 + + type solver_output_t + type(point_probe_output_t), allocatable :: pointProbe + type(wire_probe_output_t), allocatable :: wireProbe + type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe + type(far_field_t), allocatable :: farField + type(time_movie_output_t), allocatable :: timeMovie + type(frequency_slice_output_t), allocatable :: frequencySlice + end type solver_output_t + + type point_probe_output_t + integer(kind=SINGLE) :: columnas = 2_SINGLE + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: fieldComponent + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE, nFreq = 0_SINGLE + real(kind=RKIND_tiempo), dimension(MAX_SERIALIZED_COUNT), allocatable :: timeStep + real(kind=RKIND), dimension(MAX_SERIALIZED_COUNT), allocatable :: valueForTime + real(kind=RKIND), dimension(:), allocatable :: frequencySlice + real(kind=CKIND), dimension(:), allocatable :: valueForFreq + end type point_probe_output_t + + interface init_solver_output + module procedure & + init_point_probe_output, & + init_wire_probe_output, & + init_bulk_current_probe_output, & + init_far_field, & + initime_movie_output, & + init_frequency_slice_output + end interface + + interface update_solver_output + module procedure & + update_point_probe_output, & + update_wire_probe_output, & + update_bulk_current_probe_output, & + update_far_field, & + updateime_movie_output, & + update_frequency_slice_output + end interface + + interface flush_solver_output + module procedure & + flush_point_probe_output, & + flush_wire_probe_output, & + flush_bulk_current_probe_output, & + flush_far_field, & + flushime_movie_output, & + flush_frequency_slice_output + end interface + + interface delete_solver_output + module procedure & + delete_point_probe_output, & + delete_wire_probe_output, & + delete_bulk_current_probe_output, & + delete_far_field, & + deleteime_movie_output, & + delete_frequency_slice_output + end interface contains - subroutine init_point_probe_output(probeOutput, iCoord, jCoord, kCoord, field, outputTypeExtension, mpidir) - type(point_probe_output_t), intent(out) :: probeOutput + subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, outputTypeExtension, mpidir) + type(point_probe_output_t), intent(out) :: this integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord integer(kind=SINGLE), intent(in) :: mpidir, field character(len=BUFSIZE), intent(in) :: outputTypeExtension + type(domain_t), intent(in) :: domain character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension - probeBoundsExtension = get_probe_bounds_extension(iCoord, jCoord, kCoord, mpidir) - prefixFieldExtension = get_prefix_extension(field, mpidir) - probeOutput%path = & - trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension))//trim(adjustl(datFileExtension)) + this%xCoord = iCoord + this%yCoord = jCoord + this%zCoord = kCoord - end subroutine init_point_probe_output + this%domain = domain + this%path = get_output_path(outputTypeExtension, iCoord, jCoord, kCoord, field, mpidir) - function get_probe_bounds_extension(iCoord, jCoord, kCoord) result(probeBoundsExtension) - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord - character(len=BUFSIZE) :: probeBoundsExtension - - character(len=BUFSIZE) :: chari, charj, chark - - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord - - #if CompileWithMPI - if (mpidir == 3) then - probeBoundsExtension = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) - elseif (mpidir == 2) then - probeBoundsExtension = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) - elseif (mpidir == 1) then - probeBoundsExtension = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) - else - call stoponerror(layoutnumber, size, 'Buggy error in mpidir. ') + if (any(this%domain%domainType=(/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + this%nFreq = this%domain%fnum + allocate (this%frequencySlice(this%domain%fnum)) + allocate (this%valueForFreq(this%domain%fnum)) end if - #else - probeBoundsExtension = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) - #endif - - return - end function get_probe_bounds_extension - - function get_prefix_extension(field, mpidir) result(prefixExtension) - integer(kind=SINGLE), intent(in) :: field, mpidir - character(len=BUFSIZE) :: prefixExtension - - #if CompileWithMPI - prefixExtension = get_rotated_prefix(field, mpidir) - #else - prefixExtension = prefix(field) - #endif - end function get_prefix_extension - - function get_rotated_prefix(field, mpidir) result(prefixExtension) - integer(kind=SINGLE), intent(in) :: field, mpidir - character(len=BUFSIZE) :: prefixExtension - if (mpidir == 3) then - select case (field) - case (iEx); prefixExtension = prefix(iEx) - case (iEy); prefixExtension = prefix(iEy) - case (iEz); prefixExtension = prefix(iEz) - case (iJx); prefixExtension = prefix(iJx) - case (iJy); prefixExtension = prefix(iJy) - case (iJz); prefixExtension = prefix(iJz) - case (iQx); prefixExtension = prefix(iQx) - case (iQy); prefixExtension = prefix(iQy) - case (iQz); prefixExtension = prefix(iQz) - case (iVx); prefixExtension = prefix(iVx) - case (iVy); prefixExtension = prefix(iVy) - case (iVz); prefixExtension = prefix(iVz) - case (iHx); prefixExtension = prefix(iHx) - case (iHy); prefixExtension = prefix(iHy) - case (iHz); prefixExtension = prefix(iHz) - case default; prefixExtension = prefix(field) - end select - elseif (mpidir == 2) then - select case (field) - case (iEx); prefixExtension = prefix(iEz) - case (iEy); prefixExtension = prefix(iEx) - case (iEz); prefixExtension = prefix(iEy) - case (iJx); prefixExtension = prefix(iJz) - case (iJy); prefixExtension = prefix(iJx) - case (iJz); prefixExtension = prefix(iJy) - case (iQx); prefixExtension = prefix(iQz) - case (iQy); prefixExtension = prefix(iQx) - case (iQz); prefixExtension = prefix(iQy) - case (iVx); prefixExtension = prefix(iVz) - case (iVy); prefixExtension = prefix(iVx) - case (iVz); prefixExtension = prefix(iVy) - case (iHx); prefixExtension = prefix(iHz) - case (iHy); prefixExtension = prefix(iHx) - case (iHz); prefixExtension = prefix(iHy) - case default; prefixExtension = prefix(field) - end select - elseif (mpidir == 1) then - select case (field) - case (iEx); prefixExtension = prefix(iEy) - case (iEy); prefixExtension = prefix(iEz) - case (iEz); prefixExtension = prefix(iEx) - case (iJx); prefixExtension = prefix(iJy) - case (iJy); prefixExtension = prefix(iJz) - case (iJz); prefixExtension = prefix(iJx) - case (iQx); prefixExtension = prefix(iQy) - case (iQy); prefixExtension = prefix(iQz) - case (iQz); prefixExtension = prefix(iQx) - case (iVx); prefixExtension = prefix(iVy) - case (iVy); prefixExtension = prefix(iVz) - case (iVz); prefixExtension = prefix(iVx) - case (iHx); prefixExtension = prefix(iHy) - case (iHy); prefixExtension = prefix(iHz) - case (iHz); prefixExtension = prefix(iHx) - case default; prefixExtension = prefix(field) - end select - else - call stoponerror(layoutnumber, size, 'Buggy error in mpidir. ') + + contains + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_probe_bounds_extension() + prefixFieldExtension = get_prefix_extension(field, mpidir) + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension)) + return + end function get_output_path + + function get_probe_bounds_extension() result(ext) + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + +#if CompileWithMPI + if (mpidir == 3) then + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + elseif (mpidir == 2) then + ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) + elseif (mpidir == 1) then + ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) + else + call stoponerror(layoutnumber, size, 'Buggy error in mpidir. ') + end if +#else + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) +#endif + + return + end function get_probe_bounds_extension + end subroutine init_point_probe_output + + subroutine update_point_probe_output(this, step) + type(point_probe_output_t), intent(inout) :: this + real(kind=RKIND), pointer, dimension(:, :, :) :: field + real(kind=RKIND_tiempo) :: step + + field => get_field_component(this%fieldComponent) + + if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + this%serializedTimeSize = this%serializedTimeSize + 1 + this%timeStep(this%serializedTimeSize) = step + this%valueForTime(this%serializedTimeSize) = field(i, j, k) end if - return - end function get_rotated_prefix - - function prefix(campo) result(ext) - integer(kind=SINGLE), intent(in) :: campo - character(len=BUFSIZE) :: ext - - select case (campo) - case (iEx); ext = 'Ex' - case (iEy); ext = 'Ey' - case (iEz); ext = 'Ez' - case (iVx); ext = 'Vx' - case (iVy); ext = 'Vy' - case (iVz); ext = 'Vz' - case (iHx); ext = 'Hx' - case (iHy); ext = 'Hy' - case (iHz); ext = 'Hz' - case (iBloqueJx); ext = 'Jx' - case (iBloqueJy); ext = 'Jy' - case (iBloqueJz); ext = 'Jz' - case (iBloqueMx); ext = 'Mx' - case (iBloqueMy); ext = 'My' - case (iBloqueMz); ext = 'Mz' - case (iJx); ext = 'Wx' - case (iJy); ext = 'Wy' - case (iJz); ext = 'Wz' - case (iQx); ext = 'Qx' - case (iQy); ext = 'Qy' - case (iQz); ext = 'Qz' - case (iExC); ext = 'ExC' - case (iEyC); ext = 'EyC' - case (iEzC); ext = 'EzC' - case (iHxC); ext = 'HxC' - case (iHyC); ext = 'HyC' - case (iHzC); ext = 'HzC' - case (iMEC); ext = 'ME' - case (iMHC); ext = 'MH' - case (iCur); ext = 'BC' - case (mapvtk); ext = 'MAP' - case (iCurX); ext = 'BCX' - case (iCurY); ext = 'BCY' - case (iCurZ); ext = 'BCZ' - case (farfield); ext = 'FF' - case (lineIntegral); ext = 'LI' - end select - return - end function prefix - - -end module output \ No newline at end of file + + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + do iter = 1, this%nFreq + this%valueForFreq(iter) = & + this%valueForFreq(iter) + field(i, j, k)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) + end do + end if + end subroutine update_point_probe_output + + subroutine flush_point_probe_output(this) + type(point_probe_output_t), intent(inout) :: this + + integer(kind=SINGLE) :: timeUnitFile, frequencyUnitFile, status + character(len=BUFSIZE) :: timeFileName, frequencyFileName + + if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + timeFileName = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) + timeUnitFile = FILE_UNIT + 1 + + status = open_file(timeUnitFile, timeFileName) + if (status /= 0) call stoponerror() + + do i = 1, this%serializedTimeSize + write (timeUnitFile, '(F12.4, 2X, F12.4)') this%timeStep(i), this%valueForTime(i) + end do + + status = close_file(timeUnitFile) + end if + + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + frequencyFileName = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) + frequencyUnitFile = FILE_UNIT + 2 + + OPEN (UNIT=frequencyUnitFile, FILE=frequencyFileName, STATUS='REPLACE', ACTION='WRITE', iostat=status) + if (status /= 0) call stoponerror() + + do i = 1, this%nFreq + write (frequencyUnitFile, '(F12.4, 2X, F12.4)') this%frequencySlice(i), this%valueForFreq(i) + end do + + status = close_file(frequencyUnitFile) + end if + end subroutine flush_point_probe_output + +end module output diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 new file mode 100644 index 00000000..34c3d263 --- /dev/null +++ b/src_output/outputUtils.F90 @@ -0,0 +1,147 @@ +module mod_outputUtils + use FDETYPES + implicit none + +contains + + function get_prefix_extension(field, mpidir) result(prefixExtension) + integer(kind=SINGLE), intent(in) :: field, mpidir + character(len=BUFSIZE) :: prefixExtension + +#if CompileWithMPI + prefixExtension = get_rotated_prefix(field, mpidir) +#else + prefixExtension = prefix(field) +#endif + end function get_prefix_extension + + function get_rotated_prefix(field, mpidir) result(prefixExtension) + integer(kind=SINGLE), intent(in) :: field, mpidir + character(len=BUFSIZE) :: prefixExtension + if (mpidir == 3) then + select case (field) + case (iEx); prefixExtension = prefix(iEx) + case (iEy); prefixExtension = prefix(iEy) + case (iEz); prefixExtension = prefix(iEz) + case (iJx); prefixExtension = prefix(iJx) + case (iJy); prefixExtension = prefix(iJy) + case (iJz); prefixExtension = prefix(iJz) + case (iQx); prefixExtension = prefix(iQx) + case (iQy); prefixExtension = prefix(iQy) + case (iQz); prefixExtension = prefix(iQz) + case (iVx); prefixExtension = prefix(iVx) + case (iVy); prefixExtension = prefix(iVy) + case (iVz); prefixExtension = prefix(iVz) + case (iHx); prefixExtension = prefix(iHx) + case (iHy); prefixExtension = prefix(iHy) + case (iHz); prefixExtension = prefix(iHz) + case default; prefixExtension = prefix(field) + end select + elseif (mpidir == 2) then + select case (field) + case (iEx); prefixExtension = prefix(iEz) + case (iEy); prefixExtension = prefix(iEx) + case (iEz); prefixExtension = prefix(iEy) + case (iJx); prefixExtension = prefix(iJz) + case (iJy); prefixExtension = prefix(iJx) + case (iJz); prefixExtension = prefix(iJy) + case (iQx); prefixExtension = prefix(iQz) + case (iQy); prefixExtension = prefix(iQx) + case (iQz); prefixExtension = prefix(iQy) + case (iVx); prefixExtension = prefix(iVz) + case (iVy); prefixExtension = prefix(iVx) + case (iVz); prefixExtension = prefix(iVy) + case (iHx); prefixExtension = prefix(iHz) + case (iHy); prefixExtension = prefix(iHx) + case (iHz); prefixExtension = prefix(iHy) + case default; prefixExtension = prefix(field) + end select + elseif (mpidir == 1) then + select case (field) + case (iEx); prefixExtension = prefix(iEy) + case (iEy); prefixExtension = prefix(iEz) + case (iEz); prefixExtension = prefix(iEx) + case (iJx); prefixExtension = prefix(iJy) + case (iJy); prefixExtension = prefix(iJz) + case (iJz); prefixExtension = prefix(iJx) + case (iQx); prefixExtension = prefix(iQy) + case (iQy); prefixExtension = prefix(iQz) + case (iQz); prefixExtension = prefix(iQx) + case (iVx); prefixExtension = prefix(iVy) + case (iVy); prefixExtension = prefix(iVz) + case (iVz); prefixExtension = prefix(iVx) + case (iHx); prefixExtension = prefix(iHy) + case (iHy); prefixExtension = prefix(iHz) + case (iHz); prefixExtension = prefix(iHx) + case default; prefixExtension = prefix(field) + end select + else + call stoponerror(layoutnumber, size, 'Buggy error in mpidir. ') + end if + return + end function get_rotated_prefix + + function prefix(campo) result(ext) + integer(kind=SINGLE), intent(in) :: campo + character(len=BUFSIZE) :: ext + + select case (campo) + case (iEx); ext = 'Ex' + case (iEy); ext = 'Ey' + case (iEz); ext = 'Ez' + case (iVx); ext = 'Vx' + case (iVy); ext = 'Vy' + case (iVz); ext = 'Vz' + case (iHx); ext = 'Hx' + case (iHy); ext = 'Hy' + case (iHz); ext = 'Hz' + case (iBloqueJx); ext = 'Jx' + case (iBloqueJy); ext = 'Jy' + case (iBloqueJz); ext = 'Jz' + case (iBloqueMx); ext = 'Mx' + case (iBloqueMy); ext = 'My' + case (iBloqueMz); ext = 'Mz' + case (iJx); ext = 'Wx' + case (iJy); ext = 'Wy' + case (iJz); ext = 'Wz' + case (iQx); ext = 'Qx' + case (iQy); ext = 'Qy' + case (iQz); ext = 'Qz' + case (iExC); ext = 'ExC' + case (iEyC); ext = 'EyC' + case (iEzC); ext = 'EzC' + case (iHxC); ext = 'HxC' + case (iHyC); ext = 'HyC' + case (iHzC); ext = 'HzC' + case (iMEC); ext = 'ME' + case (iMHC); ext = 'MH' + case (iCur); ext = 'BC' + case (mapvtk); ext = 'MAP' + case (iCurX); ext = 'BCX' + case (iCurY); ext = 'BCY' + case (iCurZ); ext = 'BCZ' + case (farfield); ext = 'FF' + case (lineIntegral); ext = 'LI' + end select + return + end function prefix + + function open_file(fileUnit, fileName) result(iostat) + character(len=*), intent(in) :: fileName + integer(kind=SINGLE), intent(in) :: fileUnit + integer(kind=SINGLE) :: iostat + + open (unit=fileUnit, file=fileName status='OLD', action='WRITE', possition='APPEND', iostat=iostat) + if (iostat /= 0) then + open (unit=fileUnit, file=fileName status='NEW', action='WRITE', iostat=iostat) + end if + return + end function open_file + + function close_file(fileUnit) result(iostat) + integer(kind=SINGLE), intent(in) :: fileUnit + integer(kind=SINGLE) :: iostat + + close (fileUnit, iostat=iostat) + end function close_file +end module mod_outputUtils From 5aa7cf0f6e529767f38a79e217f1ecd977c4e9fd Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 27 Nov 2025 13:09:51 +0100 Subject: [PATCH 03/67] Compilation fixes --- CMakeLists.txt | 2 + src_output/CMakeLists.txt | 6 +++ src_output/domain.F90 | 13 +++--- src_output/output.F90 | 89 +++++++++++++++++++++----------------- src_output/outputUtils.F90 | 24 ++++++++-- 5 files changed, 87 insertions(+), 47 deletions(-) create mode 100644 src_output/CMakeLists.txt diff --git a/CMakeLists.txt b/CMakeLists.txt index 099f912f..d7af112c 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -191,6 +191,8 @@ if (SEMBA_FDTD_ENABLE_TEST) add_subdirectory(test) endif() +add_subdirectory(src_output) + if(SEMBA_FDTD_COMPONENTS_LIB) add_library(semba-components "src_main_pub/anisotropic.F90" diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt new file mode 100644 index 00000000..8792cba2 --- /dev/null +++ b/src_output/CMakeLists.txt @@ -0,0 +1,6 @@ +add_library(fdtd-output + "output.F90" + "domain.F90" + "outputUtils.F90" +) +target_link_libraries(fdtd-output semba-types ) \ No newline at end of file diff --git a/src_output/domain.F90 b/src_output/domain.F90 index 9363334b..eaa63251 100644 --- a/src_output/domain.F90 +++ b/src_output/domain.F90 @@ -7,16 +7,15 @@ module mod_domain integer, parameter :: FREQUENCY_DOMAIN = 1 integer, parameter :: BOTH_DOMAIN = 2 - ! Definición del tipo derivado + interface domain_t + module procedure new_domain_time, new_domain_freq, new_domain_both + end interface domain_t type :: domain_t real(kind=RKIND_tiempo) :: tstart = 0.0_RKIND_tiempo, tstop = 0.0_RKIND_tiempo, tstep = 0.0_RKIND_tiempo - real(kind=RKIND) :: fstart = 0.0_RKIND, fstop = 0.0_RKIND + real(kind=RKIND) :: fstart = 0.0_RKIND, fstop = 0.0_RKIND, fstep integer(kind=SINGLE) :: fnum = 0 integer(kind=SINGLE) :: domainType = UNDEFINED_DOMAIN logical :: logarithmicSpacing = .false. - - contains - generic :: domain_t => new_domain_time, new_domain_freq, new_domain_both end type domain_t contains @@ -39,6 +38,8 @@ function new_domain_freq(fstart, fstop, fnum, logarithmicSpacing) result(new_dom new_domain%fstart = fstart new_domain%fstop = fstop new_domain%fnum = fnum + new_domain%fstep = (fstop - fstart) / fnum + new_domain%domainType = FREQUENCY_DOMAIN if (present(logarithmicSpacing)) then @@ -60,6 +61,8 @@ function new_domain_both(tstart, tstop, tstep, fstart, fstop, fnum, logarithmicS new_domain%fstart = fstart new_domain%fstop = fstop new_domain%fnum = fnum + new_domain%fstep = (fstop - fstart) / fnum + new_domain%domainType = BOTH_DOMAIN if (present(logarithmicSpacing)) then diff --git a/src_output/output.F90 b/src_output/output.F90 index 95ed06ad..50c87de7 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -4,15 +4,15 @@ module output use mod_outputUtils implicit none character(len=4) :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' - integer(kind=SINGLE) :: MAX_SERIALIZED_COUNT = 500, FILE_UNIT = 400 + integer(kind=SINGLE), parameter :: MAX_SERIALIZED_COUNT = 500, FILE_UNIT = 400 type solver_output_t type(point_probe_output_t), allocatable :: pointProbe - type(wire_probe_output_t), allocatable :: wireProbe - type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe - type(far_field_t), allocatable :: farField - type(time_movie_output_t), allocatable :: timeMovie - type(frequency_slice_output_t), allocatable :: frequencySlice + !type(wire_probe_output_t), allocatable :: wireProbe + !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe + !type(far_field_t), allocatable :: farField + !type(time_movie_output_t), allocatable :: timeMovie + !type(frequency_slice_output_t), allocatable :: frequencySlice end type solver_output_t type point_probe_output_t @@ -22,50 +22,50 @@ module output character(len=BUFSIZE) :: path integer(kind=SINGLE) :: fieldComponent integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE, nFreq = 0_SINGLE - real(kind=RKIND_tiempo), dimension(MAX_SERIALIZED_COUNT), allocatable :: timeStep - real(kind=RKIND), dimension(MAX_SERIALIZED_COUNT), allocatable :: valueForTime + real(kind=RKIND_tiempo), dimension(MAX_SERIALIZED_COUNT) :: timeStep + real(kind=RKIND), dimension(MAX_SERIALIZED_COUNT) :: valueForTime real(kind=RKIND), dimension(:), allocatable :: frequencySlice real(kind=CKIND), dimension(:), allocatable :: valueForFreq end type point_probe_output_t interface init_solver_output module procedure & - init_point_probe_output, & - init_wire_probe_output, & - init_bulk_current_probe_output, & - init_far_field, & - initime_movie_output, & - init_frequency_slice_output + init_point_probe_output + !init_wire_probe_output, & + !init_bulk_current_probe_output, & + !init_far_field, & + !initime_movie_output, & + !init_frequency_slice_output end interface interface update_solver_output module procedure & - update_point_probe_output, & - update_wire_probe_output, & - update_bulk_current_probe_output, & - update_far_field, & - updateime_movie_output, & - update_frequency_slice_output + update_point_probe_output + !update_wire_probe_output, & + !update_bulk_current_probe_output, & + !update_far_field, & + !updateime_movie_output, & + !update_frequency_slice_output end interface interface flush_solver_output module procedure & - flush_point_probe_output, & - flush_wire_probe_output, & - flush_bulk_current_probe_output, & - flush_far_field, & - flushime_movie_output, & - flush_frequency_slice_output + flush_point_probe_output + !flush_wire_probe_output, & + !flush_bulk_current_probe_output, & + !flush_far_field, & + !flushime_movie_output, & + !flush_frequency_slice_output end interface interface delete_solver_output module procedure & - delete_point_probe_output, & - delete_wire_probe_output, & - delete_bulk_current_probe_output, & - delete_far_field, & - deleteime_movie_output, & - delete_frequency_slice_output + delete_point_probe_output + !delete_wire_probe_output, & + !delete_bulk_current_probe_output, & + !delete_far_field, & + !deleteime_movie_output, & + !delete_frequency_slice_output end interface contains @@ -77,18 +77,23 @@ subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, type(domain_t), intent(in) :: domain character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + integer(kind=SINGLE) :: i this%xCoord = iCoord this%yCoord = jCoord this%zCoord = kCoord this%domain = domain - this%path = get_output_path(outputTypeExtension, iCoord, jCoord, kCoord, field, mpidir) + this%path = get_output_path() - if (any(this%domain%domainType=(/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + if (any(this%domain%domainType==(/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then this%nFreq = this%domain%fnum allocate (this%frequencySlice(this%domain%fnum)) allocate (this%valueForFreq(this%domain%fnum)) + do i = 1, this%nFreq + call init_frequency_slice(this%frequencySlice, this%domain) + end do + this%valueForFreq = (0.0_RKIND, 0.0_RKIND) end if contains @@ -117,7 +122,7 @@ function get_probe_bounds_extension() result(ext) elseif (mpidir == 1) then ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) else - call stoponerror(layoutnumber, size, 'Buggy error in mpidir. ') + call stoponerror('Buggy error in mpidir. ') end if #else ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) @@ -131,19 +136,20 @@ subroutine update_point_probe_output(this, step) type(point_probe_output_t), intent(inout) :: this real(kind=RKIND), pointer, dimension(:, :, :) :: field real(kind=RKIND_tiempo) :: step + integer(kind=SINGLE) :: iter field => get_field_component(this%fieldComponent) if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then this%serializedTimeSize = this%serializedTimeSize + 1 this%timeStep(this%serializedTimeSize) = step - this%valueForTime(this%serializedTimeSize) = field(i, j, k) + this%valueForTime(this%serializedTimeSize) = field(this%xCoord, this%yCoord, this%zCoord) end if if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then do iter = 1, this%nFreq this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(i, j, k)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) + this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) end do end if end subroutine update_point_probe_output @@ -153,13 +159,14 @@ subroutine flush_point_probe_output(this) integer(kind=SINGLE) :: timeUnitFile, frequencyUnitFile, status character(len=BUFSIZE) :: timeFileName, frequencyFileName + integer(kind=SINGLE) :: i if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then timeFileName = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) timeUnitFile = FILE_UNIT + 1 status = open_file(timeUnitFile, timeFileName) - if (status /= 0) call stoponerror() + if (status /= 0) call stoponerror('Failed to open timeDomainFile. ') do i = 1, this%serializedTimeSize write (timeUnitFile, '(F12.4, 2X, F12.4)') this%timeStep(i), this%valueForTime(i) @@ -173,7 +180,7 @@ subroutine flush_point_probe_output(this) frequencyUnitFile = FILE_UNIT + 2 OPEN (UNIT=frequencyUnitFile, FILE=frequencyFileName, STATUS='REPLACE', ACTION='WRITE', iostat=status) - if (status /= 0) call stoponerror() + if (status /= 0) call stoponerror('Failed to open frequencyDomainFile. ') do i = 1, this%nFreq write (frequencyUnitFile, '(F12.4, 2X, F12.4)') this%frequencySlice(i), this%valueForFreq(i) @@ -183,4 +190,8 @@ subroutine flush_point_probe_output(this) end if end subroutine flush_point_probe_output + subroutine delete_point_probe_output() + + end subroutine delete_point_probe_output + end module output diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 34c3d263..d0c602f4 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -1,5 +1,6 @@ module mod_outputUtils use FDETYPES + use mod_domain implicit none contains @@ -76,7 +77,7 @@ function get_rotated_prefix(field, mpidir) result(prefixExtension) case default; prefixExtension = prefix(field) end select else - call stoponerror(layoutnumber, size, 'Buggy error in mpidir. ') + call stoponerror('Buggy error in mpidir. ') end if return end function get_rotated_prefix @@ -131,9 +132,9 @@ function open_file(fileUnit, fileName) result(iostat) integer(kind=SINGLE), intent(in) :: fileUnit integer(kind=SINGLE) :: iostat - open (unit=fileUnit, file=fileName status='OLD', action='WRITE', possition='APPEND', iostat=iostat) + open (unit=fileUnit, file=fileName, status='OLD', action='WRITE', position='APPEND', iostat=iostat) if (iostat /= 0) then - open (unit=fileUnit, file=fileName status='NEW', action='WRITE', iostat=iostat) + open (unit=fileUnit, file=fileName, status='NEW', action='WRITE', iostat=iostat) end if return end function open_file @@ -144,4 +145,21 @@ function close_file(fileUnit) result(iostat) close (fileUnit, iostat=iostat) end function close_file + + subroutine init_frequency_slice(frequencySlice, domain) + real(kind=RKIND), dimension(:), intent(out) :: frequencySlice + type(domain_t), intent(in) :: domain + + integer(kind=SINGLE) :: i + + if (domain%logarithmicSpacing) then + do i = 1, domain%fnum + frequencySlice(i) = 10.0_RKIND ** (domain%fstart + (i - 1) * domain%fstep) + end do + else + do i=1, domain%fnum + frequencySlice(i) = domain%fstart + (i-1) * domain%fstep + end do + end if + end subroutine init_frequency_slice end module mod_outputUtils From 69a43526ce10ad67ea427b31b341475f125678dd Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 27 Nov 2025 15:21:40 +0100 Subject: [PATCH 04/67] Start Init outputs subroutine --- src_output/output.F90 | 132 ++++++++++++++++++++++++++++++++++-------- 1 file changed, 108 insertions(+), 24 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index 50c87de7..4f37d0c6 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -6,7 +6,10 @@ module output character(len=4) :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' integer(kind=SINGLE), parameter :: MAX_SERIALIZED_COUNT = 500, FILE_UNIT = 400 + integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0 + type solver_output_t + integer(kind=SINGLE) :: outputID type(point_probe_output_t), allocatable :: pointProbe !type(wire_probe_output_t), allocatable :: wireProbe !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe @@ -31,44 +34,125 @@ module output interface init_solver_output module procedure & init_point_probe_output - !init_wire_probe_output, & - !init_bulk_current_probe_output, & - !init_far_field, & - !initime_movie_output, & - !init_frequency_slice_output + !init_wire_probe_output, & + !init_bulk_current_probe_output, & + !init_far_field, & + !initime_movie_output, & + !init_frequency_slice_output end interface interface update_solver_output module procedure & update_point_probe_output - !update_wire_probe_output, & - !update_bulk_current_probe_output, & - !update_far_field, & - !updateime_movie_output, & - !update_frequency_slice_output + !update_wire_probe_output, & + !update_bulk_current_probe_output, & + !update_far_field, & + !updateime_movie_output, & + !update_frequency_slice_output end interface interface flush_solver_output module procedure & flush_point_probe_output - !flush_wire_probe_output, & - !flush_bulk_current_probe_output, & - !flush_far_field, & - !flushime_movie_output, & - !flush_frequency_slice_output + !flush_wire_probe_output, & + !flush_bulk_current_probe_output, & + !flush_far_field, & + !flushime_movie_output, & + !flush_frequency_slice_output end interface interface delete_solver_output module procedure & delete_point_probe_output - !delete_wire_probe_output, & - !delete_bulk_current_probe_output, & - !delete_far_field, & - !deleteime_movie_output, & - !delete_frequency_slice_output + !delete_wire_probe_output, & + !delete_bulk_current_probe_output, & + !delete_far_field, & + !deleteime_movie_output, & + !delete_frequency_slice_output end interface contains + subroutine init_outputs(sgg, control, outputs) + type(SGGFDTDINFO), intent(in) :: sgg + type(sim_control_t), intent(inout) :: control + type(solver_output_t), dimension(:), intent(out) :: outputs + + integer(kind=SINGLE) :: outputCount = 0 + allocate (outputs(sgg%NumberRequest)) + + do ii = 1, sgg%NumberRequest + do i = 1, sgg%Observation(ii)%nP + I1 = sgg%observation(ii)%P(i)%XI + J1 = sgg%observation(ii)%P(i)%YI + K1 = sgg%observation(ii)%P(i)%ZI + + field = sgg%observation(ii)%P(i)%what + select case (field) + case (iEx, iEy, iEz, iVx, iVy, iVz, iJx, iJy, iJz, iQx, iQy, iQz, iHx, iHy, iHz, lineIntegral) + outputCount = outputCount + 1 + + outputs(outputCount)%outputID = POINT_PROBE_ID + + domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, finaltimestep) + + outputTypeExtension = trim(adjustl(nEntradaRoot))//'_'//trim(adjustl(sgg%observation(ii)%outputrequest)) + + allocate (outputs(outputCount)%pointProbe) + init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, field, domain, outputTypeExtension, mpidir) + case default + call stoponerror('Field type not implemented yet on new observations') + end select + end do + end do + return + contains + function preprocess_domain(observation, timeArray, timeStep, finalStepIndex) result(newDomain) + type(Obses_t), intent(in) :: observation + real(kind=RKIND_tiempo), pointer, dimension(:), intent(in) :: timeArray + real(kind=RKIND_tiempo), intent(in) :: timeStep + integer(kind=4), intent(in) :: finalStepIndex + type(domain_t) :: newDomain + + integer(kind=SINGLE) :: nFreq + + if (observation%TimeDomain) then + newdomain = domain_t(observation%InitialTime, observation%FinalTime, observation%TimeStep) + + newdomain%tstep = max(newdomain%tstep, timeStep) + + if (10.0_RKIND*(newdomain%tstop - newdomain%tstart)/min(timeStep, newdomain%tstep) >= huge(1_4)) then + newdomain%tstop = newdomain%tstart + min(timeStep, newdomain%tstep)*huge(1_4)/10.0_RKIND + end if + + if (newDomain%tstart < newDomain%tstep) then + newDomain%tstart = 0.0_RKIND_tiempo + end if + + if (newDomain%tstep > (newdomain%tstop - newdomain%tstart)) then + newDomain%tstop = newDomain%tstart + newDomain%tstep + end if + + elseif (observation%FreqDomain) then + !Just linear progression for now. Need to bring logartihmic info to here + nFreq = int((observation%FinalFreq - observation%InitialFreq) / observation%FreqStep, kind=SINGLE) + newdomain = domain_t(observation%InitialFreq, observation%FinalFreq, nFreq, logarithmicspacing=.false.) + + newDomain%fstep = min(newDomain%fstep, 2.0_RKIND/dt) + if ((newDomain%fstep > newDomain%fstop - newDomain%fstart) .or. (newDomain%fstep == 0)) then + newDomain%fstep = newDomain%fstop - newDomain%fstart + newDomain%fstop = newDomain%fstart + observation%fstep + end if + + newDomain%fnum = int((newDomain%fstop - newDomain%fstart) / newDomain%fstep, kind=SINGLE) + + else + call stoponerror('No domain present') + end if + return + end function preprocess_domain + + end subroutine init_observations + subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, outputTypeExtension, mpidir) type(point_probe_output_t), intent(out) :: this integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord @@ -86,14 +170,14 @@ subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, this%domain = domain this%path = get_output_path() - if (any(this%domain%domainType==(/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then this%nFreq = this%domain%fnum allocate (this%frequencySlice(this%domain%fnum)) allocate (this%valueForFreq(this%domain%fnum)) do i = 1, this%nFreq - call init_frequency_slice(this%frequencySlice, this%domain) + call init_frequency_slice(this%frequencySlice, this%domain) end do - this%valueForFreq = (0.0_RKIND, 0.0_RKIND) + this%valueForFreq = (0.0_RKIND, 0.0_RKIND) end if contains @@ -149,7 +233,7 @@ subroutine update_point_probe_output(this, step) if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then do iter = 1, this%nFreq this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) + this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) end do end if end subroutine update_point_probe_output From c8cceb6c7469aea3c23a79c781569c75bd5ab57c Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 28 Nov 2025 08:20:59 +0100 Subject: [PATCH 05/67] Create update structure --- src_output/output.F90 | 65 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 57 insertions(+), 8 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index 4f37d0c6..1c2ad132 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -153,6 +153,54 @@ end function preprocess_domain end subroutine init_observations + subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh) + type(solver_output_t), dimension(:), intent(inout) :: outputs + real(kind=RKIND_tiempo) :: step + integer(kind=SINGLE) :: i, id + + + REAL(KIND=RKIND), intent(in), target :: & + Ex(sgg%alloc(iEx)%XI:sgg%alloc(iEx)%XE, sgg%alloc(iEx)%YI:sgg%alloc(iEx)%YE, sgg%alloc(iEx)%ZI:sgg%alloc(iEx)%ZE), & + Ey(sgg%alloc(iEy)%XI:sgg%alloc(iEy)%XE, sgg%alloc(iEy)%YI:sgg%alloc(iEy)%YE, sgg%alloc(iEy)%ZI:sgg%alloc(iEy)%ZE), & + Ez(sgg%alloc(iEz)%XI:sgg%alloc(iEz)%XE, sgg%alloc(iEz)%YI:sgg%alloc(iEz)%YE, sgg%alloc(iEz)%ZI:sgg%alloc(iEz)%ZE), & + Hx(sgg%alloc(iHx)%XI:sgg%alloc(iHx)%XE, sgg%alloc(iHx)%YI:sgg%alloc(iHx)%YE, sgg%alloc(iHx)%ZI:sgg%alloc(iHx)%ZE), & + Hy(sgg%alloc(iHy)%XI:sgg%alloc(iHy)%XE, sgg%alloc(iHy)%YI:sgg%alloc(iHy)%YE, sgg%alloc(iHy)%ZI:sgg%alloc(iHy)%ZE), & + Hz(sgg%alloc(iHz)%XI:sgg%alloc(iHz)%XE, sgg%alloc(iHz)%YI:sgg%alloc(iHz)%YE, sgg%alloc(iHz)%ZI:sgg%alloc(iHz)%ZE) + !---> + REAL(KIND=RKIND), dimension(:), intent(in) :: dxh(sgg%ALLOC(iEx)%XI:sgg%ALLOC(iEx)%XE), & + dyh(sgg%ALLOC(iEy)%YI:sgg%ALLOC(iEy)%YE), & + dzh(sgg%ALLOC(iEz)%ZI:sgg%ALLOC(iEz)%ZE), & + dxe(sgg%alloc(iHx)%XI:sgg%alloc(iHx)%XE), & + dye(sgg%alloc(iHy)%YI:sgg%alloc(iHy)%YE), & + dze(sgg%alloc(iHz)%ZI:sgg%alloc(iHz)%ZE) + + + do i = 1, size(outputs) + id = outputs(i)%outputID + select case(id) + case(POINT_PROBE_ID) + field => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos + update_solver_output(outputs(i)%pointProbe, step, field) + case default + call stoponerror('Output update not implemented') + end select + end do + + contains + function get_field_component(fieldId) result(field) + integer(kind=SINGLE), intent(in) :: fieldId + select case(fieldId) + case(iEx); field => Ex + case(iEy); field => Ey + case(iEz); field => Ez + case(iHx); field => Hx + case(iHy); field => Hy + case(iHz); field => Hz + end select + end function get_field_component + + end subroutine update_outputs + subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, outputTypeExtension, mpidir) type(point_probe_output_t), intent(out) :: this integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord @@ -198,7 +246,7 @@ function get_probe_bounds_extension() result(ext) write (charj, '(i7)') jCoord write (chark, '(i7)') kCoord -#if CompileWithMPI + #if CompileWithMPI if (mpidir == 3) then ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) elseif (mpidir == 2) then @@ -208,22 +256,23 @@ function get_probe_bounds_extension() result(ext) else call stoponerror('Buggy error in mpidir. ') end if -#else + #else ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) -#endif + #endif return end function get_probe_bounds_extension end subroutine init_point_probe_output - subroutine update_point_probe_output(this, step) + subroutine + + + subroutine update_point_probe_output(this, step, field) type(point_probe_output_t), intent(inout) :: this real(kind=RKIND), pointer, dimension(:, :, :) :: field real(kind=RKIND_tiempo) :: step integer(kind=SINGLE) :: iter - field => get_field_component(this%fieldComponent) - if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then this%serializedTimeSize = this%serializedTimeSize + 1 this%timeStep(this%serializedTimeSize) = step @@ -233,7 +282,7 @@ subroutine update_point_probe_output(this, step) if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then do iter = 1, this%nFreq this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) + this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) end do end if end subroutine update_point_probe_output @@ -275,7 +324,7 @@ subroutine flush_point_probe_output(this) end subroutine flush_point_probe_output subroutine delete_point_probe_output() - + !TODO end subroutine delete_point_probe_output end module output From 52c62e911fdd32b6a8afb608c65034a491098e98 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 28 Nov 2025 11:59:38 +0100 Subject: [PATCH 06/67] Added init wire current probes --- src_output/output.F90 | 230 ++++++++++++++++++++++++++++++++++++------ 1 file changed, 197 insertions(+), 33 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index 1c2ad132..2a1f0a37 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -2,16 +2,19 @@ module output use FDETYPES use mod_domain use mod_outputUtils + + use wiresHolland_constants + use HollandWires implicit none character(len=4) :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' - integer(kind=SINGLE), parameter :: MAX_SERIALIZED_COUNT = 500, FILE_UNIT = 400 + integer(kind=SINGLE), parameter :: FILE_UNIT = 400 integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0 type solver_output_t integer(kind=SINGLE) :: outputID type(point_probe_output_t), allocatable :: pointProbe - !type(wire_probe_output_t), allocatable :: wireProbe + type(wire_current_probe_output_t), allocatable :: wireProbe !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !type(far_field_t), allocatable :: farField !type(time_movie_output_t), allocatable :: timeMovie @@ -19,18 +22,38 @@ module output end type solver_output_t type point_probe_output_t - integer(kind=SINGLE) :: columnas = 2_SINGLE + integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field type(domain_t) :: domain integer(kind=SINGLE) :: xCoord, yCoord, zCoord character(len=BUFSIZE) :: path integer(kind=SINGLE) :: fieldComponent integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE, nFreq = 0_SINGLE - real(kind=RKIND_tiempo), dimension(MAX_SERIALIZED_COUNT) :: timeStep - real(kind=RKIND), dimension(MAX_SERIALIZED_COUNT) :: valueForTime + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND + real(kind=RKIND), dimension(:), allocatable :: frequencySlice real(kind=CKIND), dimension(:), allocatable :: valueForFreq end type point_probe_output_t + type wire_current_probe_output_t + integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: currentComponent + integer(kind=SINGLE) :: sign = +1 + type(CurrentSegments), pointer :: segment + + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + type(current_values_t), dimension(BuffObse) :: currentValues + end type wire_current_probe_output_t + + type current_values_t + real(kind=RKIND) :: current = 0.0_RKIND, deltaVoltage = 0.0_RKIND + real(kind=RKIND) :: plusVoltage = 0.0_RKIND, minusVoltage = 0.0_RKIND, voltageDiference = 0.0_RKIND + end type + interface init_solver_output module procedure & init_point_probe_output @@ -134,7 +157,7 @@ function preprocess_domain(observation, timeArray, timeStep, finalStepIndex) res elseif (observation%FreqDomain) then !Just linear progression for now. Need to bring logartihmic info to here - nFreq = int((observation%FinalFreq - observation%InitialFreq) / observation%FreqStep, kind=SINGLE) + nFreq = int((observation%FinalFreq - observation%InitialFreq)/observation%FreqStep, kind=SINGLE) newdomain = domain_t(observation%InitialFreq, observation%FinalFreq, nFreq, logarithmicspacing=.false.) newDomain%fstep = min(newDomain%fstep, 2.0_RKIND/dt) @@ -143,7 +166,7 @@ function preprocess_domain(observation, timeArray, timeStep, finalStepIndex) res newDomain%fstop = newDomain%fstart + observation%fstep end if - newDomain%fnum = int((newDomain%fstop - newDomain%fstart) / newDomain%fstep, kind=SINGLE) + newDomain%fnum = int((newDomain%fstop - newDomain%fstart)/newDomain%fstep, kind=SINGLE) else call stoponerror('No domain present') @@ -158,14 +181,13 @@ subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, real(kind=RKIND_tiempo) :: step integer(kind=SINGLE) :: i, id - REAL(KIND=RKIND), intent(in), target :: & - Ex(sgg%alloc(iEx)%XI:sgg%alloc(iEx)%XE, sgg%alloc(iEx)%YI:sgg%alloc(iEx)%YE, sgg%alloc(iEx)%ZI:sgg%alloc(iEx)%ZE), & - Ey(sgg%alloc(iEy)%XI:sgg%alloc(iEy)%XE, sgg%alloc(iEy)%YI:sgg%alloc(iEy)%YE, sgg%alloc(iEy)%ZI:sgg%alloc(iEy)%ZE), & - Ez(sgg%alloc(iEz)%XI:sgg%alloc(iEz)%XE, sgg%alloc(iEz)%YI:sgg%alloc(iEz)%YE, sgg%alloc(iEz)%ZI:sgg%alloc(iEz)%ZE), & - Hx(sgg%alloc(iHx)%XI:sgg%alloc(iHx)%XE, sgg%alloc(iHx)%YI:sgg%alloc(iHx)%YE, sgg%alloc(iHx)%ZI:sgg%alloc(iHx)%ZE), & - Hy(sgg%alloc(iHy)%XI:sgg%alloc(iHy)%XE, sgg%alloc(iHy)%YI:sgg%alloc(iHy)%YE, sgg%alloc(iHy)%ZI:sgg%alloc(iHy)%ZE), & - Hz(sgg%alloc(iHz)%XI:sgg%alloc(iHz)%XE, sgg%alloc(iHz)%YI:sgg%alloc(iHz)%YE, sgg%alloc(iHz)%ZI:sgg%alloc(iHz)%ZE) + Ex(sgg%alloc(iEx)%XI:sgg%alloc(iEx)%XE, sgg%alloc(iEx)%YI:sgg%alloc(iEx)%YE, sgg%alloc(iEx)%ZI:sgg%alloc(iEx)%ZE), & + Ey(sgg%alloc(iEy)%XI:sgg%alloc(iEy)%XE, sgg%alloc(iEy)%YI:sgg%alloc(iEy)%YE, sgg%alloc(iEy)%ZI:sgg%alloc(iEy)%ZE), & + Ez(sgg%alloc(iEz)%XI:sgg%alloc(iEz)%XE, sgg%alloc(iEz)%YI:sgg%alloc(iEz)%YE, sgg%alloc(iEz)%ZI:sgg%alloc(iEz)%ZE), & + Hx(sgg%alloc(iHx)%XI:sgg%alloc(iHx)%XE, sgg%alloc(iHx)%YI:sgg%alloc(iHx)%YE, sgg%alloc(iHx)%ZI:sgg%alloc(iHx)%ZE), & + Hy(sgg%alloc(iHy)%XI:sgg%alloc(iHy)%XE, sgg%alloc(iHy)%YI:sgg%alloc(iHy)%YE, sgg%alloc(iHy)%ZI:sgg%alloc(iHy)%ZE), & + Hz(sgg%alloc(iHz)%XI:sgg%alloc(iHz)%XE, sgg%alloc(iHz)%YI:sgg%alloc(iHz)%YE, sgg%alloc(iHz)%ZI:sgg%alloc(iHz)%ZE) !---> REAL(KIND=RKIND), dimension(:), intent(in) :: dxh(sgg%ALLOC(iEx)%XI:sgg%ALLOC(iEx)%XE), & dyh(sgg%ALLOC(iEy)%YI:sgg%ALLOC(iEy)%YE), & @@ -174,11 +196,10 @@ subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dye(sgg%alloc(iHy)%YI:sgg%alloc(iHy)%YE), & dze(sgg%alloc(iHz)%ZI:sgg%alloc(iHz)%ZE) - do i = 1, size(outputs) id = outputs(i)%outputID - select case(id) - case(POINT_PROBE_ID) + select case (id) + case (POINT_PROBE_ID) field => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos update_solver_output(outputs(i)%pointProbe, step, field) case default @@ -186,17 +207,17 @@ subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, end select end do - contains + contains function get_field_component(fieldId) result(field) - integer(kind=SINGLE), intent(in) :: fieldId - select case(fieldId) - case(iEx); field => Ex - case(iEy); field => Ey - case(iEz); field => Ez - case(iHx); field => Hx - case(iHy); field => Hy - case(iHz); field => Hz - end select + integer(kind=SINGLE), intent(in) :: fieldId + select case (fieldId) + case (iEx); field => Ex + case (iEy); field => Ey + case (iEz); field => Ez + case (iHx); field => Hx + case (iHy); field => Hy + case (iHz); field => Hz + end select end function get_field_component end subroutine update_outputs @@ -215,6 +236,8 @@ subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, this%yCoord = jCoord this%zCoord = kCoord + this%fieldComponent = field + this%domain = domain this%path = get_output_path() @@ -246,7 +269,7 @@ function get_probe_bounds_extension() result(ext) write (charj, '(i7)') jCoord write (chark, '(i7)') kCoord - #if CompileWithMPI +#if CompileWithMPI if (mpidir == 3) then ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) elseif (mpidir == 2) then @@ -256,16 +279,157 @@ function get_probe_bounds_extension() result(ext) else call stoponerror('Buggy error in mpidir. ') end if - #else +#else ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) - #endif +#endif return end function get_probe_bounds_extension end subroutine init_point_probe_output - subroutine - + subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, outputTypeExtension, wiresFlavor) + type(wire_current_probe_output_t), intent(out) :: this + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node + integer(kind=SINGLE), intent(in) :: field + character(len=BUFSIZE), intent(in) :: outputTypeExtension + character(len=*), intent(in) :: wiresFlavor + type(domain_t), intent(in) :: domain + + this%xCoord = iCoord + this%yCoord = jCoord + this%zCoord = kCoord + + this%currentComponent = field + + this%domain = domain + this%path = get_output_path() + + call find_segment() + + contains + subroutine find_segment() + integer(kind=SINGLE) :: n + type(CurrentSegments), pointer :: currentSegment + logical :: found = .false. + + if (ThereAreWires) then + select case (trim(adjustl(wiresFlavor))) + case ('holland', 'transition') + this%segment => HWireslocal%NullSegment + do n = 1, HWireslocal%NumCurrentSegments + currentSegment => HWireslocal%CurrentSegment(n) + if ((currentSegment%origindex == no) .and. & + (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & + (currentSegment%tipofield*10 == field)) then + found = .true. + this%segment => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do +#ifdef CompileWithBerengerWires + case ('berenger') + do n = 1, Hwireslocal_Berenger%NumSegments + currentSegment => Hwireslocal_Berenger%Segments(n) + if (currentSegment%IndexSegment == no) then + found = .true. + this%segmentBerenger => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do +#endif +#ifdef CompileWithSlantedWires + case ('slanted', 'semistructured') + do n = 1, Hwireslocal_Slanted%NumSegments + currentSegment => Hwireslocal_Slanted%Segments(n) + if (currentSegment%ptr%Index == no) then + found = .true. + this%segmentSlanted => currentSegment%ptr + end if + end do +#endif + end select + + if (.not. found) then + select case (trim(adjustl(wiresFlavor))) + case ('holland', 'transition') + buscarabono: do iwi = 1, Hwireslocal%NumDifferentWires + do iwj = 1, sgg%Med(Hwireslocal%WireTipoMedio(iwi))%wire(1)%numsegmentos + if ((no == sgg%Med(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%origindex) .and. & + sgg%Med(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multirabo) then + no2 = sgg%Med(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multiraboDE + do n = 1, HWireslocal%NumCurrentSegments + currentSegment => HWireslocal%CurrentSegment(n) + if (currentSegment%origindex == no2) then + found = .true. + this%segment => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do + exit buscarabono + end if + end do + end do buscarabono +#ifdef CompileWithSlantedWires + case ('slanted', 'semistructured') + do n = 1, Hwireslocal_Slanted%NumSegments + currentSegment => Hwireslocal_Slanted%Segments(n) + if (currentSegment%ptr%elotroindice == no) then + found = .true. + this%segmentSlanted => currentSegment%ptr + end if + end do +#endif + end select + end if + end if + + if (.not. found) then + write (buff, '(a,4i7,a)') 'ERROR: WIRE probe ', no, iCoord, jCoord, kCoord, ' DOES NOT EXIST' + CALL WarnErrReport(buff, .true.) + end if + end subroutine find_segment + + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: outputPath + character(len=BUFSIZE) :: charNO + + write (charNO, '(i7)') NO + prefixNodeExtension = 's'//trim(adjustl(charNO)) + probeBoundsExtension = get_probe_bounds_extension() + prefixFieldExtension = get_prefix_extension(field, mpidir) + + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_' & + //trim(adjustl(probeBoundsExtension))//'_'//trim(adjustl(prefixNodeExtension)) + return + end function get_output_path + + function get_probe_bounds_extension() result(ext) + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + +#if CompileWithMPI + if (mpidir == 3) then + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + elseif (mpidir == 2) then + ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) + elseif (mpidir == 1) then + ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) + else + call stoponerror('Buggy error in mpidir. ') + end if +#else + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) +#endif + + return + end function get_probe_bounds_extension + + end subroutine init_wire_current_probe_output subroutine update_point_probe_output(this, step, field) type(point_probe_output_t), intent(inout) :: this @@ -282,7 +446,7 @@ subroutine update_point_probe_output(this, step, field) if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then do iter = 1, this%nFreq this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) + this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) end do end if end subroutine update_point_probe_output From 952e9811490b6a497fb9fcf19c4602a30e6b9ad1 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 28 Nov 2025 12:55:27 +0100 Subject: [PATCH 07/67] Separate point probe logic --- src_output/CMakeLists.txt | 1 + src_output/output.F90 | 370 +++++++++++------------------- src_output/outputUtils.F90 | 3 +- src_output/point_probe_output.F90 | 146 ++++++++++++ 4 files changed, 282 insertions(+), 238 deletions(-) create mode 100644 src_output/point_probe_output.F90 diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index 8792cba2..66e92720 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -2,5 +2,6 @@ add_library(fdtd-output "output.F90" "domain.F90" "outputUtils.F90" + "point_probe_output.F90" ) target_link_libraries(fdtd-output semba-types ) \ No newline at end of file diff --git a/src_output/output.F90 b/src_output/output.F90 index 2a1f0a37..0c84341e 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -2,39 +2,31 @@ module output use FDETYPES use mod_domain use mod_outputUtils - + use mod_pointProbeOutput use wiresHolland_constants use HollandWires implicit none - character(len=4) :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' - integer(kind=SINGLE), parameter :: FILE_UNIT = 400 + + - integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0 + integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0, & + WIRE_CURRENT_PROBE_ID = 0 type solver_output_t integer(kind=SINGLE) :: outputID type(point_probe_output_t), allocatable :: pointProbe - type(wire_current_probe_output_t), allocatable :: wireProbe + type(wire_current_probe_output_t), allocatable :: wireCurrentProbe !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !type(far_field_t), allocatable :: farField !type(time_movie_output_t), allocatable :: timeMovie !type(frequency_slice_output_t), allocatable :: frequencySlice end type solver_output_t - type point_probe_output_t - integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field - type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: fieldComponent - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE, nFreq = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND - - real(kind=RKIND), dimension(:), allocatable :: frequencySlice - real(kind=CKIND), dimension(:), allocatable :: valueForFreq - end type point_probe_output_t - + + type current_values_t + real(kind=RKIND) :: current = 0.0_RKIND, deltaVoltage = 0.0_RKIND + real(kind=RKIND) :: plusVoltage = 0.0_RKIND, minusVoltage = 0.0_RKIND, voltageDiference = 0.0_RKIND + end type type wire_current_probe_output_t integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus type(domain_t) :: domain @@ -49,15 +41,10 @@ module output type(current_values_t), dimension(BuffObse) :: currentValues end type wire_current_probe_output_t - type current_values_t - real(kind=RKIND) :: current = 0.0_RKIND, deltaVoltage = 0.0_RKIND - real(kind=RKIND) :: plusVoltage = 0.0_RKIND, minusVoltage = 0.0_RKIND, voltageDiference = 0.0_RKIND - end type - interface init_solver_output module procedure & - init_point_probe_output - !init_wire_probe_output, & + init_point_probe_output, & + init_wire_current_probe_output !init_bulk_current_probe_output, & !init_far_field, & !initime_movie_output, & @@ -95,7 +82,7 @@ module output end interface contains - subroutine init_outputs(sgg, control, outputs) + subroutine init_outputs(sgg, control, outputs, ThereAreWires) type(SGGFDTDINFO), intent(in) :: sgg type(sim_control_t), intent(inout) :: control type(solver_output_t), dimension(:), intent(out) :: outputs @@ -103,25 +90,35 @@ subroutine init_outputs(sgg, control, outputs) integer(kind=SINGLE) :: outputCount = 0 allocate (outputs(sgg%NumberRequest)) + call retrive_wires_data() + do ii = 1, sgg%NumberRequest do i = 1, sgg%Observation(ii)%nP I1 = sgg%observation(ii)%P(i)%XI J1 = sgg%observation(ii)%P(i)%YI K1 = sgg%observation(ii)%P(i)%ZI + NO = sgg%observation(ii)%P(i)%NODE + + domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, finaltimestep) + outputTypeExtension = trim(adjustl(nEntradaRoot))//'_'//trim(adjustl(sgg%observation(ii)%outputrequest)) field = sgg%observation(ii)%P(i)%what select case (field) - case (iEx, iEy, iEz, iVx, iVy, iVz, iJx, iJy, iJz, iQx, iQy, iQz, iHx, iHy, iHz, lineIntegral) + case (iEx, iEy, iEz, iHx, iHy, iHz) outputCount = outputCount + 1 - outputs(outputCount)%outputID = POINT_PROBE_ID - domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, finaltimestep) + allocate (outputs(outputCount)%pointProbe) + call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, field, domain, outputTypeExtension, control%mpidir) - outputTypeExtension = trim(adjustl(nEntradaRoot))//'_'//trim(adjustl(sgg%observation(ii)%outputrequest)) + case (iJx, iJy, iJz) + if (ThereAreWires) then + outputCount = outputCount + 1 + outputs(outputCount)%outputID = WIRE_CURRENT_PROBE_ID - allocate (outputs(outputCount)%pointProbe) - init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, field, domain, outputTypeExtension, mpidir) + allocate (outputs(outputCount)%wireCurrentProbe) + call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NO, field, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) + end if case default call stoponerror('Field type not implemented yet on new observations') end select @@ -163,7 +160,7 @@ function preprocess_domain(observation, timeArray, timeStep, finalStepIndex) res newDomain%fstep = min(newDomain%fstep, 2.0_RKIND/dt) if ((newDomain%fstep > newDomain%fstop - newDomain%fstart) .or. (newDomain%fstep == 0)) then newDomain%fstep = newDomain%fstop - newDomain%fstart - newDomain%fstop = newDomain%fstart + observation%fstep + newDomain%fstop = newDomain%fstart + newDomain%fstep end if newDomain%fnum = int((newDomain%fstop - newDomain%fstart)/newDomain%fstep, kind=SINGLE) @@ -174,34 +171,36 @@ function preprocess_domain(observation, timeArray, timeStep, finalStepIndex) res return end function preprocess_domain - end subroutine init_observations + end subroutine init_outputs - subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh) + subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh, alloc) type(solver_output_t), dimension(:), intent(inout) :: outputs real(kind=RKIND_tiempo) :: step integer(kind=SINGLE) :: i, id - - REAL(KIND=RKIND), intent(in), target :: & - Ex(sgg%alloc(iEx)%XI:sgg%alloc(iEx)%XE, sgg%alloc(iEx)%YI:sgg%alloc(iEx)%YE, sgg%alloc(iEx)%ZI:sgg%alloc(iEx)%ZE), & - Ey(sgg%alloc(iEy)%XI:sgg%alloc(iEy)%XE, sgg%alloc(iEy)%YI:sgg%alloc(iEy)%YE, sgg%alloc(iEy)%ZI:sgg%alloc(iEy)%ZE), & - Ez(sgg%alloc(iEz)%XI:sgg%alloc(iEz)%XE, sgg%alloc(iEz)%YI:sgg%alloc(iEz)%YE, sgg%alloc(iEz)%ZI:sgg%alloc(iEz)%ZE), & - Hx(sgg%alloc(iHx)%XI:sgg%alloc(iHx)%XE, sgg%alloc(iHx)%YI:sgg%alloc(iHx)%YE, sgg%alloc(iHx)%ZI:sgg%alloc(iHx)%ZE), & - Hy(sgg%alloc(iHy)%XI:sgg%alloc(iHy)%XE, sgg%alloc(iHy)%YI:sgg%alloc(iHy)%YE, sgg%alloc(iHy)%ZI:sgg%alloc(iHy)%ZE), & - Hz(sgg%alloc(iHz)%XI:sgg%alloc(iHz)%XE, sgg%alloc(iHz)%YI:sgg%alloc(iHz)%YE, sgg%alloc(iHz)%ZI:sgg%alloc(iHz)%ZE) + type(XYZlimit_t), dimension(1:6), intent(in) :: alloc + real(kind=RKIND), pointer, dimension(:, :, :) :: fieldPointer + + real(KIND=RKIND), intent(in), target :: & + Ex(alloc(iEx)%XI:alloc(iEx)%XE, alloc(iEx)%YI:alloc(iEx)%YE, alloc(iEx)%ZI:alloc(iEx)%ZE), & + Ey(alloc(iEy)%XI:alloc(iEy)%XE, alloc(iEy)%YI:alloc(iEy)%YE, alloc(iEy)%ZI:alloc(iEy)%ZE), & + Ez(alloc(iEz)%XI:alloc(iEz)%XE, alloc(iEz)%YI:alloc(iEz)%YE, alloc(iEz)%ZI:alloc(iEz)%ZE), & + Hx(alloc(iHx)%XI:alloc(iHx)%XE, alloc(iHx)%YI:alloc(iHx)%YE, alloc(iHx)%ZI:alloc(iHx)%ZE), & + Hy(alloc(iHy)%XI:alloc(iHy)%XE, alloc(iHy)%YI:alloc(iHy)%YE, alloc(iHy)%ZI:alloc(iHy)%ZE), & + Hz(alloc(iHz)%XI:alloc(iHz)%XE, alloc(iHz)%YI:alloc(iHz)%YE, alloc(iHz)%ZI:alloc(iHz)%ZE) !---> - REAL(KIND=RKIND), dimension(:), intent(in) :: dxh(sgg%ALLOC(iEx)%XI:sgg%ALLOC(iEx)%XE), & - dyh(sgg%ALLOC(iEy)%YI:sgg%ALLOC(iEy)%YE), & - dzh(sgg%ALLOC(iEz)%ZI:sgg%ALLOC(iEz)%ZE), & - dxe(sgg%alloc(iHx)%XI:sgg%alloc(iHx)%XE), & - dye(sgg%alloc(iHy)%YI:sgg%alloc(iHy)%YE), & - dze(sgg%alloc(iHz)%ZI:sgg%alloc(iHz)%ZE) + real(KIND=RKIND), dimension(:), intent(in) :: dxh(alloc(iEx)%XI:alloc(iEx)%XE), & + dyh(alloc(iEy)%YI:alloc(iEy)%YE), & + dzh(alloc(iEz)%ZI:alloc(iEz)%ZE), & + dxe(alloc(iHx)%XI:alloc(iHx)%XE), & + dye(alloc(iHy)%YI:alloc(iHy)%YE), & + dze(alloc(iHz)%ZI:alloc(iHz)%ZE) do i = 1, size(outputs) id = outputs(i)%outputID select case (id) case (POINT_PROBE_ID) - field => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos - update_solver_output(outputs(i)%pointProbe, step, field) + fieldPointer => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos + call update_solver_output(outputs(i)%pointProbe, step, field) case default call stoponerror('Output update not implemented') end select @@ -210,6 +209,7 @@ subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, contains function get_field_component(fieldId) result(field) integer(kind=SINGLE), intent(in) :: fieldId + real(kind=RKIND), pointer, dimension(:, :, :) :: field select case (fieldId) case (iEx); field => Ex case (iEy); field => Ey @@ -222,78 +222,36 @@ end function get_field_component end subroutine update_outputs - subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, outputTypeExtension, mpidir) - type(point_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord - integer(kind=SINGLE), intent(in) :: mpidir, field + + + subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, media, outputTypeExtension, mpidir, wiresflavor) + type(wire_current_probe_output_t), intent(out) :: this + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node + integer(kind=SINGLE), intent(in) :: field, mpidir character(len=BUFSIZE), intent(in) :: outputTypeExtension + character(len=*), intent(in) :: wiresflavor type(domain_t), intent(in) :: domain + type(MediaData_t), pointer, dimension(:), intent(in) :: media - character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension - integer(kind=SINGLE) :: i - - this%xCoord = iCoord - this%yCoord = jCoord - this%zCoord = kCoord - - this%fieldComponent = field - - this%domain = domain - this%path = get_output_path() - - if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - this%nFreq = this%domain%fnum - allocate (this%frequencySlice(this%domain%fnum)) - allocate (this%valueForFreq(this%domain%fnum)) - do i = 1, this%nFreq - call init_frequency_slice(this%frequencySlice, this%domain) - end do - this%valueForFreq = (0.0_RKIND, 0.0_RKIND) - end if - - contains - function get_output_path() result(outputPath) - character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_probe_bounds_extension() - prefixFieldExtension = get_prefix_extension(field, mpidir) - outputPath = & - trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension)) - return - end function get_output_path - - function get_probe_bounds_extension() result(ext) - character(len=BUFSIZE) :: ext - character(len=BUFSIZE) :: chari, charj, chark - - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord - -#if CompileWithMPI - if (mpidir == 3) then - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) - elseif (mpidir == 2) then - ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) - elseif (mpidir == 1) then - ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) - else - call stoponerror('Buggy error in mpidir. ') - end if -#else - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + type(Thinwires_t), pointer :: Hwireslocal +#ifdef CompileWithBerengerWires + type(TWires), pointer :: Hwireslocal_Berenger +#endif +#ifdef CompileWithSlantedWires + type(WiresData), pointer :: Hwireslocal_Slanted #endif - return - end function get_probe_bounds_extension - end subroutine init_point_probe_output + select case (trim(adjustl(wiresflavor))) + case ('holland', 'transition'); Hwireslocal => GetHwires() +#ifdef CompileWithBerengerWires + case ('berenger'); Hwireslocal_Berenger => GetHwires_Berenger() +#endif +#ifdef CompileWithSlantedWires + case ('slanted', 'semistructured'); Hwireslocal_Slanted => GetHwires_Slanted() +#endif + end select - subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, outputTypeExtension, wiresFlavor) - type(wire_current_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node - integer(kind=SINGLE), intent(in) :: field - character(len=BUFSIZE), intent(in) :: outputTypeExtension - character(len=*), intent(in) :: wiresFlavor - type(domain_t), intent(in) :: domain + call find_segment() this%xCoord = iCoord this%yCoord = jCoord @@ -304,83 +262,79 @@ subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, fi this%domain = domain this%path = get_output_path() - call find_segment() - contains subroutine find_segment() integer(kind=SINGLE) :: n type(CurrentSegments), pointer :: currentSegment logical :: found = .false. - if (ThereAreWires) then - select case (trim(adjustl(wiresFlavor))) - case ('holland', 'transition') - this%segment => HWireslocal%NullSegment - do n = 1, HWireslocal%NumCurrentSegments - currentSegment => HWireslocal%CurrentSegment(n) - if ((currentSegment%origindex == no) .and. & - (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & - (currentSegment%tipofield*10 == field)) then - found = .true. - this%segment => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do + select case (trim(adjustl(wiresflavor))) + case ('holland', 'transition') + this%segment => HWireslocal%NullSegment + do n = 1, HWireslocal%NumCurrentSegments + currentSegment => HWireslocal%CurrentSegment(n) + if ((currentSegment%origindex == no) .and. & + (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & + (currentSegment%tipofield*10 == field)) then + found = .true. + this%segment => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do #ifdef CompileWithBerengerWires - case ('berenger') - do n = 1, Hwireslocal_Berenger%NumSegments - currentSegment => Hwireslocal_Berenger%Segments(n) - if (currentSegment%IndexSegment == no) then - found = .true. - this%segmentBerenger => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do + case ('berenger') + do n = 1, Hwireslocal_Berenger%NumSegments + currentSegment => Hwireslocal_Berenger%Segments(n) + if (currentSegment%IndexSegment == no) then + found = .true. + this%segmentBerenger => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do #endif +#ifdef CompileWithSlantedWires + case ('slanted', 'semistructured') + do n = 1, Hwireslocal_Slanted%NumSegments + currentSegment => Hwireslocal_Slanted%Segments(n) + if (currentSegment%ptr%Index == no) then + found = .true. + this%segmentSlanted => currentSegment%ptr + end if + end do +#endif + end select + + if (.not. found) then + select case (trim(adjustl(wiresflavor))) + case ('holland', 'transition') + buscarabono: do iwi = 1, Hwireslocal%NumDifferentWires + do iwj = 1, media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%numsegmentos + if ((no == media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%origindex) .and. & + media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multirabo) then + no2 = media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multiraboDE + do n = 1, HWireslocal%NumCurrentSegments + currentSegment => HWireslocal%CurrentSegment(n) + if (currentSegment%origindex == no2) then + found = .true. + this%segment => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do + exit buscarabono + end if + end do + end do buscarabono #ifdef CompileWithSlantedWires case ('slanted', 'semistructured') do n = 1, Hwireslocal_Slanted%NumSegments currentSegment => Hwireslocal_Slanted%Segments(n) - if (currentSegment%ptr%Index == no) then + if (currentSegment%ptr%elotroindice == no) then found = .true. this%segmentSlanted => currentSegment%ptr end if end do #endif end select - - if (.not. found) then - select case (trim(adjustl(wiresFlavor))) - case ('holland', 'transition') - buscarabono: do iwi = 1, Hwireslocal%NumDifferentWires - do iwj = 1, sgg%Med(Hwireslocal%WireTipoMedio(iwi))%wire(1)%numsegmentos - if ((no == sgg%Med(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%origindex) .and. & - sgg%Med(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multirabo) then - no2 = sgg%Med(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multiraboDE - do n = 1, HWireslocal%NumCurrentSegments - currentSegment => HWireslocal%CurrentSegment(n) - if (currentSegment%origindex == no2) then - found = .true. - this%segment => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do - exit buscarabono - end if - end do - end do buscarabono -#ifdef CompileWithSlantedWires - case ('slanted', 'semistructured') - do n = 1, Hwireslocal_Slanted%NumSegments - currentSegment => Hwireslocal_Slanted%Segments(n) - if (currentSegment%ptr%elotroindice == no) then - found = .true. - this%segmentSlanted => currentSegment%ptr - end if - end do -#endif - end select - end if end if if (.not. found) then @@ -397,7 +351,7 @@ function get_output_path() result(outputPath) prefixNodeExtension = 's'//trim(adjustl(charNO)) probeBoundsExtension = get_probe_bounds_extension() prefixFieldExtension = get_prefix_extension(field, mpidir) - + outputPath = & trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_' & //trim(adjustl(probeBoundsExtension))//'_'//trim(adjustl(prefixNodeExtension)) @@ -431,64 +385,6 @@ end function get_probe_bounds_extension end subroutine init_wire_current_probe_output - subroutine update_point_probe_output(this, step, field) - type(point_probe_output_t), intent(inout) :: this - real(kind=RKIND), pointer, dimension(:, :, :) :: field - real(kind=RKIND_tiempo) :: step - integer(kind=SINGLE) :: iter - - if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then - this%serializedTimeSize = this%serializedTimeSize + 1 - this%timeStep(this%serializedTimeSize) = step - this%valueForTime(this%serializedTimeSize) = field(this%xCoord, this%yCoord, this%zCoord) - end if - - if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - do iter = 1, this%nFreq - this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*get_auxExp(this%frequencySlice(iter), this%fieldComponent) - end do - end if - end subroutine update_point_probe_output - - subroutine flush_point_probe_output(this) - type(point_probe_output_t), intent(inout) :: this - - integer(kind=SINGLE) :: timeUnitFile, frequencyUnitFile, status - character(len=BUFSIZE) :: timeFileName, frequencyFileName - integer(kind=SINGLE) :: i - - if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then - timeFileName = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) - timeUnitFile = FILE_UNIT + 1 - - status = open_file(timeUnitFile, timeFileName) - if (status /= 0) call stoponerror('Failed to open timeDomainFile. ') - - do i = 1, this%serializedTimeSize - write (timeUnitFile, '(F12.4, 2X, F12.4)') this%timeStep(i), this%valueForTime(i) - end do - - status = close_file(timeUnitFile) - end if - - if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - frequencyFileName = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) - frequencyUnitFile = FILE_UNIT + 2 - - OPEN (UNIT=frequencyUnitFile, FILE=frequencyFileName, STATUS='REPLACE', ACTION='WRITE', iostat=status) - if (status /= 0) call stoponerror('Failed to open frequencyDomainFile. ') - - do i = 1, this%nFreq - write (frequencyUnitFile, '(F12.4, 2X, F12.4)') this%frequencySlice(i), this%valueForFreq(i) - end do - - status = close_file(frequencyUnitFile) - end if - end subroutine flush_point_probe_output - - subroutine delete_point_probe_output() - !TODO - end subroutine delete_point_probe_output + end module output diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index d0c602f4..2b356d4e 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -2,7 +2,8 @@ module mod_outputUtils use FDETYPES use mod_domain implicit none - + character(len=4), parameter :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' + integer(kind=SINGLE), parameter :: FILE_UNIT = 400 contains function get_prefix_extension(field, mpidir) result(prefixExtension) diff --git a/src_output/point_probe_output.F90 b/src_output/point_probe_output.F90 new file mode 100644 index 00000000..2f5706fd --- /dev/null +++ b/src_output/point_probe_output.F90 @@ -0,0 +1,146 @@ +module mod_pointProbeOutput + use FDETYPES + use mod_domain + use mod_outputUtils + implicit none + + type point_probe_output_t + integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: fieldComponent + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE, nFreq = 0_SINGLE + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND + + real(kind=RKIND), dimension(:), allocatable :: frequencySlice + real(kind=CKIND), dimension(:), allocatable :: valueForFreq + end type point_probe_output_t + +contains + subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, outputTypeExtension, mpidir) + type(point_probe_output_t), intent(out) :: this + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord + integer(kind=SINGLE), intent(in) :: mpidir, field + character(len=BUFSIZE), intent(in) :: outputTypeExtension + type(domain_t), intent(in) :: domain + + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + integer(kind=SINGLE) :: i + + this%xCoord = iCoord + this%yCoord = jCoord + this%zCoord = kCoord + + this%fieldComponent = field + + this%domain = domain + this%path = get_output_path() + + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + this%nFreq = this%domain%fnum + allocate (this%frequencySlice(this%domain%fnum)) + allocate (this%valueForFreq(this%domain%fnum)) + do i = 1, this%nFreq + call init_frequency_slice(this%frequencySlice, this%domain) + end do + this%valueForFreq = (0.0_RKIND, 0.0_RKIND) + end if + + contains + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_probe_bounds_extension() + prefixFieldExtension = get_prefix_extension(field, mpidir) + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension)) + return + end function get_output_path + + function get_probe_bounds_extension() result(ext) + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + +#if CompileWithMPI + if (mpidir == 3) then + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + elseif (mpidir == 2) then + ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) + elseif (mpidir == 1) then + ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) + else + call stoponerror('Buggy error in mpidir. ') + end if +#else + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) +#endif + + return + end function get_probe_bounds_extension + end subroutine init_point_probe_output + + subroutine update_point_probe_output(this, step, field) + type(point_probe_output_t), intent(inout) :: this + real(kind=RKIND), pointer, dimension(:, :, :) :: field + real(kind=RKIND_tiempo) :: step + integer(kind=SINGLE) :: iter + + if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + this%serializedTimeSize = this%serializedTimeSize + 1 + this%timeStep(this%serializedTimeSize) = step + this%valueForTime(this%serializedTimeSize) = field(this%xCoord, this%yCoord, this%zCoord) + end if + + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + do iter = 1, this%nFreq + this%valueForFreq(iter) = & + this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord) !*get_auxExp(this%frequencySlice(iter), this%fieldComponent) + end do + end if + end subroutine update_point_probe_output + + subroutine flush_point_probe_output(this) + type(point_probe_output_t), intent(inout) :: this + + integer(kind=SINGLE) :: timeUnitFile, frequencyUnitFile, status + character(len=BUFSIZE) :: timeFileName, frequencyFileName + integer(kind=SINGLE) :: i + + if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + timeFileName = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) + timeUnitFile = FILE_UNIT + 1 + + status = open_file(timeUnitFile, timeFileName) + if (status /= 0) call stoponerror('Failed to open timeDomainFile. ') + + do i = 1, this%serializedTimeSize + write (timeUnitFile, '(F12.4, 2X, F12.4)') this%timeStep(i), this%valueForTime(i) + end do + + status = close_file(timeUnitFile) + end if + + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + frequencyFileName = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) + frequencyUnitFile = FILE_UNIT + 2 + + OPEN (UNIT=frequencyUnitFile, FILE=frequencyFileName, STATUS='REPLACE', ACTION='WRITE', iostat=status) + if (status /= 0) call stoponerror('Failed to open frequencyDomainFile. ') + + do i = 1, this%nFreq + write (frequencyUnitFile, '(F12.4, 2X, F12.4)') this%frequencySlice(i), this%valueForFreq(i) + end do + + status = close_file(frequencyUnitFile) + end if + end subroutine flush_point_probe_output + + subroutine delete_point_probe_output() + !TODO + end subroutine delete_point_probe_output +end module From fa14f1503a4abacf2431260e5b6720a91a81d2b0 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 28 Nov 2025 13:30:20 +0100 Subject: [PATCH 08/67] Fix compilation errors --- src_output/domain.F90 | 15 ++++--- src_output/output.F90 | 65 ++++++++++++++++++------------- src_output/point_probe_output.F90 | 2 +- 3 files changed, 46 insertions(+), 36 deletions(-) diff --git a/src_output/domain.F90 b/src_output/domain.F90 index eaa63251..72d4d3a3 100644 --- a/src_output/domain.F90 +++ b/src_output/domain.F90 @@ -32,26 +32,25 @@ end function new_domain_time function new_domain_freq(fstart, fstop, fnum, logarithmicSpacing) result(new_domain) real(kind=RKIND), intent(in) :: fstart, fstop integer(kind=SINGLE), intent(in) :: fnum - logical, intent(in), optional :: logarithmicSpacing + logical, intent(in) :: logarithmicSpacing type(domain_t) :: new_domain new_domain%fstart = fstart new_domain%fstop = fstop new_domain%fnum = fnum new_domain%fstep = (fstop - fstart) / fnum + new_domain%logarithmicSpacing = logarithmicSpacing new_domain%domainType = FREQUENCY_DOMAIN - if (present(logarithmicSpacing)) then - new_domain%logarithmicSpacing = logarithmicSpacing - end if + end function new_domain_freq function new_domain_both(tstart, tstop, tstep, fstart, fstop, fnum, logarithmicSpacing) result(new_domain) real(kind=RKIND_tiempo), intent(in) :: tstart, tstop, tstep real(kind=RKIND), intent(in) :: fstart, fstop integer(kind=SINGLE), intent(in) :: fnum - logical, intent(in), optional :: logarithmicSpacing + logical, intent(in) :: logarithmicSpacing type(domain_t) :: new_domain new_domain%tstart = tstart @@ -62,12 +61,12 @@ function new_domain_both(tstart, tstop, tstep, fstart, fstop, fnum, logarithmicS new_domain%fstop = fstop new_domain%fnum = fnum new_domain%fstep = (fstop - fstart) / fnum + new_domain%logarithmicSpacing = logarithmicSpacing new_domain%domainType = BOTH_DOMAIN - if (present(logarithmicSpacing)) then - new_domain%logarithmicSpacing = logarithmicSpacing - end if + + end function new_domain_both end module mod_domain diff --git a/src_output/output.F90 b/src_output/output.F90 index 0c84341e..7057c7d8 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -85,9 +85,14 @@ module output subroutine init_outputs(sgg, control, outputs, ThereAreWires) type(SGGFDTDINFO), intent(in) :: sgg type(sim_control_t), intent(inout) :: control - type(solver_output_t), dimension(:), intent(out) :: outputs + type(solver_output_t), dimension(:), allocatable, intent(out) :: outputs + logical :: ThereAreWires + type(domain_t) :: domain + integer(kind=SINGLE) :: i, ii, outputRequestType + integer(kind=SINGLE) :: I1, J1, K1, NODE integer(kind=SINGLE) :: outputCount = 0 + character(len=BUFSIZE) :: outputTypeExtension allocate (outputs(sgg%NumberRequest)) call retrive_wires_data() @@ -97,19 +102,19 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) I1 = sgg%observation(ii)%P(i)%XI J1 = sgg%observation(ii)%P(i)%YI K1 = sgg%observation(ii)%P(i)%ZI - NO = sgg%observation(ii)%P(i)%NODE + NODE = sgg%observation(ii)%P(i)%NODE - domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, finaltimestep) - outputTypeExtension = trim(adjustl(nEntradaRoot))//'_'//trim(adjustl(sgg%observation(ii)%outputrequest)) + domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, control%finaltimestep) + outputTypeExtension = trim(adjustl(control%nEntradaRoot))//'_'//trim(adjustl(sgg%observation(ii)%outputrequest)) - field = sgg%observation(ii)%P(i)%what - select case (field) + outputRequestType = sgg%observation(ii)%P(i)%what + select case (outputRequestType) case (iEx, iEy, iEz, iHx, iHy, iHz) outputCount = outputCount + 1 outputs(outputCount)%outputID = POINT_PROBE_ID allocate (outputs(outputCount)%pointProbe) - call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, field, domain, outputTypeExtension, control%mpidir) + call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir) case (iJx, iJy, iJz) if (ThereAreWires) then @@ -117,31 +122,33 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) outputs(outputCount)%outputID = WIRE_CURRENT_PROBE_ID allocate (outputs(outputCount)%wireCurrentProbe) - call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NO, field, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) + call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) end if case default - call stoponerror('Field type not implemented yet on new observations') + call stoponerror('OutputRequestType type not implemented yet on new observations') end select end do end do return contains - function preprocess_domain(observation, timeArray, timeStep, finalStepIndex) result(newDomain) + function preprocess_domain(observation, timeArray, simulationTimeStep, finalStepIndex) result(newDomain) type(Obses_t), intent(in) :: observation real(kind=RKIND_tiempo), pointer, dimension(:), intent(in) :: timeArray - real(kind=RKIND_tiempo), intent(in) :: timeStep + real(kind=RKIND_tiempo), intent(in) :: simulationTimeStep integer(kind=4), intent(in) :: finalStepIndex type(domain_t) :: newDomain integer(kind=SINGLE) :: nFreq if (observation%TimeDomain) then - newdomain = domain_t(observation%InitialTime, observation%FinalTime, observation%TimeStep) + newdomain = domain_t(real(observation%InitialTime, kind=RKIND_tiempo), & + real(observation%FinalTime, kind=RKIND_tiempo), & + real(observation%TimeStep, kind=RKIND_tiempo)) - newdomain%tstep = max(newdomain%tstep, timeStep) + newdomain%tstep = max(newdomain%tstep, simulationTimeStep) - if (10.0_RKIND*(newdomain%tstop - newdomain%tstart)/min(timeStep, newdomain%tstep) >= huge(1_4)) then - newdomain%tstop = newdomain%tstart + min(timeStep, newdomain%tstep)*huge(1_4)/10.0_RKIND + if (10.0_RKIND*(newdomain%tstop - newdomain%tstart)/min(simulationTimeStep, newdomain%tstep) >= huge(1_4)) then + newdomain%tstop = newdomain%tstart + min(simulationTimeStep, newdomain%tstep)*huge(1_4)/10.0_RKIND end if if (newDomain%tstart < newDomain%tstep) then @@ -157,7 +164,7 @@ function preprocess_domain(observation, timeArray, timeStep, finalStepIndex) res nFreq = int((observation%FinalFreq - observation%InitialFreq)/observation%FreqStep, kind=SINGLE) newdomain = domain_t(observation%InitialFreq, observation%FinalFreq, nFreq, logarithmicspacing=.false.) - newDomain%fstep = min(newDomain%fstep, 2.0_RKIND/dt) + newDomain%fstep = min(newDomain%fstep, 2.0_RKIND/simulationTimeStep) if ((newDomain%fstep > newDomain%fstop - newDomain%fstart) .or. (newDomain%fstep == 0)) then newDomain%fstep = newDomain%fstop - newDomain%fstart newDomain%fstop = newDomain%fstart + newDomain%fstep @@ -200,7 +207,7 @@ subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, select case (id) case (POINT_PROBE_ID) fieldPointer => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos - call update_solver_output(outputs(i)%pointProbe, step, field) + call update_solver_output(outputs(i)%pointProbe, step, fieldPointer) case default call stoponerror('Output update not implemented') end select @@ -233,6 +240,8 @@ subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, fi type(domain_t), intent(in) :: domain type(MediaData_t), pointer, dimension(:), intent(in) :: media + + type(Thinwires_t), pointer :: Hwireslocal #ifdef CompileWithBerengerWires type(TWires), pointer :: Hwireslocal_Berenger @@ -264,16 +273,17 @@ subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, fi contains subroutine find_segment() - integer(kind=SINGLE) :: n + integer(kind=SINGLE) :: n, iwi, iwj, node2 type(CurrentSegments), pointer :: currentSegment logical :: found = .false. + character(len=BUFSIZE) :: buff select case (trim(adjustl(wiresflavor))) case ('holland', 'transition') this%segment => HWireslocal%NullSegment do n = 1, HWireslocal%NumCurrentSegments currentSegment => HWireslocal%CurrentSegment(n) - if ((currentSegment%origindex == no) .and. & + if ((currentSegment%origindex == node) .and. & (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & (currentSegment%tipofield*10 == field)) then found = .true. @@ -285,7 +295,7 @@ subroutine find_segment() case ('berenger') do n = 1, Hwireslocal_Berenger%NumSegments currentSegment => Hwireslocal_Berenger%Segments(n) - if (currentSegment%IndexSegment == no) then + if (currentSegment%IndexSegment == node) then found = .true. this%segmentBerenger => currentSegment if (currentSegment%orientadoalreves) this%sign = -1 @@ -296,7 +306,7 @@ subroutine find_segment() case ('slanted', 'semistructured') do n = 1, Hwireslocal_Slanted%NumSegments currentSegment => Hwireslocal_Slanted%Segments(n) - if (currentSegment%ptr%Index == no) then + if (currentSegment%ptr%Index == node) then found = .true. this%segmentSlanted => currentSegment%ptr end if @@ -309,12 +319,12 @@ subroutine find_segment() case ('holland', 'transition') buscarabono: do iwi = 1, Hwireslocal%NumDifferentWires do iwj = 1, media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%numsegmentos - if ((no == media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%origindex) .and. & + if ((node == media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%origindex) .and. & media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multirabo) then - no2 = media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multiraboDE + node2 = media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multiraboDE do n = 1, HWireslocal%NumCurrentSegments currentSegment => HWireslocal%CurrentSegment(n) - if (currentSegment%origindex == no2) then + if (currentSegment%origindex == node2) then found = .true. this%segment => currentSegment if (currentSegment%orientadoalreves) this%sign = -1 @@ -328,7 +338,7 @@ subroutine find_segment() case ('slanted', 'semistructured') do n = 1, Hwireslocal_Slanted%NumSegments currentSegment => Hwireslocal_Slanted%Segments(n) - if (currentSegment%ptr%elotroindice == no) then + if (currentSegment%ptr%elotroindice == node) then found = .true. this%segmentSlanted => currentSegment%ptr end if @@ -338,7 +348,7 @@ subroutine find_segment() end if if (.not. found) then - write (buff, '(a,4i7,a)') 'ERROR: WIRE probe ', no, iCoord, jCoord, kCoord, ' DOES NOT EXIST' + write (buff, '(a,4i7,a)') 'ERROR: WIRE probe ', node, iCoord, jCoord, kCoord, ' DOES NOT EXIST' CALL WarnErrReport(buff, .true.) end if end subroutine find_segment @@ -346,8 +356,9 @@ end subroutine find_segment function get_output_path() result(outputPath) character(len=BUFSIZE) :: outputPath character(len=BUFSIZE) :: charNO + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension, prefixNodeExtension - write (charNO, '(i7)') NO + write (charNO, '(i7)') node prefixNodeExtension = 's'//trim(adjustl(charNO)) probeBoundsExtension = get_probe_bounds_extension() prefixFieldExtension = get_prefix_extension(field, mpidir) diff --git a/src_output/point_probe_output.F90 b/src_output/point_probe_output.F90 index 2f5706fd..b97076e1 100644 --- a/src_output/point_probe_output.F90 +++ b/src_output/point_probe_output.F90 @@ -26,7 +26,6 @@ subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, character(len=BUFSIZE), intent(in) :: outputTypeExtension type(domain_t), intent(in) :: domain - character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension integer(kind=SINGLE) :: i this%xCoord = iCoord @@ -50,6 +49,7 @@ subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, contains function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath probeBoundsExtension = get_probe_bounds_extension() prefixFieldExtension = get_prefix_extension(field, mpidir) From 99ad834c5bc5c81db9bd872b0e672d6db7613482 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 1 Dec 2025 10:21:00 +0100 Subject: [PATCH 09/67] Create wire current probe output module --- src_output/CMakeLists.txt | 1 + src_output/output.F90 | 191 +--------------------- src_output/point_probe_output.F90 | 1 + src_output/wire_current_probe_output.F90 | 192 +++++++++++++++++++++++ 4 files changed, 196 insertions(+), 189 deletions(-) create mode 100644 src_output/wire_current_probe_output.F90 diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index 66e92720..d028369a 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -3,5 +3,6 @@ add_library(fdtd-output "domain.F90" "outputUtils.F90" "point_probe_output.F90" + "wire_current_probe_output.F90" ) target_link_libraries(fdtd-output semba-types ) \ No newline at end of file diff --git a/src_output/output.F90 b/src_output/output.F90 index 7057c7d8..a58ddc33 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -3,8 +3,8 @@ module output use mod_domain use mod_outputUtils use mod_pointProbeOutput - use wiresHolland_constants - use HollandWires + use mod_wireCurrentProbeOutput + implicit none @@ -22,24 +22,6 @@ module output !type(frequency_slice_output_t), allocatable :: frequencySlice end type solver_output_t - - type current_values_t - real(kind=RKIND) :: current = 0.0_RKIND, deltaVoltage = 0.0_RKIND - real(kind=RKIND) :: plusVoltage = 0.0_RKIND, minusVoltage = 0.0_RKIND, voltageDiference = 0.0_RKIND - end type - type wire_current_probe_output_t - integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus - type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: currentComponent - integer(kind=SINGLE) :: sign = +1 - type(CurrentSegments), pointer :: segment - - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - type(current_values_t), dimension(BuffObse) :: currentValues - end type wire_current_probe_output_t interface init_solver_output module procedure & @@ -54,7 +36,6 @@ module output interface update_solver_output module procedure & update_point_probe_output - !update_wire_probe_output, & !update_bulk_current_probe_output, & !update_far_field, & !updateime_movie_output, & @@ -229,173 +210,5 @@ end function get_field_component end subroutine update_outputs - - - subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, media, outputTypeExtension, mpidir, wiresflavor) - type(wire_current_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node - integer(kind=SINGLE), intent(in) :: field, mpidir - character(len=BUFSIZE), intent(in) :: outputTypeExtension - character(len=*), intent(in) :: wiresflavor - type(domain_t), intent(in) :: domain - type(MediaData_t), pointer, dimension(:), intent(in) :: media - - - - type(Thinwires_t), pointer :: Hwireslocal -#ifdef CompileWithBerengerWires - type(TWires), pointer :: Hwireslocal_Berenger -#endif -#ifdef CompileWithSlantedWires - type(WiresData), pointer :: Hwireslocal_Slanted -#endif - - select case (trim(adjustl(wiresflavor))) - case ('holland', 'transition'); Hwireslocal => GetHwires() -#ifdef CompileWithBerengerWires - case ('berenger'); Hwireslocal_Berenger => GetHwires_Berenger() -#endif -#ifdef CompileWithSlantedWires - case ('slanted', 'semistructured'); Hwireslocal_Slanted => GetHwires_Slanted() -#endif - end select - - call find_segment() - - this%xCoord = iCoord - this%yCoord = jCoord - this%zCoord = kCoord - - this%currentComponent = field - - this%domain = domain - this%path = get_output_path() - - contains - subroutine find_segment() - integer(kind=SINGLE) :: n, iwi, iwj, node2 - type(CurrentSegments), pointer :: currentSegment - logical :: found = .false. - character(len=BUFSIZE) :: buff - - select case (trim(adjustl(wiresflavor))) - case ('holland', 'transition') - this%segment => HWireslocal%NullSegment - do n = 1, HWireslocal%NumCurrentSegments - currentSegment => HWireslocal%CurrentSegment(n) - if ((currentSegment%origindex == node) .and. & - (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & - (currentSegment%tipofield*10 == field)) then - found = .true. - this%segment => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do -#ifdef CompileWithBerengerWires - case ('berenger') - do n = 1, Hwireslocal_Berenger%NumSegments - currentSegment => Hwireslocal_Berenger%Segments(n) - if (currentSegment%IndexSegment == node) then - found = .true. - this%segmentBerenger => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do -#endif -#ifdef CompileWithSlantedWires - case ('slanted', 'semistructured') - do n = 1, Hwireslocal_Slanted%NumSegments - currentSegment => Hwireslocal_Slanted%Segments(n) - if (currentSegment%ptr%Index == node) then - found = .true. - this%segmentSlanted => currentSegment%ptr - end if - end do -#endif - end select - - if (.not. found) then - select case (trim(adjustl(wiresflavor))) - case ('holland', 'transition') - buscarabono: do iwi = 1, Hwireslocal%NumDifferentWires - do iwj = 1, media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%numsegmentos - if ((node == media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%origindex) .and. & - media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multirabo) then - node2 = media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multiraboDE - do n = 1, HWireslocal%NumCurrentSegments - currentSegment => HWireslocal%CurrentSegment(n) - if (currentSegment%origindex == node2) then - found = .true. - this%segment => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do - exit buscarabono - end if - end do - end do buscarabono -#ifdef CompileWithSlantedWires - case ('slanted', 'semistructured') - do n = 1, Hwireslocal_Slanted%NumSegments - currentSegment => Hwireslocal_Slanted%Segments(n) - if (currentSegment%ptr%elotroindice == node) then - found = .true. - this%segmentSlanted => currentSegment%ptr - end if - end do -#endif - end select - end if - - if (.not. found) then - write (buff, '(a,4i7,a)') 'ERROR: WIRE probe ', node, iCoord, jCoord, kCoord, ' DOES NOT EXIST' - CALL WarnErrReport(buff, .true.) - end if - end subroutine find_segment - - function get_output_path() result(outputPath) - character(len=BUFSIZE) :: outputPath - character(len=BUFSIZE) :: charNO - character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension, prefixNodeExtension - - write (charNO, '(i7)') node - prefixNodeExtension = 's'//trim(adjustl(charNO)) - probeBoundsExtension = get_probe_bounds_extension() - prefixFieldExtension = get_prefix_extension(field, mpidir) - - outputPath = & - trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_' & - //trim(adjustl(probeBoundsExtension))//'_'//trim(adjustl(prefixNodeExtension)) - return - end function get_output_path - - function get_probe_bounds_extension() result(ext) - character(len=BUFSIZE) :: ext - character(len=BUFSIZE) :: chari, charj, chark - - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord - -#if CompileWithMPI - if (mpidir == 3) then - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) - elseif (mpidir == 2) then - ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) - elseif (mpidir == 1) then - ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) - else - call stoponerror('Buggy error in mpidir. ') - end if -#else - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) -#endif - - return - end function get_probe_bounds_extension - - end subroutine init_wire_current_probe_output - - end module output diff --git a/src_output/point_probe_output.F90 b/src_output/point_probe_output.F90 index b97076e1..f79ef792 100644 --- a/src_output/point_probe_output.F90 +++ b/src_output/point_probe_output.F90 @@ -2,6 +2,7 @@ module mod_pointProbeOutput use FDETYPES use mod_domain use mod_outputUtils + implicit none type point_probe_output_t diff --git a/src_output/wire_current_probe_output.F90 b/src_output/wire_current_probe_output.F90 new file mode 100644 index 00000000..8bf791e7 --- /dev/null +++ b/src_output/wire_current_probe_output.F90 @@ -0,0 +1,192 @@ +module mod_wireCurrentProbeOutput + use FDETYPES + use mod_domain + use mod_outputUtils + use wiresHolland_constants + use HollandWires + implicit none + + type current_values_t + real(kind=RKIND) :: current = 0.0_RKIND, deltaVoltage = 0.0_RKIND + real(kind=RKIND) :: plusVoltage = 0.0_RKIND, minusVoltage = 0.0_RKIND, voltageDiference = 0.0_RKIND + end type + type wire_current_probe_output_t + integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: currentComponent + integer(kind=SINGLE) :: sign = +1 + type(CurrentSegments), pointer :: segment + + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + type(current_values_t), dimension(BuffObse) :: currentValues + end type wire_current_probe_output_t + +contains + subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, media, outputTypeExtension, mpidir, wiresflavor) + type(wire_current_probe_output_t), intent(out) :: this + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node + integer(kind=SINGLE), intent(in) :: field, mpidir + character(len=BUFSIZE), intent(in) :: outputTypeExtension + character(len=*), intent(in) :: wiresflavor + type(domain_t), intent(in) :: domain + type(MediaData_t), pointer, dimension(:), intent(in) :: media + + type(Thinwires_t), pointer :: Hwireslocal +#ifdef CompileWithBerengerWires + type(TWires), pointer :: Hwireslocal_Berenger +#endif +#ifdef CompileWithSlantedWires + type(WiresData), pointer :: Hwireslocal_Slanted +#endif + + select case (trim(adjustl(wiresflavor))) + case ('holland', 'transition'); Hwireslocal => GetHwires() +#ifdef CompileWithBerengerWires + case ('berenger'); Hwireslocal_Berenger => GetHwires_Berenger() +#endif +#ifdef CompileWithSlantedWires + case ('slanted', 'semistructured'); Hwireslocal_Slanted => GetHwires_Slanted() +#endif + end select + + call find_segment() + + this%xCoord = iCoord + this%yCoord = jCoord + this%zCoord = kCoord + + this%currentComponent = field + + this%domain = domain + this%path = get_output_path() + + contains + subroutine find_segment() + integer(kind=SINGLE) :: n, iwi, iwj, node2 + type(CurrentSegments), pointer :: currentSegment + logical :: found = .false. + character(len=BUFSIZE) :: buff + + select case (trim(adjustl(wiresflavor))) + case ('holland', 'transition') + this%segment => HWireslocal%NullSegment + do n = 1, HWireslocal%NumCurrentSegments + currentSegment => HWireslocal%CurrentSegment(n) + if ((currentSegment%origindex == node) .and. & + (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & + (currentSegment%tipofield*10 == field)) then + found = .true. + this%segment => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do +#ifdef CompileWithBerengerWires + case ('berenger') + do n = 1, Hwireslocal_Berenger%NumSegments + currentSegment => Hwireslocal_Berenger%Segments(n) + if (currentSegment%IndexSegment == node) then + found = .true. + this%segmentBerenger => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do +#endif +#ifdef CompileWithSlantedWires + case ('slanted', 'semistructured') + do n = 1, Hwireslocal_Slanted%NumSegments + currentSegment => Hwireslocal_Slanted%Segments(n) + if (currentSegment%ptr%Index == node) then + found = .true. + this%segmentSlanted => currentSegment%ptr + end if + end do +#endif + end select + + if (.not. found) then + select case (trim(adjustl(wiresflavor))) + case ('holland', 'transition') + buscarabono: do iwi = 1, Hwireslocal%NumDifferentWires + do iwj = 1, media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%numsegmentos + if ((node == media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%origindex) .and. & + media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multirabo) then + node2 = media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multiraboDE + do n = 1, HWireslocal%NumCurrentSegments + currentSegment => HWireslocal%CurrentSegment(n) + if (currentSegment%origindex == node2) then + found = .true. + this%segment => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do + exit buscarabono + end if + end do + end do buscarabono +#ifdef CompileWithSlantedWires + case ('slanted', 'semistructured') + do n = 1, Hwireslocal_Slanted%NumSegments + currentSegment => Hwireslocal_Slanted%Segments(n) + if (currentSegment%ptr%elotroindice == node) then + found = .true. + this%segmentSlanted => currentSegment%ptr + end if + end do +#endif + end select + end if + + if (.not. found) then + write (buff, '(a,4i7,a)') 'ERROR: WIRE probe ', node, iCoord, jCoord, kCoord, ' DOES NOT EXIST' + CALL WarnErrReport(buff, .true.) + end if + end subroutine find_segment + + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: outputPath + character(len=BUFSIZE) :: charNO + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension, prefixNodeExtension + + write (charNO, '(i7)') node + prefixNodeExtension = 's'//trim(adjustl(charNO)) + probeBoundsExtension = get_probe_bounds_extension() + prefixFieldExtension = get_prefix_extension(field, mpidir) + + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_' & + //trim(adjustl(probeBoundsExtension))//'_'//trim(adjustl(prefixNodeExtension)) + return + end function get_output_path + + function get_probe_bounds_extension() result(ext) + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + +#if CompileWithMPI + if (mpidir == 3) then + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + elseif (mpidir == 2) then + ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) + elseif (mpidir == 1) then + ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) + else + call stoponerror('Buggy error in mpidir. ') + end if +#else + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) +#endif + + return + end function get_probe_bounds_extension + + end subroutine init_wire_current_probe_output + + +end module mod_wireCurrentProbeOutput From 572b199b045411888ce5083b02ce154343ee389d Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 1 Dec 2025 11:29:37 +0100 Subject: [PATCH 10/67] Added update wire current logic --- src_output/output.F90 | 11 ++-- src_output/wire_current_probe_output.F90 | 83 ++++++++++++++++++++++++ 2 files changed, 90 insertions(+), 4 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index a58ddc33..57bd919f 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -35,7 +35,8 @@ module output interface update_solver_output module procedure & - update_point_probe_output + update_point_probe_output, & + update_wire_current_probe_output !update_bulk_current_probe_output, & !update_far_field, & !updateime_movie_output, & @@ -161,11 +162,12 @@ end function preprocess_domain end subroutine init_outputs - subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh, alloc) + subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh, alloc) type(solver_output_t), dimension(:), intent(inout) :: outputs real(kind=RKIND_tiempo) :: step integer(kind=SINGLE) :: i, id type(XYZlimit_t), dimension(1:6), intent(in) :: alloc + type(sim_control_t), intent(in) :: control real(kind=RKIND), pointer, dimension(:, :, :) :: fieldPointer real(KIND=RKIND), intent(in), target :: & @@ -184,11 +186,12 @@ subroutine update_outputs(outputs, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dze(alloc(iHz)%ZI:alloc(iHz)%ZE) do i = 1, size(outputs) - id = outputs(i)%outputID - select case (id) + select case (outputs(i)%outputID) case (POINT_PROBE_ID) fieldPointer => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos call update_solver_output(outputs(i)%pointProbe, step, fieldPointer) + case (WIRE_CURRENT_PROBE_ID) + call update_solver_output(outputs(i)%wireCurrentProbe, control%wiresflavor, control%wirecrank) case default call stoponerror('Output update not implemented') end select diff --git a/src_output/wire_current_probe_output.F90 b/src_output/wire_current_probe_output.F90 index 8bf791e7..5e180a3b 100644 --- a/src_output/wire_current_probe_output.F90 +++ b/src_output/wire_current_probe_output.F90 @@ -10,6 +10,7 @@ module mod_wireCurrentProbeOutput real(kind=RKIND) :: current = 0.0_RKIND, deltaVoltage = 0.0_RKIND real(kind=RKIND) :: plusVoltage = 0.0_RKIND, minusVoltage = 0.0_RKIND, voltageDiference = 0.0_RKIND end type + type wire_current_probe_output_t integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus type(domain_t) :: domain @@ -17,7 +18,14 @@ module mod_wireCurrentProbeOutput character(len=BUFSIZE) :: path integer(kind=SINGLE) :: currentComponent integer(kind=SINGLE) :: sign = +1 + type(CurrentSegments), pointer :: segment +#ifdef CompileWithBerengerWires + type(TSegment), pointer :: segmentBerenger +#endif +#ifdef CompileWithSlantedWires + class(Segment), pointer :: segmentSlanted +#endif integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND @@ -188,5 +196,80 @@ end function get_probe_bounds_extension end subroutine init_wire_current_probe_output + subroutine update_wire_current_probe_output(this, wiresflavor, wirecrank) + type(wire_current_probe_output_t), intent(inout) :: this + character(len=*), intent(in) :: wiresflavor + logical :: wirecrank + + type(CurrentSegments), pointer :: segmDumm +#ifdef CompileWithBerengerWires + type(TSegment), pointer :: segmDumm_Berenger +#endif +#ifdef CompileWithSlantedWires + class(Segment), pointer :: segmDumm_Slanted +#endif + + select case (trim(adjustl(wiresflavor))) + case ('holland', 'transition') + this%serializedTimeSize = this%serializedTimeSize + 1 + this%timeStep(this%serializedTimeSize) = step + SegmDumm => this%segment + + this%currentValues(this%serializedTimeSize)%current = this%sign*SegmDumm%currentpast + this%currentValues(this%serializedTimeSize)%deltaVoltage = -SegmDumm%Efield_wire2main*SegmDumm%delta + + if (wirecrank) then + this%currentValues(this%serializedTimeSize)%plusVoltage = this%sign* & + (((SegmDumm%ChargePlus%ChargePresent)))*SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) + this%currentValues(this%serializedTimeSize)%minusVoltage = this%sign* & + (((SegmDumm%ChargeMinus%ChargePresent)))*SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) + else + this%currentValues(this%serializedTimeSize)%plusVoltage = this%sign* & + (((SegmDumm%ChargePlus%ChargePresent + SegmDumm%ChargePlus%ChargePast))/2.0_RKIND)* & + SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) + this%currentValues(this%serializedTimeSize)%minusVoltage = this%sign* & + (((SegmDumm%ChargeMinus%ChargePresent + SegmDumm%ChargeMinus%ChargePast))/2.0_RKIND)* & + SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) + end if + + this%currentValues(this%serializedTimeSize)%voltageDiference = & + this%currentValues(this%serializedTimeSize)%plusVoltage - this%currentValues(this%serializedTimeSize)%minusVoltage + +#if CompileWithBerengerWires + case ('berenger') + this%serializedTimeSize = this%serializedTimeSize + 1 + this%timeStep(this%serializedTimeSize) = step + SegmDumm_Berenger => this%segmentBerenger + + this%currentValues(this%serializedTimeSize)%current = this%sign*SegmDumm_Berenger%currentpast + this%currentValues(this%serializedTimeSize)%deltaVoltage = -SegmDumm_Berenger%field*SegmDumm_Berenger%dl + + this%currentValues(this%serializedTimeSize)%plusVoltage = this%sign* & + (((SegmDumm_Berenger%ChargePlus + SegmDumm_Berenger%ChargePlusPast))/2.0_RKIND)* & + SegmDumm_Berenger%L*(InvMu(SegmDumm_Berenger%imed)*InvEps(SegmDumm_Berenger%imed)) + this%currentValues(this%serializedTimeSize)%minusVoltage = this%sign* & + (((SegmDumm_Berenger%ChargeMinus + SegmDumm_Berenger%ChargeMinusPast))/2.0_RKIND)* & + SegmDumm_Berenger%L*(InvMu(SegmDumm_Berenger%imed)*InvEps(SegmDumm_Berenger%imed)) + this%currentValues(this%serializedTimeSize)%voltageDiference = & + this%currentValues(this%serializedTimeSize)%plusVoltage - this%currentValues(this%serializedTimeSize)%minusVoltage + +#endif + case ('slanted', 'semistructured') + this%serializedTimeSize = this%serializedTimeSize + 1 + this%timeStep(this%serializedTimeSize) = step + SegmDumm_Slanted => this%segmentSlanted + + this%currentValues(this%serializedTimeSize)%current = SegmDumm_Slanted%Currentpast !ojo: slanted ya los orienta bien y no hay que multiplicar por valorsigno + this%currentValues(this%serializedTimeSize)%deltaVoltage = -SegmDumm_Slanted%field*SegmDumm_Slanted%dl + this%currentValues(this%serializedTimeSize)%plusVoltage = & + (((SegmDumm_Slanted%Voltage(iPlus)%ptr%Voltage + SegmDumm_Slanted%Voltage(iPlus)%ptr%VoltagePast))/2.0_RKIND) + this%currentValues(this%serializedTimeSize)%minusVoltage = & + (((SegmDumm_Slanted%Voltage(iMinus)%ptr%Voltage + SegmDumm_Slanted%Voltage(iMinus)%ptr%VoltagePast))/2.0_RKIND) + this%currentValues(this%serializedTimeSize)%voltageDiference = & + this%currentValues(this%serializedTimeSize)%plusVoltage - this%currentValues(this%serializedTimeSize)%minusVoltage + + end select + + end subroutine end module mod_wireCurrentProbeOutput From cec18e367a631a7cd2c99fa1efb722032da93988 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 1 Dec 2025 14:51:09 +0100 Subject: [PATCH 11/67] Added wire_charge_output --- src_output/output.F90 | 27 +++++++-- src_output/point_probe_output.F90 | 2 +- src_output/wire_charge_probe_output.F90 | 76 ++++++++++++++++++++++++ src_output/wire_current_probe_output.F90 | 17 +++++- 4 files changed, 112 insertions(+), 10 deletions(-) create mode 100644 src_output/wire_charge_probe_output.F90 diff --git a/src_output/output.F90 b/src_output/output.F90 index 57bd919f..a5541a5f 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -4,18 +4,21 @@ module output use mod_outputUtils use mod_pointProbeOutput use mod_wireCurrentProbeOutput + use mod_wireChargeProbeOutput implicit none integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0, & - WIRE_CURRENT_PROBE_ID = 0 + WIRE_CURRENT_PROBE_ID = 1, & + WIRE_CHARGE_PROBE_ID = 2 type solver_output_t integer(kind=SINGLE) :: outputID type(point_probe_output_t), allocatable :: pointProbe type(wire_current_probe_output_t), allocatable :: wireCurrentProbe + type(wire_charge_probe_output_t), allocatable :: wireChargeProbe !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !type(far_field_t), allocatable :: farField !type(time_movie_output_t), allocatable :: timeMovie @@ -26,7 +29,8 @@ module output interface init_solver_output module procedure & init_point_probe_output, & - init_wire_current_probe_output + init_wire_current_probe_output, & + init_wire_charge_probe_output !init_bulk_current_probe_output, & !init_far_field, & !initime_movie_output, & @@ -36,7 +40,8 @@ module output interface update_solver_output module procedure & update_point_probe_output, & - update_wire_current_probe_output + update_wire_current_probe_output, & + update_wire_charge_probe_output !update_bulk_current_probe_output, & !update_far_field, & !updateime_movie_output, & @@ -104,9 +109,17 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) outputs(outputCount)%outputID = WIRE_CURRENT_PROBE_ID allocate (outputs(outputCount)%wireCurrentProbe) - call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) + call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) end if - case default + + case (iQx, iQy, iQz) + if(ThereAreWires) then + outputCount = outputCount + 1 + outputs(outputCount)%outputID = WIRE_CHARGE_PROBE_ID + allocate (outputs(outputCount)%wireChargeProbe) + call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) + end if + case default call stoponerror('OutputRequestType type not implemented yet on new observations') end select end do @@ -191,7 +204,9 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d fieldPointer => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos call update_solver_output(outputs(i)%pointProbe, step, fieldPointer) case (WIRE_CURRENT_PROBE_ID) - call update_solver_output(outputs(i)%wireCurrentProbe, control%wiresflavor, control%wirecrank) + call update_solver_output(outputs(i)%wireCurrentProbe, step, control%wiresflavor, control%wirecrank) + case (WIRE_CHARGE_PROBE_ID) + call update_solver_output(outputs(i)%wireChargeProbe, step) case default call stoponerror('Output update not implemented') end select diff --git a/src_output/point_probe_output.F90 b/src_output/point_probe_output.F90 index f79ef792..88a0953d 100644 --- a/src_output/point_probe_output.F90 +++ b/src_output/point_probe_output.F90 @@ -88,7 +88,7 @@ end subroutine init_point_probe_output subroutine update_point_probe_output(this, step, field) type(point_probe_output_t), intent(inout) :: this real(kind=RKIND), pointer, dimension(:, :, :) :: field - real(kind=RKIND_tiempo) :: step + real(kind=RKIND_tiempo), intent(in) :: step integer(kind=SINGLE) :: iter if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then diff --git a/src_output/wire_charge_probe_output.F90 b/src_output/wire_charge_probe_output.F90 new file mode 100644 index 00000000..8d5f7670 --- /dev/null +++ b/src_output/wire_charge_probe_output.F90 @@ -0,0 +1,76 @@ +module mod_wireChargeProbeOutput + use FDETYPES + use mod_domain + use wiresHolland_constants + use HollandWires + implicit none + type wire_charge_probe_output_t + integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: chargeComponent + integer(kind=SINGLE) :: sign = +1 + + type(CurrentSegments), pointer :: segment + + + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + type(rkind), dimension(BuffObse) :: chargeValue + end type wire_current_probe_output_t +contains + + subroutine init_wire_charge_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, media, outputTypeExtension, mpidir,) + type(wire_charge_probe_output_t), intent(out) :: this + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node + integer(kind=SINGLE), intent(in) :: field, mpidir + character(len=BUFSIZE), intent(in) :: outputTypeExtension + type(domain_t), intent(in) :: domain + + type(Thinwires_t), pointer :: Hwireslocal + if (trim(adjustl(wiresflavor))=='holland' .or. trim(adjustl(wiresflavor))=='transition') Hwireslocal => GetHwires() + + call find_segment() + + this%xCoord = iCoord + this%yCoord = jCoord + this%zCoord = kCoord + + this%chargeComponent = field + + this%domain = domain + this%path = get_output_path() + + contains + subroutine find_segment() + logical :: found = .false. + do n = 1, HWireslocal%NumCurrentSegments + currentSegment => HWireslocal%CurrentSegment(n) + if ((currentSegment%origindex == node) .and. & + (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & + (currentSegment%tipofield*10000 == field)) then + found = .true. + this%segment => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do + if (.not. found) then + write (buff, '(a,4i7,a)') 'ERROR: CHARGE probe ', node, iCoord, jCoord, kCoord, ' DOES NOT EXIST' + CALL WarnErrReport(buff, .true.) + end if + end subroutine find_segment + end subroutine init_wire_charge_probe_output + + subroutine update_wire_charge_probe_output(this, step) + type(wire_charge_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + type(CurrentSegments), pointer :: segmDumm + + this%serializedTimeSize = this%serializedTimeSize + 1 + this%timeStep(this%serializedTimeSize) = step + SegmDumm => this%segment + this%chargeValue(this%serializedTimeSize) = SegmDumm%ChargeMinus%ChargePresent + end subroutine update_wire_charge_probe_output + +end module wire_charge_probe_output_t \ No newline at end of file diff --git a/src_output/wire_current_probe_output.F90 b/src_output/wire_current_probe_output.F90 index 5e180a3b..9f2f9e20 100644 --- a/src_output/wire_current_probe_output.F90 +++ b/src_output/wire_current_probe_output.F90 @@ -4,6 +4,15 @@ module mod_wireCurrentProbeOutput use mod_outputUtils use wiresHolland_constants use HollandWires + +#ifdef CompileWithBerengerWires + use WiresBerenger +#endif +#ifdef CompileWithSlantedWires + use WiresSlanted + use WiresSlanted_Types + use WiresSlanted_Constants +#endif implicit none type current_values_t @@ -196,8 +205,9 @@ end function get_probe_bounds_extension end subroutine init_wire_current_probe_output - subroutine update_wire_current_probe_output(this, wiresflavor, wirecrank) + subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank) type(wire_current_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step character(len=*), intent(in) :: wiresflavor logical :: wirecrank @@ -235,7 +245,7 @@ subroutine update_wire_current_probe_output(this, wiresflavor, wirecrank) this%currentValues(this%serializedTimeSize)%voltageDiference = & this%currentValues(this%serializedTimeSize)%plusVoltage - this%currentValues(this%serializedTimeSize)%minusVoltage -#if CompileWithBerengerWires +#ifdef CompileWithBerengerWires case ('berenger') this%serializedTimeSize = this%serializedTimeSize + 1 this%timeStep(this%serializedTimeSize) = step @@ -254,6 +264,7 @@ subroutine update_wire_current_probe_output(this, wiresflavor, wirecrank) this%currentValues(this%serializedTimeSize)%plusVoltage - this%currentValues(this%serializedTimeSize)%minusVoltage #endif +#ifdef CompileWithSlantedWires case ('slanted', 'semistructured') this%serializedTimeSize = this%serializedTimeSize + 1 this%timeStep(this%serializedTimeSize) = step @@ -267,7 +278,7 @@ subroutine update_wire_current_probe_output(this, wiresflavor, wirecrank) (((SegmDumm_Slanted%Voltage(iMinus)%ptr%Voltage + SegmDumm_Slanted%Voltage(iMinus)%ptr%VoltagePast))/2.0_RKIND) this%currentValues(this%serializedTimeSize)%voltageDiference = & this%currentValues(this%serializedTimeSize)%plusVoltage - this%currentValues(this%serializedTimeSize)%minusVoltage - +#endif end select end subroutine From 46643c02a68f5b28ca864c1d61bab3574a7828f9 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 1 Dec 2025 14:51:20 +0100 Subject: [PATCH 12/67] start output tests --- test/CMakeLists.txt | 3 + test/fdtd_tests.cpp | 1 + test/observation/observation_testingTools.F90 | 96 ----- test/output/CMakeLists.txt | 18 + test/output/output_tests.cpp | 1 + test/output/output_tests.h | 6 + test/output/test_output.F90 | 32 ++ test/utils/fdetypes_tools.F90 | 361 +++++++++++++++--- 8 files changed, 360 insertions(+), 158 deletions(-) create mode 100644 test/output/CMakeLists.txt create mode 100644 test/output/output_tests.cpp create mode 100644 test/output/output_tests.h create mode 100644 test/output/test_output.F90 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index c98c7dfb..36bd5c6e 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -23,6 +23,8 @@ if (SEMBA_FDTD_ENABLE_SMBJSON) set(ROTATE_TESTS_LIBRARY rotate_tests) add_subdirectory(vtk) set(VTK_TESTS_LIBRARY vtk_tests) + add_subdirectory(output) + set(OUPUT_TESTS_LIBRARY output_tests) if (NOT SEMBA_FDTD_ENABLE_MPI) add_subdirectory(observation) set(OBSERVATION_TESTS_LIBRARY observation_tests) @@ -41,5 +43,6 @@ target_link_libraries(fdtd_tests ${VTK_TESTS_LIBRARY} ${SYSTEM_TESTS_LIBRARY} ${OBSERVATION_TESTS_LIBRARY} + ${OUPUT_TESTS_LIBRARY} GTest::gtest_main ) \ No newline at end of file diff --git a/test/fdtd_tests.cpp b/test/fdtd_tests.cpp index 209a7a27..324fefd4 100644 --- a/test/fdtd_tests.cpp +++ b/test/fdtd_tests.cpp @@ -8,6 +8,7 @@ #include "smbjson/smbjson_tests.h" #include "rotate/rotate_tests.h" #include "vtk/vtk_tests.h" + #include "output/output_tests.h" #endif #ifndef CompileWithMPI #include "observation/observation_tests.h" diff --git a/test/observation/observation_testingTools.F90 b/test/observation/observation_testingTools.F90 index 1ea7e2f7..772d3b4b 100644 --- a/test/observation/observation_testingTools.F90 +++ b/test/observation/observation_testingTools.F90 @@ -120,100 +120,4 @@ logical function approx_equal(a, b, tol) result(equal) real(kind=RKIND), intent(in) :: a, b, tol equal = abs(a - b) <= tol end function approx_equal - - function create_time_array(array_size, interval) result(arr) - use FDETYPES - integer, intent(in) :: array_size - integer(kind=4) :: i - real(kind=RKIND_tiempo) :: interval - - real(kind=RKIND_tiempo), pointer, dimension(:) :: arr - allocate (arr(array_size)) - - DO i = 1, array_size - arr(i) = (i - 1)*interval - END DO - end function create_time_array - - function create_limit_type() result(r) - use FDETYPES - type(limit_t) :: r - end function - - function create_xyz_limit_array(XI,YI,ZI,XE,YE,ZE) result(arr) - use FDETYPES - type(XYZlimit_t), dimension(1:6) :: arr - integer (kind=4), intent(in) :: XI,YI,ZI,XE,YE,ZE - integer :: i - do i = 1, 6 - arr(i)%XI = XI - arr(i)%XE = XE - arr(i)%YI = YI - arr(i)%YE = YE - arr(i)%ZI = ZI - arr(i)%ZE = ZE - end do - end function create_xyz_limit_array - - - function create_facesNF2FF(tr, fr, iz, de, ab, ar) result(faces) - use FDETYPES - type(nf2ff_t) :: faces - logical :: tr, fr, iz, de, ab, ar - - faces%tr = tr - faces%fr = fr - faces%iz = iz - faces%de = de - faces%ab = ab - faces%ar = ar - end function create_facesNF2FF - - function create_control_flags(layoutnumber, size, mpidir, finaltimestep, & - nEntradaRoot, wiresflavor, & - resume, saveall, NF2FFDecim, simu_devia, singlefilewrite, & - facesNF2FF) result(control) - use FDETYPES - type(sim_control_t) :: control - integer(kind=4), intent(in) :: layoutnumber, size, mpidir, finaltimestep - character(len=*), intent(in) :: nEntradaRoot, wiresflavor - logical, intent(in) :: resume, saveall, NF2FFDecim, simu_devia, singlefilewrite - type(nf2ff_t), intent(in) :: facesNF2FF - - control%layoutnumber = layoutnumber - control%size = size - control%mpidir = mpidir - control%finaltimestep = finaltimestep - control%nEntradaRoot = nEntradaRoot - control%wiresflavor = wiresflavor - control%resume = resume - control%saveall = saveall - control%NF2FFDecim = NF2FFDecim - control%simu_devia = simu_devia - control%singlefilewrite = singlefilewrite - control%facesNF2FF = facesNF2FF - - end function create_control_flags - - function create_base_sgg() result(sgg) - use FDETYPES - type(SGGFDTDINFO) :: sgg - - sgg%NumMedia = 3 - allocate(sgg%Med(1:sgg%NumMedia)) - sgg%Med = create_basic_media() - sgg%NumberRequest = 1 - sgg%dt = 0.1_RKIND_tiempo - sgg%tiempo => create_time_array(100, sgg%dt) - sgg%Sweep = create_xyz_limit_array(0,0,0,6,6,6) - sgg%SINPMLSweep = create_xyz_limit_array(1,1,1,5,5,5) - sgg%NumPlaneWaves = 1 - sgg%alloc = create_xyz_limit_array(0,0,0,6,6,6) - - end function create_base_sgg - - function create_basic_media () result(media) - use FDETYPES - type(MediaData_t) :: media - end function create_basic_media end module diff --git a/test/output/CMakeLists.txt b/test/output/CMakeLists.txt new file mode 100644 index 00000000..259ac35f --- /dev/null +++ b/test/output/CMakeLists.txt @@ -0,0 +1,18 @@ +message(STATUS "Creating build system for test/output") + +add_library( + output_test_fortran + "test_output.F90" +) + +target_link_libraries(output_test_fortran + semba-outputs + test_utils_fortran +) + +add_library(output_tests "output_tests.cpp") + +target_link_libraries(output_tests + output_test_fortran + GTest::gtest +) \ No newline at end of file diff --git a/test/output/output_tests.cpp b/test/output/output_tests.cpp new file mode 100644 index 00000000..0dcc8252 --- /dev/null +++ b/test/output/output_tests.cpp @@ -0,0 +1 @@ +#include "output_tests.h" \ No newline at end of file diff --git a/test/output/output_tests.h b/test/output/output_tests.h new file mode 100644 index 00000000..7d2e5f05 --- /dev/null +++ b/test/output/output_tests.h @@ -0,0 +1,6 @@ +#include + +extern "C" int test_initialize(); + + +TEST(output, test_initialize ) {EXPECT_EQ(0, test_initialize()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 new file mode 100644 index 00000000..05169b93 --- /dev/null +++ b/test/output/test_output.F90 @@ -0,0 +1,32 @@ +integer function test_initialize() bind(C) result(err) + use FDETYPES + use FDETYPES_TOOLS + use output + + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(solver_output_t), dimension(:) :: outputs + logical :: TehereAreWires = .true. + + integer(kind=SINGLE) :: test_err = 0 + + + !Set requested observables + dummysgg = create_base_sgg(nummedia=5, dt=0.1_RKIND_tiempo, time_steps=100) + allocate(dummysgg%Observation(3)) + dummysgg%Observation(1) = define_point_observation() + dummysgg%Observation(2) = define_wire_current_observation() + dummysgg%Observation(3) = define_wire_charge_observation() + + !Set control flags + dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') + + call init_outputs(dummysgg, dummyControl, outputs, ThereAreWires) + + + + + deallocate(dummysgg) + err = test_err +end function test_initialize() + diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index 01ea7fc9..8fed05cb 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -1,63 +1,300 @@ module FDETYPES_TOOLS - use FDETYPES - contains - function create_limit_t(XI,XE,YI,YE,ZI,ZE,NX,NY,NZ) result(r) - type(limit_t) :: r - integer (kind=4), intent(in) :: XI,XE,YI,YE,ZI,ZE,NX,NY,NZ - r%XI = XI - r%XE = XE - r%YI = YI - r%YE = YE - r%ZI = ZI - r%ZE = ZE - r%NX = NX - r%NY = NY - r%NZ = NZ - end function create_limit_t - function create_tag_list(sggAlloc) result(r) - type(XYZlimit_t), dimension(6), intent(in) :: sggAlloc - type(taglist_t) :: r - - - allocate (r%edge%x(sggAlloc(iEx)%XI:sggAlloc(iEx)%XE, sggAlloc(iEx)%YI:sggAlloc(iEx)%YE, sggAlloc(iEx)%ZI:sggAlloc(iEx)%ZE)) - allocate (r%edge%y(sggAlloc(iEy)%XI:sggAlloc(iEy)%XE, sggAlloc(iEy)%YI:sggAlloc(iEy)%YE, sggAlloc(iEy)%ZI:sggAlloc(iEy)%ZE)) - allocate (r%edge%z(sggAlloc(iEz)%XI:sggAlloc(iEz)%XE, sggAlloc(iEz)%YI:sggAlloc(iEz)%YE, sggAlloc(iEz)%ZI:sggAlloc(iEz)%ZE)) - allocate (r%face%x(sggAlloc(iHx)%XI:sggAlloc(iHx)%XE, sggAlloc(iHx)%YI:sggAlloc(iHx)%YE, sggAlloc(iHx)%ZI:sggAlloc(iHx)%ZE)) - allocate (r%face%y(sggAlloc(iHy)%XI:sggAlloc(iHy)%XE, sggAlloc(iHy)%YI:sggAlloc(iHy)%YE, sggAlloc(iHy)%ZI:sggAlloc(iHy)%ZE)) - allocate (r%face%z(sggAlloc(iHz)%XI:sggAlloc(iHz)%XE, sggAlloc(iHz)%YI:sggAlloc(iHz)%YE, sggAlloc(iHz)%ZI:sggAlloc(iHz)%ZE)) - - - r%edge%x(:,:,:) = 0 - r%edge%y(:,:,:) = 0 - r%edge%z(:,:,:) = 0 - r%face%x(:,:,:) = 0 - r%face%y(:,:,:) = 0 - r%face%z(:,:,:) = 0 - end function create_tag_list - - function create_media(sggAlloc) result(r) - type(XYZlimit_t), dimension(6), intent(in) :: sggAlloc - type(media_matrices_t) :: r - - allocate (r%sggMtag(sggAlloc(iHx)%XI:sggAlloc(iHx)%XE, sggAlloc(iHy)%YI:sggAlloc(iHy)%YE, sggAlloc(iHz)%ZI:sggAlloc(iHz)%ZE)) - allocate (r%sggMiNo(sggAlloc(iHx)%XI:sggAlloc(iHx)%XE, sggAlloc(iHy)%YI:sggAlloc(iHy)%YE, sggAlloc(iHz)%ZI:sggAlloc(iHz)%ZE)) - - allocate (r%sggMiEx(sggAlloc(iEx)%XI:sggAlloc(iEx)%XE, sggAlloc(iEx)%YI:sggAlloc(iEx)%YE, sggAlloc(iEx)%ZI:sggAlloc(iEx)%ZE)) - allocate (r%sggMiEy(sggAlloc(iEy)%XI:sggAlloc(iEy)%XE, sggAlloc(iEy)%YI:sggAlloc(iEy)%YE, sggAlloc(iEy)%ZI:sggAlloc(iEy)%ZE)) - allocate (r%sggMiEz(sggAlloc(iEz)%XI:sggAlloc(iEz)%XE, sggAlloc(iEz)%YI:sggAlloc(iEz)%YE, sggAlloc(iEz)%ZI:sggAlloc(iEz)%ZE)) - - allocate (r%sggMiHx(sggAlloc(iHx)%XI:sggAlloc(iHx)%XE, sggAlloc(iHx)%YI:sggAlloc(iHx)%YE, sggAlloc(iHx)%ZI:sggAlloc(iHx)%ZE)) - allocate (r%sggMiHy(sggAlloc(iHy)%XI:sggAlloc(iHy)%XE, sggAlloc(iHy)%YI:sggAlloc(iHy)%YE, sggAlloc(iHy)%ZI:sggAlloc(iHy)%ZE)) - allocate (r%sggMiHz(sggAlloc(iHz)%XI:sggAlloc(iHz)%XE, sggAlloc(iHz)%YI:sggAlloc(iHz)%YE, sggAlloc(iHz)%ZI:sggAlloc(iHz)%ZE)) - - r%sggMtag (:, :, :) = 0 - r%sggMiNo (:, :, :) = 1 - r%sggMiEx (:, :, :) = 1 - r%sggMiEy (:, :, :) = 1 - r%sggMiEz (:, :, :) = 1 - r%sggMiHx (:, :, :) = 1 - r%sggMiHy (:, :, :) = 1 - r%sggMiHz (:, :, :) = 1 - end function create_media - -end module FDETYPES_TOOLS \ No newline at end of file + use FDETYPES +contains + function create_limit_t(XI, XE, YI, YE, ZI, ZE, NX, NY, NZ) result(r) + type(limit_t) :: r + integer(kind=4), intent(in) :: XI, XE, YI, YE, ZI, ZE, NX, NY, NZ + r%XI = XI + r%XE = XE + r%YI = YI + r%YE = YE + r%ZI = ZI + r%ZE = ZE + r%NX = NX + r%NY = NY + r%NZ = NZ + end function create_limit_t + function create_tag_list(sggAlloc) result(r) + type(XYZlimit_t), dimension(6), intent(in) :: sggAlloc + type(taglist_t) :: r + + allocate (r%edge%x(sggAlloc(iEx)%XI:sggAlloc(iEx)%XE, sggAlloc(iEx)%YI:sggAlloc(iEx)%YE, sggAlloc(iEx)%ZI:sggAlloc(iEx)%ZE)) + allocate (r%edge%y(sggAlloc(iEy)%XI:sggAlloc(iEy)%XE, sggAlloc(iEy)%YI:sggAlloc(iEy)%YE, sggAlloc(iEy)%ZI:sggAlloc(iEy)%ZE)) + allocate (r%edge%z(sggAlloc(iEz)%XI:sggAlloc(iEz)%XE, sggAlloc(iEz)%YI:sggAlloc(iEz)%YE, sggAlloc(iEz)%ZI:sggAlloc(iEz)%ZE)) + allocate (r%face%x(sggAlloc(iHx)%XI:sggAlloc(iHx)%XE, sggAlloc(iHx)%YI:sggAlloc(iHx)%YE, sggAlloc(iHx)%ZI:sggAlloc(iHx)%ZE)) + allocate (r%face%y(sggAlloc(iHy)%XI:sggAlloc(iHy)%XE, sggAlloc(iHy)%YI:sggAlloc(iHy)%YE, sggAlloc(iHy)%ZI:sggAlloc(iHy)%ZE)) + allocate (r%face%z(sggAlloc(iHz)%XI:sggAlloc(iHz)%XE, sggAlloc(iHz)%YI:sggAlloc(iHz)%YE, sggAlloc(iHz)%ZI:sggAlloc(iHz)%ZE)) + + r%edge%x(:, :, :) = 0 + r%edge%y(:, :, :) = 0 + r%edge%z(:, :, :) = 0 + r%face%x(:, :, :) = 0 + r%face%y(:, :, :) = 0 + r%face%z(:, :, :) = 0 + end function create_tag_list + + function create_media(sggAlloc) result(r) + type(XYZlimit_t), dimension(6), intent(in) :: sggAlloc + type(media_matrices_t) :: r + + allocate (r%sggMtag(sggAlloc(iHx)%XI:sggAlloc(iHx)%XE, sggAlloc(iHy)%YI:sggAlloc(iHy)%YE, sggAlloc(iHz)%ZI:sggAlloc(iHz)%ZE)) + allocate (r%sggMiNo(sggAlloc(iHx)%XI:sggAlloc(iHx)%XE, sggAlloc(iHy)%YI:sggAlloc(iHy)%YE, sggAlloc(iHz)%ZI:sggAlloc(iHz)%ZE)) + + allocate (r%sggMiEx(sggAlloc(iEx)%XI:sggAlloc(iEx)%XE, sggAlloc(iEx)%YI:sggAlloc(iEx)%YE, sggAlloc(iEx)%ZI:sggAlloc(iEx)%ZE)) + allocate (r%sggMiEy(sggAlloc(iEy)%XI:sggAlloc(iEy)%XE, sggAlloc(iEy)%YI:sggAlloc(iEy)%YE, sggAlloc(iEy)%ZI:sggAlloc(iEy)%ZE)) + allocate (r%sggMiEz(sggAlloc(iEz)%XI:sggAlloc(iEz)%XE, sggAlloc(iEz)%YI:sggAlloc(iEz)%YE, sggAlloc(iEz)%ZI:sggAlloc(iEz)%ZE)) + + allocate (r%sggMiHx(sggAlloc(iHx)%XI:sggAlloc(iHx)%XE, sggAlloc(iHx)%YI:sggAlloc(iHx)%YE, sggAlloc(iHx)%ZI:sggAlloc(iHx)%ZE)) + allocate (r%sggMiHy(sggAlloc(iHy)%XI:sggAlloc(iHy)%XE, sggAlloc(iHy)%YI:sggAlloc(iHy)%YE, sggAlloc(iHy)%ZI:sggAlloc(iHy)%ZE)) + allocate (r%sggMiHz(sggAlloc(iHz)%XI:sggAlloc(iHz)%XE, sggAlloc(iHz)%YI:sggAlloc(iHz)%YE, sggAlloc(iHz)%ZI:sggAlloc(iHz)%ZE)) + + r%sggMtag(:, :, :) = 0 + r%sggMiNo(:, :, :) = 1 + r%sggMiEx(:, :, :) = 1 + r%sggMiEy(:, :, :) = 1 + r%sggMiEz(:, :, :) = 1 + r%sggMiHx(:, :, :) = 1 + r%sggMiHy(:, :, :) = 1 + r%sggMiHz(:, :, :) = 1 + end function create_media + + function create_control_flags(layoutnumber, size, mpidir, finaltimestep, & + nEntradaRoot, wiresflavor, wirecrank, & + resume, saveall, NF2FFDecim, simu_devia, singlefilewrite, & + facesNF2FF) result(control) + + type(sim_control_t) :: control + + integer(kind=SINGLE), intent(in), optional :: layoutnumber, size, mpidir, finaltimestep + character(len=*), intent(in), optional :: nEntradaRoot, wiresflavor + logical, intent(in), optional :: wirecrank, resume, saveall, NF2FFDecim, simu_devia, singlefilewrite + type(nf2ff_t), intent(in), optional :: facesNF2FF + + ! 1. Set explicit defaults for all components + control%layoutnumber = 0 + control%size = 0 + control%mpidir = 0 + control%finaltimestep = 0 + control%nEntradaRoot = "" + control%wiresflavor = "" + control%wirecrank = .false. + control%resume = .false. + control%saveall = .false. + control%NF2FFDecim = .false. + control%simu_devia = .false. + control%singlefilewrite = .false. + ! Note: control%facesNF2FF retains its default initialized state + + ! 2. Overwrite defaults only if the optional argument is present + if (present(layoutnumber)) control%layoutnumber = layoutnumber + if (present(size)) control%size = size + if (present(mpidir)) control%mpidir = mpidir + if (present(finaltimestep)) control%finaltimestep = finaltimestep + if (present(nEntradaRoot)) control%nEntradaRoot = nEntradaRoot + if (present(wiresflavor)) control%wiresflavor = wiresflavor + if (present(wiresflavor)) control%wirecrank = wirecrank + if (present(resume)) control%resume = resume + if (present(saveall)) control%saveall = saveall + if (present(NF2FFDecim)) control%NF2FFDecim = NF2FFDecim + if (present(simu_devia)) control%simu_devia = simu_devia + if (present(singlefilewrite)) control%singlefilewrite = singlefilewrite + if (present(facesNF2FF)) control%facesNF2FF = facesNF2FF + + end function create_control_flags + + function create_base_sgg(NumMedia, dt, time_steps) result(sgg) + type(SGGFDTDINFO) :: sgg + integer, optional, intent(in) :: NumMedia, time_steps + real(kind=RKIND_tiempo), optional, intent(in) :: dt + + sgg%NumMedia = merge(NumMedia, 3, present(NumMedia)) + allocate (sgg%Med(1:sgg%NumMedia)) + sgg%Med = create_basic_media() + sgg%NumberRequest = 1 + sgg%dt = merge(dt, 0.1_RKIND_tiempo, present(dt)) + + ! Use the new optional-aware create_time_array + sgg%tiempo = create_time_array(merge(time_steps, 100, present(time_steps)), sgg%dt) + + ! Hardcoded array limits now call the optional-aware function + sgg%Sweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + sgg%SINPMLSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) + sgg%NumPlaneWaves = 1 + sgg%alloc = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + + end function create_base_sgg + + function create_time_array(array_size, interval) result(arr) + integer, intent(in), optional :: array_size + real(kind=RKIND_tiempo), intent(in), optional :: interval + integer(kind=4) :: i + integer :: size_val + real(kind=RKIND_tiempo) :: interval_val + real(kind=RKIND_tiempo), allocatable, dimension(:) :: arr + + size_val = merge(array_size, 100, present(array_size)) + interval_val = merge(interval, 1.0_RKIND_tiempo, present(interval)) + + + + allocate (arr(size_val)) + + DO i = 1, size_val + arr(i) = (i - 1)*interval_val + END DO + end function create_time_array + + function create_limit_type() result(r) + type(limit_t) :: r + end function create_limit_type + + function create_xyz_limit_array(XI, YI, ZI, XE, YE, ZE) result(arr) + type(XYZlimit_t), dimension(1:6) :: arr + integer(kind=4), intent(in), optional :: XI, YI, ZI, XE, YE, ZE + integer :: i + integer(kind=4) :: xi_val, yi_val, zi_val, xe_val, ye_val, ze_val + + ! Use merge for compact handling of optional inputs with defaults + xi_val = merge(XI, 0, present(XI)) + yi_val = merge(YI, 0, present(YI)) + zi_val = merge(ZI, 0, present(ZI)) + xe_val = merge(XE, 6, present(XE)) + ye_val = merge(YE, 6, present(YE)) + ze_val = merge(ZE, 6, present(ZE)) + + do i = 1, 6 + arr(i)%XI = xi_val + arr(i)%XE = xe_val + arr(i)%YI = yi_val + arr(i)%YE = ye_val + arr(i)%ZI = zi_val + arr(i)%ZE = ze_val + end do + end function create_xyz_limit_array + + function create_facesNF2FF(tr, fr, iz, de, ab, ar) result(faces) + type(nf2ff_t) :: faces + logical, intent(in), optional :: tr, fr, iz, de, ab, ar + + faces%tr = .false. + faces%fr = .false. + faces%iz = .false. + faces%de = .false. + faces%ab = .false. + faces%ar = .false. + + if (present(tr)) faces%tr = tr + if (present(fr)) faces%fr = fr + if (present(iz)) faces%iz = iz + if (present(de)) faces%de = de + if (present(ab)) faces%ab = ab + if (present(ar)) faces%ar = ar + end function create_facesNF2FF + + function create_basic_media() result(media) + type(MediaData_t) :: media + end function create_basic_media + + function define_point_observation() result(obs) + type(Obses_t) :: obs + + obs%nP = 1 + allocate (obs%P(obs%nP)) + obs%P(1) = create_observable(1_SINGLE, 1_SINGLE, 1_SINGLE, 1_SINGLE, 1_SINGLE, 1_SINGLE, iEx) + + obs%InitialTime = 0.0_RKIND_tiempo + obs%FinalTime = 1.0_RKIND_tiempo + obs%TimeStep = 0.1_RKIND_tiempo + + obs%InitialFreq = 0.0_RKIND + obs%FinalFreq = 0.0_RKIND + obs%FreqStep = 0.0_RKIND + + obs%outputrequest = 'pointProbe' + + obs%FreqDomain = .false. + obs%TimeDomain = .true. + obs%Saveall = .false. + obs%TransFer = .false. + obs%Volumic = .false. + obs%Done = .false. + obs%Begun = .false. + obs%Flushed = .false. + + end function define_point_observation + + function define_wire_current_observation() result(obs) + type(Obses_t) :: obs + + obs%nP = 1 + allocate (obs%P(obs%nP)) + obs%P(1) = create_observable(3_SINGLE, 3_SINGLE, 3_SINGLE, 3_SINGLE, 3_SINGLE, 3_SINGLE, iJx) + + obs%InitialTime = 0.0_RKIND_tiempo + obs%FinalTime = 1.0_RKIND_tiempo + obs%TimeStep = 0.1_RKIND_tiempo + + obs%InitialFreq = 0.0_RKIND + obs%FinalFreq = 0.0_RKIND + obs%FreqStep = 0.0_RKIND + + obs%outputrequest = 'pointProbe' + + obs%FreqDomain = .false. + obs%TimeDomain = .true. + obs%Saveall = .false. + obs%TransFer = .false. + obs%Volumic = .false. + obs%Done = .false. + obs%Begun = .false. + obs%Flushed = .false. + end function define_wire_current_observation + + + function define_wire_charge_observation() result(obs) + type(Obses_t) :: obs + + obs%nP = 1 + allocate (obs%P(obs%nP)) + obs%P(1) = create_observable(3_SINGLE, 3_SINGLE, 3_SINGLE, 3_SINGLE, 3_SINGLE, 3_SINGLE, iQx) + + obs%InitialTime = 0.0_RKIND_tiempo + obs%FinalTime = 1.0_RKIND_tiempo + obs%TimeStep = 0.1_RKIND_tiempo + + obs%InitialFreq = 0.0_RKIND + obs%FinalFreq = 0.0_RKIND + obs%FreqStep = 0.0_RKIND + + obs%outputrequest = 'pointProbe' + + obs%FreqDomain = .false. + obs%TimeDomain = .true. + obs%Saveall = .false. + obs%TransFer = .false. + obs%Volumic = .false. + obs%Done = .false. + obs%Begun = .false. + obs%Flushed = .false. + end function define_wire_charge_observation + + function create_observable(XI,YI,ZI,XE,YE,ZE, what) result(observable) + type(observable_t) :: observable + integer (kind=4) :: XI,YI,ZI,XE,YE,ZE, what + + observable%XI = XI + observable%YI = YI + observable%ZI = ZI + + observable%XE = XE + observable%YE = YE + observable%ZE = ZE + + observable%Xtrancos = 1 + observable%Ytrancos = 1 + observable%Ztrancos = 1 + + observable%What = what + end function create_observable + +end module FDETYPES_TOOLS From 1520fe6ce7afb967bbb52fedb8d1d169eef6cafc Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 1 Dec 2025 16:16:40 +0100 Subject: [PATCH 13/67] Fix compilation errors --- src_output/CMakeLists.txt | 1 + src_output/output.F90 | 31 ++++++----- src_output/outputUtils.F90 | 3 +- src_output/point_probe_output.F90 | 4 +- src_output/wire_charge_probe_output.F90 | 57 +++++++++++++++++--- src_output/wire_current_probe_output.F90 | 5 +- test/observation/test_observation_init.F90 | 4 +- test/observation/test_observation_update.F90 | 4 +- test/observation/test_preprocess.F90 | 8 +++ test/output/CMakeLists.txt | 1 + test/output/output_tests.h | 3 +- test/output/test_output.F90 | 45 ++++++++-------- test/utils/fdetypes_tools.F90 | 4 +- 13 files changed, 111 insertions(+), 59 deletions(-) diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index d028369a..c64b5920 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -4,5 +4,6 @@ add_library(fdtd-output "outputUtils.F90" "point_probe_output.F90" "wire_current_probe_output.F90" + "wire_charge_probe_output.F90" ) target_link_libraries(fdtd-output semba-types ) \ No newline at end of file diff --git a/src_output/output.F90 b/src_output/output.F90 index a5541a5f..cf8447c2 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -7,13 +7,14 @@ module output use mod_wireChargeProbeOutput implicit none - - integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0, & WIRE_CURRENT_PROBE_ID = 1, & WIRE_CHARGE_PROBE_ID = 2 + REAL(KIND=RKIND), save :: eps0, mu0 + REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu + type solver_output_t integer(kind=SINGLE) :: outputID type(point_probe_output_t), allocatable :: pointProbe @@ -25,7 +26,6 @@ module output !type(frequency_slice_output_t), allocatable :: frequencySlice end type solver_output_t - interface init_solver_output module procedure & init_point_probe_output, & @@ -82,7 +82,11 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) character(len=BUFSIZE) :: outputTypeExtension allocate (outputs(sgg%NumberRequest)) - call retrive_wires_data() + allocate (InvEps(0:sgg%NumMedia), InvMu(0:sgg%NumMedia)) + + InvEps(0:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia)%Epr) + InvMu(0:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia)%Mur) + do ii = 1, sgg%NumberRequest do i = 1, sgg%Observation(ii)%nP @@ -101,7 +105,7 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) outputs(outputCount)%outputID = POINT_PROBE_ID allocate (outputs(outputCount)%pointProbe) - call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir) +call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir) case (iJx, iJy, iJz) if (ThereAreWires) then @@ -111,16 +115,16 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) allocate (outputs(outputCount)%wireCurrentProbe) call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) end if - + case (iQx, iQy, iQz) - if(ThereAreWires) then + if (ThereAreWires) then outputCount = outputCount + 1 outputs(outputCount)%outputID = WIRE_CHARGE_PROBE_ID allocate (outputs(outputCount)%wireChargeProbe) call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) - end if - case default - call stoponerror('OutputRequestType type not implemented yet on new observations') + end if + case default + call stoponerror(0,0,'OutputRequestType type not implemented yet on new observations') end select end do end do @@ -168,7 +172,7 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep newDomain%fnum = int((newDomain%fstop - newDomain%fstart)/newDomain%fstep, kind=SINGLE) else - call stoponerror('No domain present') + call stoponerror(0,0,'No domain present') end if return end function preprocess_domain @@ -204,11 +208,11 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d fieldPointer => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos call update_solver_output(outputs(i)%pointProbe, step, fieldPointer) case (WIRE_CURRENT_PROBE_ID) - call update_solver_output(outputs(i)%wireCurrentProbe, step, control%wiresflavor, control%wirecrank) + call update_solver_output(outputs(i)%wireCurrentProbe, step, control%wiresflavor, control%wirecrank, InvEps, InvMu) case (WIRE_CHARGE_PROBE_ID) call update_solver_output(outputs(i)%wireChargeProbe, step) case default - call stoponerror('Output update not implemented') + call stoponerror(0,0,'Output update not implemented') end select end do @@ -228,5 +232,4 @@ end function get_field_component end subroutine update_outputs - end module output diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 2b356d4e..5c48a649 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -1,6 +1,7 @@ module mod_outputUtils use FDETYPES use mod_domain + use report implicit none character(len=4), parameter :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' integer(kind=SINGLE), parameter :: FILE_UNIT = 400 @@ -78,7 +79,7 @@ function get_rotated_prefix(field, mpidir) result(prefixExtension) case default; prefixExtension = prefix(field) end select else - call stoponerror('Buggy error in mpidir. ') + call stoponerror(0,0,"Buggy error in mpidir.") end if return end function get_rotated_prefix diff --git a/src_output/point_probe_output.F90 b/src_output/point_probe_output.F90 index 88a0953d..cd828fbc 100644 --- a/src_output/point_probe_output.F90 +++ b/src_output/point_probe_output.F90 @@ -117,7 +117,7 @@ subroutine flush_point_probe_output(this) timeUnitFile = FILE_UNIT + 1 status = open_file(timeUnitFile, timeFileName) - if (status /= 0) call stoponerror('Failed to open timeDomainFile. ') + if (status /= 0) call stoponerror(0,0,'Failed to open timeDomainFile. ') do i = 1, this%serializedTimeSize write (timeUnitFile, '(F12.4, 2X, F12.4)') this%timeStep(i), this%valueForTime(i) @@ -131,7 +131,7 @@ subroutine flush_point_probe_output(this) frequencyUnitFile = FILE_UNIT + 2 OPEN (UNIT=frequencyUnitFile, FILE=frequencyFileName, STATUS='REPLACE', ACTION='WRITE', iostat=status) - if (status /= 0) call stoponerror('Failed to open frequencyDomainFile. ') + if (status /= 0) call stoponerror(0,0, 'Failed to open frequencyDomainFile. ') do i = 1, this%nFreq write (frequencyUnitFile, '(F12.4, 2X, F12.4)') this%frequencySlice(i), this%valueForFreq(i) diff --git a/src_output/wire_charge_probe_output.F90 b/src_output/wire_charge_probe_output.F90 index 8d5f7670..0c5cd413 100644 --- a/src_output/wire_charge_probe_output.F90 +++ b/src_output/wire_charge_probe_output.F90 @@ -1,6 +1,7 @@ module mod_wireChargeProbeOutput use FDETYPES use mod_domain + use mod_outputUtils use wiresHolland_constants use HollandWires implicit none @@ -17,18 +18,21 @@ module mod_wireChargeProbeOutput integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - type(rkind), dimension(BuffObse) :: chargeValue - end type wire_current_probe_output_t + real(kind=RKIND), dimension(BuffObse) :: chargeValue + end type wire_charge_probe_output_t contains - subroutine init_wire_charge_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, media, outputTypeExtension, mpidir,) + subroutine init_wire_charge_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, outputTypeExtension, mpidir, wiresflavor) type(wire_charge_probe_output_t), intent(out) :: this integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node integer(kind=SINGLE), intent(in) :: field, mpidir - character(len=BUFSIZE), intent(in) :: outputTypeExtension + character(len=*), intent(in) :: outputTypeExtension, wiresflavor type(domain_t), intent(in) :: domain type(Thinwires_t), pointer :: Hwireslocal + type(CurrentSegments), pointer :: currentSegment + character(len=BUFSIZE) :: buff + integer(kind=SINGLE) :: n if (trim(adjustl(wiresflavor))=='holland' .or. trim(adjustl(wiresflavor))=='transition') Hwireslocal => GetHwires() call find_segment() @@ -60,10 +64,51 @@ subroutine find_segment() CALL WarnErrReport(buff, .true.) end if end subroutine find_segment + + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: outputPath + character(len=BUFSIZE) :: charNO + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension, prefixNodeExtension + + write (charNO, '(i7)') node + prefixNodeExtension = 's'//trim(adjustl(charNO)) + probeBoundsExtension = get_probe_bounds_extension() + prefixFieldExtension = get_prefix_extension(field, mpidir) + + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_' & + //trim(adjustl(probeBoundsExtension))//'_'//trim(adjustl(prefixNodeExtension)) + return + end function get_output_path + + function get_probe_bounds_extension() result(ext) + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + +#if CompileWithMPI + if (mpidir == 3) then + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + elseif (mpidir == 2) then + ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) + elseif (mpidir == 1) then + ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) + else + call stoponerror('Buggy error in mpidir. ') + end if +#else + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) +#endif + + return + end function get_probe_bounds_extension end subroutine init_wire_charge_probe_output subroutine update_wire_charge_probe_output(this, step) - type(wire_charge_probe_output_t), intent(inout) :: this + type(wire_charge_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step type(CurrentSegments), pointer :: segmDumm @@ -73,4 +118,4 @@ subroutine update_wire_charge_probe_output(this, step) this%chargeValue(this%serializedTimeSize) = SegmDumm%ChargeMinus%ChargePresent end subroutine update_wire_charge_probe_output -end module wire_charge_probe_output_t \ No newline at end of file +end module mod_wireChargeProbeOutput \ No newline at end of file diff --git a/src_output/wire_current_probe_output.F90 b/src_output/wire_current_probe_output.F90 index 9f2f9e20..aa7117a3 100644 --- a/src_output/wire_current_probe_output.F90 +++ b/src_output/wire_current_probe_output.F90 @@ -205,11 +205,12 @@ end function get_probe_bounds_extension end subroutine init_wire_current_probe_output - subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank) + subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank, InvEps, InvMu) type(wire_current_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step character(len=*), intent(in) :: wiresflavor - logical :: wirecrank + logical, intent(in) :: wirecrank + real(KIND=RKIND), pointer, dimension(:), intent(in) :: InvEps, InvMu type(CurrentSegments), pointer :: segmDumm #ifdef CompileWithBerengerWires diff --git a/test/observation/test_observation_init.F90 b/test/observation/test_observation_init.F90 index 69135a38..85e65483 100644 --- a/test/observation/test_observation_init.F90 +++ b/test/observation/test_observation_init.F90 @@ -35,9 +35,7 @@ integer function test_init_time_movie_observation() bind(C) result(err) SINPML_fullsize = create_limit_t(0,4,0,4,0,4,3,3,3) facesNF2FF = create_facesNF2FF(.false., .false., .false., .false., .false., .false.) - control = create_control_flags(0, 0, 3, 10, "entryRoot", "wireflavour",& - .false., .false., .false., .false., .false.,& - facesNF2FF) + control = create_control_flags(nEntradaRoot="entryRoot", wiresflavor="wiresflavour",facesNF2FF=facesNF2FF) call InitObservation(sgg, media, tag_numbers, & ThereAreObservation, ThereAreWires, ThereAreFarFields,& diff --git a/test/observation/test_observation_update.F90 b/test/observation/test_observation_update.F90 index 1e96261f..3aa2b71f 100644 --- a/test/observation/test_observation_update.F90 +++ b/test/observation/test_observation_update.F90 @@ -37,9 +37,7 @@ integer function test_update_time_movie_observation() bind(C) result(err) SINPML_fullsize = create_limit_t(0,4,0,4,0,4,3,3,3) facesNF2FF = create_facesNF2FF(.false., .false., .false., .false., .false., .false.) - control = create_control_flags(0, 0, 3, 10, "entryRoot", "wireflavour",& - .false., .false., .false., .false., .false.,& - facesNF2FF) + control = create_control_flags(nEntradaRoot="entryRoot", wiresflavor="wireflavour", facesNF2FF=facesNF2FF) call InitObservation(sgg, media, tag_numbers, & ThereAreObservation, ThereAreWires, ThereAreFarFields,& diff --git a/test/observation/test_preprocess.F90 b/test/observation/test_preprocess.F90 index 79467ddb..261a517f 100644 --- a/test/observation/test_preprocess.F90 +++ b/test/observation/test_preprocess.F90 @@ -2,6 +2,7 @@ integer function test_initial_time_less_than_timestep() bind(C) result(err) use observation_testingTools use FDETYPES use OBSERVA + use FDETYPES_TOOLS type(Obses_t) :: obs type(output_t) :: out @@ -42,6 +43,7 @@ integer function test_timestep_greater_and_mapvtk() bind(C) result(err) use observation_testingTools use FDETYPES use OBSERVA + use FDETYPES_TOOLS type(Obses_t) :: obs type(output_t) :: out @@ -87,6 +89,7 @@ integer function test_timestep_greater_not_mapvtk() bind(C) result(err) use observation_testingTools use FDETYPES use OBSERVA + use FDETYPES_TOOLS type(Obses_t) :: obs type(output_t) :: out @@ -128,6 +131,7 @@ integer function test_freqstep_zero_or_large() bind(C) result(err) use observation_testingTools use FDETYPES use OBSERVA + use FDETYPES_TOOLS type(Obses_t) :: obs type(output_t) :: out @@ -179,6 +183,7 @@ integer function test_volumic_false_true_and_saveall() bind(C) result(err) use observation_testingTools use FDETYPES use OBSERVA + use FDETYPES_TOOLS type(Obses_t) :: obs type(output_t) :: out @@ -230,6 +235,7 @@ integer function test_saveall_branch() bind(C) result(err) use observation_testingTools use FDETYPES use OBSERVA + use FDETYPES_TOOLS type(Obses_t) :: obs type(output_t) :: out @@ -268,6 +274,7 @@ integer function test_final_less_than_initial() bind(C) result(err) use observation_testingTools use FDETYPES use OBSERVA + use FDETYPES_TOOLS type(Obses_t) :: obs type(output_t) :: out @@ -304,6 +311,7 @@ integer function test_huge_cap() bind(C) result(err) use observation_testingTools use FDETYPES use OBSERVA + use FDETYPES_TOOLS type(Obses_t) :: obs type(output_t) :: out diff --git a/test/output/CMakeLists.txt b/test/output/CMakeLists.txt index 259ac35f..3c66ad8a 100644 --- a/test/output/CMakeLists.txt +++ b/test/output/CMakeLists.txt @@ -7,6 +7,7 @@ add_library( target_link_libraries(output_test_fortran semba-outputs + fdtd-output test_utils_fortran ) diff --git a/test/output/output_tests.h b/test/output/output_tests.h index 7d2e5f05..54107b97 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -2,5 +2,4 @@ extern "C" int test_initialize(); - -TEST(output, test_initialize ) {EXPECT_EQ(0, test_initialize()); } +TEST(output, test_initialize) {EXPECT_EQ(0, test_initialize()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 05169b93..266de664 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -1,32 +1,29 @@ -integer function test_initialize() bind(C) result(err) - use FDETYPES - use FDETYPES_TOOLS - use output +function test_initialize() bind(C) result(err) + use FDETYPES + use FDETYPES_TOOLS + use output - type(SGGFDTDINFO) :: dummysgg - type(sim_control_t) :: dummyControl - type(solver_output_t), dimension(:) :: outputs - logical :: TehereAreWires = .true. + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(solver_output_t), dimension(:), allocatable :: outputs + logical :: ThereAreWires = .true. - integer(kind=SINGLE) :: test_err = 0 + integer(kind=SINGLE) :: test_err = 0 + !Set requested observables + dummysgg = create_base_sgg(nummedia=5, dt=0.1_RKIND_tiempo, time_steps=100) + allocate (dummysgg%Observation(3)) + dummysgg%Observation(1) = define_point_observation() + dummysgg%Observation(2) = define_wire_current_observation() + dummysgg%Observation(3) = define_wire_charge_observation() - !Set requested observables - dummysgg = create_base_sgg(nummedia=5, dt=0.1_RKIND_tiempo, time_steps=100) - allocate(dummysgg%Observation(3)) - dummysgg%Observation(1) = define_point_observation() - dummysgg%Observation(2) = define_wire_current_observation() - dummysgg%Observation(3) = define_wire_charge_observation() + !Set control flags + dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') - !Set control flags - dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') + call init_outputs(dummysgg, dummyControl, outputs, ThereAreWires) - call init_outputs(dummysgg, dummyControl, outputs, ThereAreWires) - - - - - deallocate(dummysgg) + deallocate (dummysgg%Observation) + deallocate (outputs) err = test_err -end function test_initialize() +end function test_initialize diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index 8fed05cb..cf7335a3 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -73,7 +73,7 @@ function create_control_flags(layoutnumber, size, mpidir, finaltimestep, & ! 1. Set explicit defaults for all components control%layoutnumber = 0 control%size = 0 - control%mpidir = 0 + control%mpidir = 3 control%finaltimestep = 0 control%nEntradaRoot = "" control%wiresflavor = "" @@ -130,7 +130,7 @@ function create_time_array(array_size, interval) result(arr) integer(kind=4) :: i integer :: size_val real(kind=RKIND_tiempo) :: interval_val - real(kind=RKIND_tiempo), allocatable, dimension(:) :: arr + real(kind=RKIND_tiempo), pointer, dimension(:) :: arr size_val = merge(array_size, 100, present(array_size)) interval_val = merge(interval, 1.0_RKIND_tiempo, present(interval)) From a67c746128a97ee531b7793215ecad4d7bd0043e Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 2 Dec 2025 08:57:20 +0100 Subject: [PATCH 14/67] Added bulk probe update method --- src_output/bulk_probe_output.F90 | 206 +++++++++++++++++++++++++++++++ src_output/output.F90 | 75 ++++++++--- src_output/outputUtils.F90 | 51 ++++++-- test/output/test_output.F90 | 1 + test/utils/fdetypes_tools.F90 | 7 +- 5 files changed, 307 insertions(+), 33 deletions(-) create mode 100644 src_output/bulk_probe_output.F90 diff --git a/src_output/bulk_probe_output.F90 b/src_output/bulk_probe_output.F90 new file mode 100644 index 00000000..9d7eb7ac --- /dev/null +++ b/src_output/bulk_probe_output.F90 @@ -0,0 +1,206 @@ +module mod_bulkProbe + use FDETYPES + use FDETYPES_TOOLS + use mod_domain + use mod_outputUtils + implicit none + + type bulk_probe_output_t + integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + integer(kind=SINGLE) :: x2Coord, y2Coord, z2Coord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: fieldComponent + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND + + end type bulk_probe_output_t + +contains + + subroutine init_bulk_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, field, domain, outputTypeExtension, mpidir) + type(bulk_probe_output_t), intent(out) :: this + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord + integer(kind=SINGLE), intent(in) :: i2Coord, j2Coord, k2Coord + integer(kind=SINGLE), intent(in) :: mpidir, field + character(len=BUFSIZE), intent(in) :: outputTypeExtension + type(domain_t), intent(in) :: domain + + integer(kind=SINGLE) :: i + + this%xCoord = iCoord + this%yCoord = jCoord + this%zCoord = kCoord + + this%x2Coord = i2Coord + this%y2Coord = j2Coord + this%z2Coord = k2Coord + + this%fieldComponent = field + + this%domain = domain + this%path = get_output_path() + + contains + + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_probe_bounds_extension() + prefixFieldExtension = get_prefix_extension(field, mpidir) + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension)) + return + end function get_output_path + + function get_probe_bounds_extension() result(ext) + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark, chari2, charj2, chark2 + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + + write (chari2, '(i7)') i2Coord + write (charj2, '(i7)') j2Coord + write (chark2, '(i7)') k2Coord + +#if CompileWithMPI + if (mpidir == 3) then + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark))//'__'// & + trim(adjustl(chari2))//'_'//trim(adjustl(charj2))//'_'//trim(adjustl(chark2)) + elseif (mpidir == 2) then + ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari))//'__'// & + trim(adjustl(charj2))//'_'//trim(adjustl(chark2))//'_'//trim(adjustl(chari2)) + elseif (mpidir == 1) then + ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj))//'__'// & + trim(adjustl(chark2))//'_'//trim(adjustl(chari2))//'_'//trim(adjustl(charj2)) + else + call stoponerror('Buggy error in mpidir. ') + end if +#else + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark))//'__'// & + trim(adjustl(chari2))//'_'//trim(adjustl(charj2))//'_'//trim(adjustl(chark2)) +#endif + + return + end function get_probe_bounds_extension + + end subroutine init_bulk_probe_output + + subroutine update_bulk_probe_output(this, step, field) + type(bulk_probe_output_t), intent(out) :: 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 + + real(kind=RKIND), pointer, dimension(:,:,:) :: xF, yF, zF + real(kind=RKIND), pointer, dimension(:) :: dx, dy, dz + + i1_m = this%xCoord + i2_m = this%x2Coord + j1_m = this%yCoord + j2_m = this%y2Coord + k1_m = this%zCoord + k2_m = this%z2Coord + + i1 = i1_m + j1 = i2_m + k1 = j1_m + i2 = j2_m + j2 = k1_m + k2 = k2_m + + xF => field%x + yF => field%y + zF => field%z + dx => field%deltaX + dy => field%deltaY + dz => field%deltaZ + + + this%serializedTimeSize = this%serializedTimeSize + 1 + this%timeStep(this%serializedTimeSize) = step + this%valueForTime(this%serializedTimeSize) = 0.0_RKIND !Clear uninitialized value + selectcase (field) + case (iBloqueJx) + do JJJ = j1, j2 + this%valueForTime(this%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (yF(i1_m, JJJ, k1_m - 1) - yF(i1_m, JJJ, k2_m))*dy(JJJ) + end do + do KKK = k1, k2 + this%valueForTime(this%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (-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%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (-zF(i2_m, j1_m, KKK) + zF(i1_m - 1, j1_m, KKK))*dz(KKK) + end do + do III = i1, i2 + this%valueForTime(this%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (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%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (xF(III, j1_m - 1, k1_m) - xF(III, j2_m, k1_m))*dx(III) + end do + do JJJ = j1, j2 + this%valueForTime(this%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (-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%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (-yF(i1_m, JJJ, k1_m) + yF(i1_m, JJJ, k2_m + 1))*dy(JJJ) + end do + do KKK = k1, k2 + this%valueForTime(this%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (zF(i1_m, j1_m, KKK_m) - zF(i1_m, j2_m + 1, KKK_m))*dz(KKK_m) + end do + + case (iBloqueMy) + do KKK = k1, k2 + this%valueForTime(this%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (zF(i2_m + 1, j1_m, KKK) - zF(i1_m, j1_m, KKK))*dz(KKK) + end do + do III = i1, i2 + this%valueForTime(this%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (-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%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (-xF(III, j1_m, k1_m) + xF(III, j2_m + 1, k1_m))*dx(III) + end do + do JJJ = j1, j2 + this%valueForTime(this%serializedTimeSize) = & + this%valueForTime(this%serializedTimeSize) + & + (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 + +end module mod_bulkProbe diff --git a/src_output/output.F90 b/src_output/output.F90 index cf8447c2..1a601d86 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -5,12 +5,14 @@ module output use mod_pointProbeOutput use mod_wireCurrentProbeOutput use mod_wireChargeProbeOutput + use mod_bulkProbe implicit none integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0, & WIRE_CURRENT_PROBE_ID = 1, & - WIRE_CHARGE_PROBE_ID = 2 + WIRE_CHARGE_PROBE_ID = 2, & + BULK_PROBE_ID = 3 REAL(KIND=RKIND), save :: eps0, mu0 REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu @@ -20,6 +22,7 @@ module output type(point_probe_output_t), allocatable :: pointProbe type(wire_current_probe_output_t), allocatable :: wireCurrentProbe type(wire_charge_probe_output_t), allocatable :: wireChargeProbe + type(bulk_probe_output_t), allocatable :: blukProbe !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !type(far_field_t), allocatable :: farField !type(time_movie_output_t), allocatable :: timeMovie @@ -30,7 +33,8 @@ module output module procedure & init_point_probe_output, & init_wire_current_probe_output, & - init_wire_charge_probe_output + init_wire_charge_probe_output, & + init_bulk_probe_output !init_bulk_current_probe_output, & !init_far_field, & !initime_movie_output, & @@ -77,7 +81,7 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) type(domain_t) :: domain integer(kind=SINGLE) :: i, ii, outputRequestType - integer(kind=SINGLE) :: I1, J1, K1, NODE + integer(kind=SINGLE) :: I1, J1, K1, I2, J2, K2, NODE integer(kind=SINGLE) :: outputCount = 0 character(len=BUFSIZE) :: outputTypeExtension allocate (outputs(sgg%NumberRequest)) @@ -87,12 +91,14 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) InvEps(0:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia)%Epr) InvMu(0:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia)%Mur) - do ii = 1, sgg%NumberRequest do i = 1, sgg%Observation(ii)%nP I1 = sgg%observation(ii)%P(i)%XI J1 = sgg%observation(ii)%P(i)%YI K1 = sgg%observation(ii)%P(i)%ZI + I2 = sgg%observation(ii)%P(i)%XE + J2 = sgg%observation(ii)%P(i)%YE + K2 = sgg%observation(ii)%P(i)%ZE NODE = sgg%observation(ii)%P(i)%NODE domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, control%finaltimestep) @@ -105,7 +111,7 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) outputs(outputCount)%outputID = POINT_PROBE_ID allocate (outputs(outputCount)%pointProbe) -call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir) + call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir) case (iJx, iJy, iJz) if (ThereAreWires) then @@ -117,14 +123,21 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) end if case (iQx, iQy, iQz) - if (ThereAreWires) then - outputCount = outputCount + 1 - outputs(outputCount)%outputID = WIRE_CHARGE_PROBE_ID - allocate (outputs(outputCount)%wireChargeProbe) - call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) - end if + outputCount = outputCount + 1 + outputs(outputCount)%outputID = WIRE_CHARGE_PROBE_ID + + allocate (outputs(outputCount)%wireChargeProbe) + call init_solver_output(outputs(outputCount)%wireChargeProbe, , I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) + case (iBloqueJx, iBloqueJy, iBloqueJz, iBloqueMx, iBloqueMy, iBloqueMz) + outputCount = outputCount + 1 + outputs(outputCount)%outputID = BULK_PROBE_ID + + allocate (outputs(outputCount)%bulkProbe) + call init_solver_output(outputs(outputCount)%bulkProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, outputTypeExtension, control%mpidir) + !! call adjust_computation_range --- Required due to issues in mpi region edges + case default - call stoponerror(0,0,'OutputRequestType type not implemented yet on new observations') + call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') end select end do end do @@ -172,7 +185,7 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep newDomain%fnum = int((newDomain%fstop - newDomain%fstart)/newDomain%fstep, kind=SINGLE) else - call stoponerror(0,0,'No domain present') + call stoponerror(0, 0, 'No domain present') end if return end function preprocess_domain @@ -185,7 +198,8 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d integer(kind=SINGLE) :: i, id type(XYZlimit_t), dimension(1:6), intent(in) :: alloc type(sim_control_t), intent(in) :: control - real(kind=RKIND), pointer, dimension(:, :, :) :: fieldPointer + real(kind=RKIND), pointer, dimension(:, :, :) :: fieldComponent + type(field_data_t), :: fieldReference real(KIND=RKIND), intent(in), target :: & Ex(alloc(iEx)%XI:alloc(iEx)%XE, alloc(iEx)%YI:alloc(iEx)%YE, alloc(iEx)%ZI:alloc(iEx)%ZE), & @@ -205,14 +219,17 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d do i = 1, size(outputs) select case (outputs(i)%outputID) case (POINT_PROBE_ID) - fieldPointer => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos - call update_solver_output(outputs(i)%pointProbe, step, fieldPointer) + fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos + call update_solver_output(outputs(i)%pointProbe, step, fieldComponent) case (WIRE_CURRENT_PROBE_ID) call update_solver_output(outputs(i)%wireCurrentProbe, step, control%wiresflavor, control%wirecrank, InvEps, InvMu) case (WIRE_CHARGE_PROBE_ID) call update_solver_output(outputs(i)%wireChargeProbe, step) + case (BULK_PROBE_ID) + fieldReference => get_field_reference(outputs(i)%blukProbe%fieldComponent) + call update_solver_output(outputs(i)%bulkProbe, step, fieldReference) case default - call stoponerror(0,0,'Output update not implemented') + call stoponerror(0, 0, 'Output update not implemented') end select end do @@ -230,6 +247,30 @@ function get_field_component(fieldId) result(field) end select end function get_field_component + function get_field_reference(fieldId) result(field) + integer(kind=SINGLE), intent(in) :: fieldId + type(field_data_t) :: field + select case + case (iBloqueJx, iBloqueJy, iBloqueJz) + field%x => Ex + field%y => Ey + field%z => Ez + + field%deltaX => dxe + field%deltaY => dye + field%deltaZ => dze + case (iBloqueMx, iBloqueMy, iBloqueMz) + field%x => Hx + field%y => Hy + field%z => Hz + + field%deltaX => dxh + field%deltaY => dyh + field%deltaZ => dzh + end select + end function get_field_reference + + end subroutine update_outputs end module output diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 5c48a649..159bec14 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -5,6 +5,13 @@ module mod_outputUtils implicit none character(len=4), parameter :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' integer(kind=SINGLE), parameter :: FILE_UNIT = 400 + + + type field_data_t + real(kind=RKIND), pointer, dimension(:, :, :) :: x, y, z + real(kind=RKIND), pointer, dimension(:) :: deltaX, deltaY, deltaZ + end type field_data_t + contains function get_prefix_extension(field, mpidir) result(prefixExtension) @@ -38,6 +45,12 @@ function get_rotated_prefix(field, mpidir) result(prefixExtension) case (iHx); prefixExtension = prefix(iHx) case (iHy); prefixExtension = prefix(iHy) case (iHz); prefixExtension = prefix(iHz) + case (iBloqueJx); prefix_field = prefix(iBloqueJx) + case (iBloqueJy); prefix_field = prefix(iBloqueJy) + case (iBloqueJz); prefix_field = prefix(iBloqueJz) + case (iBloqueMx); prefix_field = prefix(iBloqueMx) + case (iBloqueMy); prefix_field = prefix(iBloqueMy) + case (iBloqueMz); prefix_field = prefix(iBloqueMz) case default; prefixExtension = prefix(field) end select elseif (mpidir == 2) then @@ -57,6 +70,12 @@ function get_rotated_prefix(field, mpidir) result(prefixExtension) case (iHx); prefixExtension = prefix(iHz) case (iHy); prefixExtension = prefix(iHx) case (iHz); prefixExtension = prefix(iHy) + case (iBloqueJx); prefix_field = prefix(iBloqueJz) + case (iBloqueJy); prefix_field = prefix(iBloqueJx) + case (iBloqueJz); prefix_field = prefix(iBloqueJy) + case (iBloqueMx); prefix_field = prefix(iBloqueMz) + case (iBloqueMy); prefix_field = prefix(iBloqueMx) + case (iBloqueMz); prefix_field = prefix(iBloqueMy) case default; prefixExtension = prefix(field) end select elseif (mpidir == 1) then @@ -76,10 +95,16 @@ function get_rotated_prefix(field, mpidir) result(prefixExtension) case (iHx); prefixExtension = prefix(iHy) case (iHy); prefixExtension = prefix(iHz) case (iHz); prefixExtension = prefix(iHx) + case (iBloqueJx); prefix_field = prefix(iBloqueJy) + case (iBloqueJy); prefix_field = prefix(iBloqueJz) + case (iBloqueJz); prefix_field = prefix(iBloqueJx) + case (iBloqueMx); prefix_field = prefix(iBloqueMy) + case (iBloqueMy); prefix_field = prefix(iBloqueMz) + case (iBloqueMz); prefix_field = prefix(iBloqueMx) case default; prefixExtension = prefix(field) end select else - call stoponerror(0,0,"Buggy error in mpidir.") + call stoponerror(0, 0, "Buggy error in mpidir.") end if return end function get_rotated_prefix @@ -149,19 +174,19 @@ function close_file(fileUnit) result(iostat) end function close_file subroutine init_frequency_slice(frequencySlice, domain) - real(kind=RKIND), dimension(:), intent(out) :: frequencySlice - type(domain_t), intent(in) :: domain + real(kind=RKIND), dimension(:), intent(out) :: frequencySlice + type(domain_t), intent(in) :: domain - integer(kind=SINGLE) :: i + integer(kind=SINGLE) :: i - if (domain%logarithmicSpacing) then - do i = 1, domain%fnum - frequencySlice(i) = 10.0_RKIND ** (domain%fstart + (i - 1) * domain%fstep) - end do - else - do i=1, domain%fnum - frequencySlice(i) = domain%fstart + (i-1) * domain%fstep - end do - end if + if (domain%logarithmicSpacing) then + do i = 1, domain%fnum + frequencySlice(i) = 10.0_RKIND**(domain%fstart + (i - 1)*domain%fstep) + end do + else + do i = 1, domain%fnum + frequencySlice(i) = domain%fstart + (i - 1)*domain%fstep + end do + end if end subroutine init_frequency_slice end module mod_outputUtils diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 266de664..134ce76a 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -12,6 +12,7 @@ function test_initialize() bind(C) result(err) !Set requested observables dummysgg = create_base_sgg(nummedia=5, dt=0.1_RKIND_tiempo, time_steps=100) + dummysgg%NumberRequest = 3 allocate (dummysgg%Observation(3)) dummysgg%Observation(1) = define_point_observation() dummysgg%Observation(2) = define_wire_current_observation() diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index cf7335a3..dd3025b6 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -92,7 +92,7 @@ function create_control_flags(layoutnumber, size, mpidir, finaltimestep, & if (present(finaltimestep)) control%finaltimestep = finaltimestep if (present(nEntradaRoot)) control%nEntradaRoot = nEntradaRoot if (present(wiresflavor)) control%wiresflavor = wiresflavor - if (present(wiresflavor)) control%wirecrank = wirecrank + if (present(wirecrank)) control%wirecrank = wirecrank if (present(resume)) control%resume = resume if (present(saveall)) control%saveall = saveall if (present(NF2FFDecim)) control%NF2FFDecim = NF2FFDecim @@ -113,8 +113,9 @@ function create_base_sgg(NumMedia, dt, time_steps) result(sgg) sgg%NumberRequest = 1 sgg%dt = merge(dt, 0.1_RKIND_tiempo, present(dt)) - ! Use the new optional-aware create_time_array - sgg%tiempo = create_time_array(merge(time_steps, 100, present(time_steps)), sgg%dt) + nTimes = merge(time_steps, 100, present(time_steps)) + allocate(sgg%tiempo(nTimes)) + sgg%tiempo = create_time_array(nTimes, sgg%dt) ! Hardcoded array limits now call the optional-aware function sgg%Sweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) From bb5f02d0945fc2c08a429c9b1dbebc398b03fda3 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 2 Dec 2025 12:53:19 +0100 Subject: [PATCH 15/67] Translate observation utils --- src_output/outputUtils.F90 | 122 ++++++++++++++++++++++++++++++++++++- 1 file changed, 121 insertions(+), 1 deletion(-) diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 159bec14..5b3b53ba 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -6,7 +6,6 @@ module mod_outputUtils character(len=4), parameter :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' integer(kind=SINGLE), parameter :: FILE_UNIT = 400 - type field_data_t real(kind=RKIND), pointer, dimension(:, :, :) :: x, y, z real(kind=RKIND), pointer, dimension(:) :: deltaX, deltaY, deltaZ @@ -14,6 +13,66 @@ module mod_outputUtils contains + function get_probe_coords_extension(iCoord, jCoord, kCoord, mpidir) result(ext) + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, mpidir + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + +#if CompileWithMPI + if (mpidir == 3) then + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + elseif (mpidir == 2) then + ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) + elseif (mpidir == 1) then + ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) + else + call stoponerror('Buggy error in mpidir. ') + end if +#else + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) +#endif + + return + end function get_probe_coords_extension + + function get_probe_bounds_coords_extension(iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, mpidir) result(ext) + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, mpidir + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark, chari2, charj2, chark2 + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + + write (chari2, '(i7)') i2Coord + write (charj2, '(i7)') j2Coord + write (chark2, '(i7)') k2Coord + +#if CompileWithMPI + if (mpidir == 3) then + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark))//'__'// & + trim(adjustl(chari2))//'_'//trim(adjustl(charj2))//'_'//trim(adjustl(chark2)) + elseif (mpidir == 2) then + ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari))//'__'// & + trim(adjustl(charj2))//'_'//trim(adjustl(chark2))//'_'//trim(adjustl(chari2)) + elseif (mpidir == 1) then + ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj))//'__'// & + trim(adjustl(chark2))//'_'//trim(adjustl(chari2))//'_'//trim(adjustl(charj2)) + else + call stoponerror('Buggy error in mpidir. ') + end if +#else + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark))//'__'// & + trim(adjustl(chari2))//'_'//trim(adjustl(charj2))//'_'//trim(adjustl(chark2)) +#endif + + return + end function get_probe_bounds_coords_extension + function get_prefix_extension(field, mpidir) result(prefixExtension) integer(kind=SINGLE), intent(in) :: field, mpidir character(len=BUFSIZE) :: prefixExtension @@ -189,4 +248,65 @@ subroutine init_frequency_slice(frequencySlice, domain) end do end if end subroutine init_frequency_slice + + integer function blockCurrent(field) + integer(kind=4) :: field + select case (field) + case (iHx); blockCurrent = iCurX + case (iHy); blockCurrent = iCurY + case (iHz); blockCurrent = iCurZ + case default; call StopOnError(layoutnumber, size, 'field is not H field') + end select + end function + + logical function isPECorSurface(field, i, j, k, media, simulationMedia) + type(MediaData_t), pointer, dimension(:), intent(in) :: simulationMedia + type(media_matrices_t), intent(in) :: media + integer(kind=4), intent(in) :: field, i, j, k + integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex + mediaIndex = getMedia(field, i, j, k, media) + isPECorSurface = simulationMedia(mediaIndex)%is%PEC .or. simulationMedia(mediaIndex)%is%Surface + end function + + function getMedia(field, i, j, k, media) result(res) + TYPE(media_matrices_t), INTENT(IN) :: media + integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: res + integer(kind=4) :: field, i, j, k + select case (field) + case (iEx); res = media%sggMiEx(i, j, k) + case (iEy); res = media%sggMiEy(i, j, k) + case (iEz); res = media%sggMiEz(i, j, k) + case (iHx); res = media%sggMiHx(i, j, k) + case (iHy); res = media%sggMiHy(i, j, k) + case (iHz); res = media%sggMiHz(i, j, k) + case default; call StopOnError(layoutnumber, size, 'Unrecognized field') + end select + end function + + logical function isWithinBounds(field, i, j, k, SINPML_fullsize) + TYPE(limit_t), DIMENSION(:), INTENT(IN) :: SINPML_fullsize + integer(kind=4) :: field, i, j, k + isWithinBounds = (i <= SINPML_fullsize(field)%XE) .and. & + (j <= SINPML_fullsize(field)%YE) .and. & + (k <= SINPML_fullsize(field)%ZE) + end function + + logical function isMediaVacuum(field, i, j, k, media) + TYPE(media_matrices_t), INTENT(IN) :: media + integer(kind=4) :: field, i, j, k + integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex, vacuum = 1 + mediaIndex = getMedia(field, i, j, k, media) + isMediaVacuum = (mediaIndex == vacuum) + end function + + logical function isSplitOrAdvanced(field, i, j, k, media, simulationMedia) + type(MediaData_t), pointer, dimension(:), intent(in) :: simulationMedia + type(media_matrices_t), intent(in) :: media + integer(kind=4) :: field, i, j, k + integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex + mediaIndex = getMedia(field, i, j, k, media) + isSplitOrAdvanced = sgg%med(mediaIndex)%is%split_and_useless .or. & + sgg%med(mediaIndex)%is%already_YEEadvanced_byconformal + + end function end module mod_outputUtils From 32ccd20eb942ed8e3e517acf13560917927ce0b2 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 2 Dec 2025 12:55:03 +0100 Subject: [PATCH 16/67] create volumic probe --- src_output/output.F90 | 21 +++- src_output/volumic_probe_output.F90 | 171 ++++++++++++++++++++++++++++ 2 files changed, 188 insertions(+), 4 deletions(-) create mode 100644 src_output/volumic_probe_output.F90 diff --git a/src_output/output.F90 b/src_output/output.F90 index 1a601d86..a30bf8f0 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -6,6 +6,7 @@ module output use mod_wireCurrentProbeOutput use mod_wireChargeProbeOutput use mod_bulkProbe + use mod_volumicProbe implicit none @@ -23,6 +24,8 @@ module output type(wire_current_probe_output_t), allocatable :: wireCurrentProbe type(wire_charge_probe_output_t), allocatable :: wireChargeProbe type(bulk_probe_output_t), allocatable :: blukProbe + type(volumic_current_probe_t), allocatable :: volumicCurrentProbe + type(volumic_field_probe_t), allocatable :: volumicFieldProbe !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !type(far_field_t), allocatable :: farField !type(time_movie_output_t), allocatable :: timeMovie @@ -34,8 +37,8 @@ module output init_point_probe_output, & init_wire_current_probe_output, & init_wire_charge_probe_output, & - init_bulk_probe_output - !init_bulk_current_probe_output, & + init_bulk_probe_output, & + init_volumic_current_probe_output !init_far_field, & !initime_movie_output, & !init_frequency_slice_output @@ -45,7 +48,8 @@ module output module procedure & update_point_probe_output, & update_wire_current_probe_output, & - update_wire_charge_probe_output + update_wire_charge_probe_output, & + update_bulk_probe_output !update_bulk_current_probe_output, & !update_far_field, & !updateime_movie_output, & @@ -73,8 +77,10 @@ module output end interface contains - subroutine init_outputs(sgg, control, outputs, ThereAreWires) + subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreWires) type(SGGFDTDINFO), intent(in) :: sgg + type(media_matrices_t), intent(in) :: media + type(limit_t), dimension(1:6), intent(in) :: SINPML_fullsize type(sim_control_t), intent(inout) :: control type(solver_output_t), dimension(:), allocatable, intent(out) :: outputs logical :: ThereAreWires @@ -136,6 +142,13 @@ subroutine init_outputs(sgg, control, outputs, ThereAreWires) call init_solver_output(outputs(outputCount)%bulkProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, outputTypeExtension, control%mpidir) !! call adjust_computation_range --- Required due to issues in mpi region edges + case (iCur, iCurX, iCurY, iCurZ) + outputCount = outputCount + 1 + outputs(outputCount)%outputID = VOLUMIC_CURRENT_PROBE_ID + + allocate (outputs(outputCount)%volumicCurrentProbe) + call init_solver_output(outputs(outputCount)%volumicCurrentProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir) + case default call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') end select diff --git a/src_output/volumic_probe_output.F90 b/src_output/volumic_probe_output.F90 new file mode 100644 index 00000000..cdf17bde --- /dev/null +++ b/src_output/volumic_probe_output.F90 @@ -0,0 +1,171 @@ +module mod_volumicProbe + use FDETYPES + use mod_domain + use mod_outputUtils + + implicit none + type volumic_current_probe_t + integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + integer(kind=SINGLE) :: x2Coord, y2Coord, z2Coord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: fieldComponent + + !Intent storage order: + !(:) == (timeinstance) => timeValue + !(:,:) == (timeInstance, componentId) => escalar + + !Time Domain (requires first allocation) + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(:) :: timeStep + real(kind=RKIND), dimension(:, :) :: xValueForTime + real(kind=RKIND), dimension(:, :) :: yValueForTime + real(kind=RKIND), dimension(:, :) :: zValueForTime + + !(:) == (frquencyinstance) => timeValue + !(:,:) == (frquencyinstance, componentId) => escalar + + !Frequency Domain (requires first allocation) + integer(kind=SINGLE) :: nFreq = 0_SINGLE + real(kind=RKIND), dimension(:), allocatable :: frequencySlice + real(kind=CKIND), dimension(:, :), allocatable :: xValueForFreq + real(kind=CKIND), dimension(:, :), allocatable :: yValueForFreq + real(kind=CKIND), dimension(:, :), allocatable :: zValueForFreq + end type volumic_current_probe_t + +contains + + subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, field, domain, media, simulationMedia, sinpml_fullsize, outputTypeExtension, mpidir) + type(volumic_current_probe_t), intent(out) :: this + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord + integer(kind=SINGLE), intent(in) :: i2Coord, j2Coord, k2Coord + integer(kind=SINGLE), intent(in) :: mpidir, field + character(len=BUFSIZE), intent(in) :: outputTypeExtension + + type(MediaData_t), pointer, dimension(:) :: simulationMedia + type(media_matrices_t), intent(in) :: media + type(limit_t), dimension(1:6), intent(in) :: sinpml_fullsize + + type(domain_t), intent(in) :: domain + + integer(kind=SINGLE) :: i + + this%xCoord = iCoord + this%yCoord = jCoord + this%zCoord = kCoord + + this%x2Coord = i2Coord + this%y2Coord = j2Coord + this%z2Coord = k2Coord + + this%fieldComponent = field + + this%domain = domain + this%path = get_output_path() + + totalPecSurfaces = count_pec_surfaces() + + if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + allocate (timeStep(BuffObse, totalPecSurfaces) & + xValueForTime(BuffObse, totalPecSurfaces) & + yValueForTime(BuffObse, totalPecSurfaces) & + zValueForTime(BuffObse, totalPecSurfaces)) + xValueForTime = 0.0_RKIND + yValueForTime = 0.0_RKIND + zValueForTime = 0.0_RKIND + end if + + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + this%nFreq = this%domain%fnum + allocate (this%frequencySlice(this%domain%fnum)) + allocate (this%xValueForFreq(this%domain%fnum, totalPecSurfaces) & + this%yValueForFreq(this%domain%fnum, totalPecSurfaces) & + this%zValueForFreq(this%domain%fnum, totalPecSurfaces)) + do i = 1, this%nFreq + call init_frequency_slice(this%frequencySlice, this%domain) + end do + this%xValueForFreq = (0.0_RKIND, 0.0_RKIND) + this%yValueForFreq = (0.0_RKIND, 0.0_RKIND) + this%zValueForFreq = (0.0_RKIND, 0.0_RKIND) + end if + + contains + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_probe_bounds_coords_extension(iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, mpidir) + prefixFieldExtension = get_prefix_extension(field, mpidir) + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension)) + return + end function get_output_path + + function count_pec_surfaces() result(n) + integer(kind=SINGLE) :: i, j, k, field + integer(kind=SINGLE) :: n = 0_SINGLE + do concurrent(i=icoord:i2coord, j=jcoord:j2coord, k=kcoord:k2coord, field= iEx:iEz) !Ejecuta todas las combinaciones de (i, j, k, field) + if (isWithinBounds(field, iii, jjj, kkk)) then + if (isThinWire(field, iii, jjj, kkk)) then + n = n + 1 + end if + if (.not. isMediaVacuum(field, iii, jjj, kkk, media) .and. .not. isSplitOrAdvanced(field, iii, jjj, kkk)) then + n = n + 1 + end if + if (isPECorSurface(field, iii, jjj, kkk, media, simulationMedia) .or. field == blockCurrent(field)) then + n = n + 1 + end if + end if + end do + + end function count_pec_surface + end subroutine init_volumic_probe_output + + subroutine update_volumic_probe_output(this, step) + type(volumic_current_probe_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + + integer(kind=SINGLE) :: Efield, iii, jjj, kkk + integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2, conta + + if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + this%serializedTimeSize = this%serializedTimeSize + 1 + conta = 0 + do KKK = k1, k2 + do JJJ = j1, j2 + do III = i1, i2 + do Efield = iEx, iEz + if (isRelevantCell(Efield, iii, jjj, kkk)) then + conta = conta + 1 + call save_current(this, Efield, iii, jjj, kkk, conta) + end if + end do + end do + end do + end do + end if + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + end if + contains + LOGICAL FUNCTION isRelevantCell(Efield, I, J, K) + IMPLICIT NONE + INTEGER, INTENT(IN) :: Efield, I, J, K + + isRelevantCell = isWithinBounds(Efield, I, J, K) .AND. & + (isThinWire(Efield, I, J, K) .OR. & + (.NOT. isMediaVacuum(Efield, I, J, K) .AND. & + .NOT. isSplitOrAdvanced(Efield, I, J, K))) + + END FUNCTION isRelevantCell + + subroutine save_current(this, Efield, iii, jjj, kkk, conta) + type(volumic_current_probe_t), intent(inout) :: this + integer(kind=SINGLE), intent(in) :: Efield, iii, jjj, kkk, conta + jdir = computeJ(EField, iii, jjj, kkk) + this%xValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEx) + this%yValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEy) + this%zValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEz) + end subroutine save_current + end subroutine update_volumic_probe_output + +end module mod_volumicProbe From 3459eee140c1269551b99f3f51fe082caa32e510 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 3 Dec 2025 11:02:42 +0100 Subject: [PATCH 17/67] Fix compilation issues from new output utils --- src_output/CMakeLists.txt | 2 + src_output/bulk_probe_output.F90 | 5 +- src_output/output.F90 | 42 +++-- src_output/outputUtils.F90 | 239 ++++++++++++++++++++++++---- src_output/volumic_probe_output.F90 | 120 ++++++++++---- test/output/test_output.F90 | 4 +- 6 files changed, 333 insertions(+), 79 deletions(-) diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index c64b5920..d5368568 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -5,5 +5,7 @@ add_library(fdtd-output "point_probe_output.F90" "wire_current_probe_output.F90" "wire_charge_probe_output.F90" + "bulk_probe_output.F90" + "volumic_probe_output.F90" ) target_link_libraries(fdtd-output semba-types ) \ No newline at end of file diff --git a/src_output/bulk_probe_output.F90 b/src_output/bulk_probe_output.F90 index 9d7eb7ac..8910f5b5 100644 --- a/src_output/bulk_probe_output.F90 +++ b/src_output/bulk_probe_output.F90 @@ -97,6 +97,7 @@ subroutine update_bulk_probe_output(this, step, 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 @@ -126,7 +127,7 @@ subroutine update_bulk_probe_output(this, step, field) this%serializedTimeSize = this%serializedTimeSize + 1 this%timeStep(this%serializedTimeSize) = step this%valueForTime(this%serializedTimeSize) = 0.0_RKIND !Clear uninitialized value - selectcase (field) + selectcase (this%fieldComponent) case (iBloqueJx) do JJJ = j1, j2 this%valueForTime(this%serializedTimeSize) = & @@ -172,7 +173,7 @@ subroutine update_bulk_probe_output(this, step, field) do KKK = k1, k2 this%valueForTime(this%serializedTimeSize) = & this%valueForTime(this%serializedTimeSize) + & - (zF(i1_m, j1_m, KKK_m) - zF(i1_m, j2_m + 1, KKK_m))*dz(KKK_m) + (zF(i1_m, j1_m, KKK) - zF(i1_m, j2_m + 1, KKK))*dz(KKK) end do case (iBloqueMy) diff --git a/src_output/output.F90 b/src_output/output.F90 index a30bf8f0..7aa18c59 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -13,7 +13,8 @@ module output integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0, & WIRE_CURRENT_PROBE_ID = 1, & WIRE_CHARGE_PROBE_ID = 2, & - BULK_PROBE_ID = 3 + BULK_PROBE_ID = 3, & + VOLUMIC_CURRENT_PROBE_ID = 4 REAL(KIND=RKIND), save :: eps0, mu0 REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu @@ -23,9 +24,9 @@ module output type(point_probe_output_t), allocatable :: pointProbe type(wire_current_probe_output_t), allocatable :: wireCurrentProbe type(wire_charge_probe_output_t), allocatable :: wireChargeProbe - type(bulk_probe_output_t), allocatable :: blukProbe + type(bulk_probe_output_t), allocatable :: bulkProbe type(volumic_current_probe_t), allocatable :: volumicCurrentProbe - type(volumic_field_probe_t), allocatable :: volumicFieldProbe + !type(volumic_field_probe_t), allocatable :: volumicFieldProbe !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !type(far_field_t), allocatable :: farField !type(time_movie_output_t), allocatable :: timeMovie @@ -38,7 +39,7 @@ module output init_wire_current_probe_output, & init_wire_charge_probe_output, & init_bulk_probe_output, & - init_volumic_current_probe_output + init_volumic_probe_output !init_far_field, & !initime_movie_output, & !init_frequency_slice_output @@ -79,8 +80,8 @@ module output subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreWires) type(SGGFDTDINFO), intent(in) :: sgg - type(media_matrices_t), intent(in) :: media - type(limit_t), dimension(1:6), intent(in) :: SINPML_fullsize + type(media_matrices_t), pointer, intent(in) :: media + type(limit_t), pointer, dimension(:), intent(in) :: SINPML_fullsize type(sim_control_t), intent(inout) :: control type(solver_output_t), dimension(:), allocatable, intent(out) :: outputs logical :: ThereAreWires @@ -133,7 +134,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW outputs(outputCount)%outputID = WIRE_CHARGE_PROBE_ID allocate (outputs(outputCount)%wireChargeProbe) - call init_solver_output(outputs(outputCount)%wireChargeProbe, , I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) + call init_solver_output(outputs(outputCount)%wireChargeProbe, I1, J1, K1, NODE, outputRequestType, domain, outputTypeExtension, control%mpidir, control%wiresflavor) case (iBloqueJx, iBloqueJy, iBloqueJz, iBloqueMx, iBloqueMy, iBloqueMz) outputCount = outputCount + 1 outputs(outputCount)%outputID = BULK_PROBE_ID @@ -212,7 +213,8 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d type(XYZlimit_t), dimension(1:6), intent(in) :: alloc type(sim_control_t), intent(in) :: control real(kind=RKIND), pointer, dimension(:, :, :) :: fieldComponent - type(field_data_t), :: fieldReference + type(field_data_t), pointer :: fieldReference + type(fields_reference_t), pointer :: fields real(KIND=RKIND), intent(in), target :: & Ex(alloc(iEx)%XI:alloc(iEx)%XE, alloc(iEx)%YI:alloc(iEx)%YE, alloc(iEx)%ZI:alloc(iEx)%ZE), & @@ -222,13 +224,29 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d Hy(alloc(iHy)%XI:alloc(iHy)%XE, alloc(iHy)%YI:alloc(iHy)%YE, alloc(iHy)%ZI:alloc(iHy)%ZE), & Hz(alloc(iHz)%XI:alloc(iHz)%XE, alloc(iHz)%YI:alloc(iHz)%YE, alloc(iHz)%ZI:alloc(iHz)%ZE) !---> - real(KIND=RKIND), dimension(:), intent(in) :: dxh(alloc(iEx)%XI:alloc(iEx)%XE), & + real(KIND=RKIND), dimension(:), intent(in), target :: dxh(alloc(iEx)%XI:alloc(iEx)%XE), & dyh(alloc(iEy)%YI:alloc(iEy)%YE), & dzh(alloc(iEz)%ZI:alloc(iEz)%ZE), & dxe(alloc(iHx)%XI:alloc(iHx)%XE), & dye(alloc(iHy)%YI:alloc(iHy)%YE), & dze(alloc(iHz)%ZI:alloc(iHz)%ZE) + fields%E%x => Ex + fields%E%y => Ey + fields%E%z => Ez + + fields%H%x => Hx + fields%H%y => Hy + fields%H%z => Hz + + fields%E%deltax => dxe + fields%E%deltay => dye + fields%E%deltaz => dze + + fields%H%deltax => dxh + fields%H%deltay => dyh + fields%H%deltaz => dzh + do i = 1, size(outputs) select case (outputs(i)%outputID) case (POINT_PROBE_ID) @@ -239,7 +257,7 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d case (WIRE_CHARGE_PROBE_ID) call update_solver_output(outputs(i)%wireChargeProbe, step) case (BULK_PROBE_ID) - fieldReference => get_field_reference(outputs(i)%blukProbe%fieldComponent) + fieldReference => get_field_reference(outputs(i)%bulkProbe%fieldComponent) call update_solver_output(outputs(i)%bulkProbe, step, fieldReference) case default call stoponerror(0, 0, 'Output update not implemented') @@ -262,8 +280,8 @@ end function get_field_component function get_field_reference(fieldId) result(field) integer(kind=SINGLE), intent(in) :: fieldId - type(field_data_t) :: field - select case + type(field_data_t), pointer :: field + select case (fieldId) case (iBloqueJx, iBloqueJy, iBloqueJz) field%x => Ex field%y => Ey diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 5b3b53ba..bbf0c436 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -11,6 +11,10 @@ module mod_outputUtils real(kind=RKIND), pointer, dimension(:) :: deltaX, deltaY, deltaZ end type field_data_t + type fields_reference_t + type(field_data_t), pointer :: E, H + end type fields_reference_t + contains function get_probe_coords_extension(iCoord, jCoord, kCoord, mpidir) result(ext) @@ -104,12 +108,12 @@ function get_rotated_prefix(field, mpidir) result(prefixExtension) case (iHx); prefixExtension = prefix(iHx) case (iHy); prefixExtension = prefix(iHy) case (iHz); prefixExtension = prefix(iHz) - case (iBloqueJx); prefix_field = prefix(iBloqueJx) - case (iBloqueJy); prefix_field = prefix(iBloqueJy) - case (iBloqueJz); prefix_field = prefix(iBloqueJz) - case (iBloqueMx); prefix_field = prefix(iBloqueMx) - case (iBloqueMy); prefix_field = prefix(iBloqueMy) - case (iBloqueMz); prefix_field = prefix(iBloqueMz) + case (iBloqueJx); prefixExtension = prefix(iBloqueJx) + case (iBloqueJy); prefixExtension = prefix(iBloqueJy) + case (iBloqueJz); prefixExtension = prefix(iBloqueJz) + case (iBloqueMx); prefixExtension = prefix(iBloqueMx) + case (iBloqueMy); prefixExtension = prefix(iBloqueMy) + case (iBloqueMz); prefixExtension = prefix(iBloqueMz) case default; prefixExtension = prefix(field) end select elseif (mpidir == 2) then @@ -129,12 +133,12 @@ function get_rotated_prefix(field, mpidir) result(prefixExtension) case (iHx); prefixExtension = prefix(iHz) case (iHy); prefixExtension = prefix(iHx) case (iHz); prefixExtension = prefix(iHy) - case (iBloqueJx); prefix_field = prefix(iBloqueJz) - case (iBloqueJy); prefix_field = prefix(iBloqueJx) - case (iBloqueJz); prefix_field = prefix(iBloqueJy) - case (iBloqueMx); prefix_field = prefix(iBloqueMz) - case (iBloqueMy); prefix_field = prefix(iBloqueMx) - case (iBloqueMz); prefix_field = prefix(iBloqueMy) + case (iBloqueJx); prefixExtension = prefix(iBloqueJz) + case (iBloqueJy); prefixExtension = prefix(iBloqueJx) + case (iBloqueJz); prefixExtension = prefix(iBloqueJy) + case (iBloqueMx); prefixExtension = prefix(iBloqueMz) + case (iBloqueMy); prefixExtension = prefix(iBloqueMx) + case (iBloqueMz); prefixExtension = prefix(iBloqueMy) case default; prefixExtension = prefix(field) end select elseif (mpidir == 1) then @@ -154,12 +158,12 @@ function get_rotated_prefix(field, mpidir) result(prefixExtension) case (iHx); prefixExtension = prefix(iHy) case (iHy); prefixExtension = prefix(iHz) case (iHz); prefixExtension = prefix(iHx) - case (iBloqueJx); prefix_field = prefix(iBloqueJy) - case (iBloqueJy); prefix_field = prefix(iBloqueJz) - case (iBloqueJz); prefix_field = prefix(iBloqueJx) - case (iBloqueMx); prefix_field = prefix(iBloqueMy) - case (iBloqueMy); prefix_field = prefix(iBloqueMz) - case (iBloqueMz); prefix_field = prefix(iBloqueMx) + case (iBloqueJx); prefixExtension = prefix(iBloqueJy) + case (iBloqueJy); prefixExtension = prefix(iBloqueJz) + case (iBloqueJz); prefixExtension = prefix(iBloqueJx) + case (iBloqueMx); prefixExtension = prefix(iBloqueMy) + case (iBloqueMy); prefixExtension = prefix(iBloqueMz) + case (iBloqueMz); prefixExtension = prefix(iBloqueMx) case default; prefixExtension = prefix(field) end select else @@ -255,13 +259,22 @@ integer function blockCurrent(field) case (iHx); blockCurrent = iCurX case (iHy); blockCurrent = iCurY case (iHz); blockCurrent = iCurZ - case default; call StopOnError(layoutnumber, size, 'field is not H field') + case default; call StopOnError(0, 0, 'field is not H field') end select end function + logical function isThinWire(field, i, j, k, simulationMedia, media) + integer(kind=4), intent(in) :: field, i, j, k + type(MediaData_t), pointer, dimension(:), intent(in) :: simulationMedia + type(media_matrices_t),pointer, intent(in) :: media + integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex + mediaIndex = getMedia(field, i, j, k, media) + isThinWire = simulationMedia(mediaIndex)%is%ThinWire + end function + logical function isPECorSurface(field, i, j, k, media, simulationMedia) type(MediaData_t), pointer, dimension(:), intent(in) :: simulationMedia - type(media_matrices_t), intent(in) :: media + type(media_matrices_t), pointer, intent(in) :: media integer(kind=4), intent(in) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex mediaIndex = getMedia(field, i, j, k, media) @@ -269,9 +282,9 @@ logical function isPECorSurface(field, i, j, k, media, simulationMedia) end function function getMedia(field, i, j, k, media) result(res) - TYPE(media_matrices_t), INTENT(IN) :: media + type(media_matrices_t), pointer, intent(in) :: media + integer(kind=4), intent(in) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: res - integer(kind=4) :: field, i, j, k select case (field) case (iEx); res = media%sggMiEx(i, j, k) case (iEy); res = media%sggMiEy(i, j, k) @@ -279,20 +292,22 @@ function getMedia(field, i, j, k, media) result(res) case (iHx); res = media%sggMiHx(i, j, k) case (iHy); res = media%sggMiHy(i, j, k) case (iHz); res = media%sggMiHz(i, j, k) - case default; call StopOnError(layoutnumber, size, 'Unrecognized field') + case default; call StopOnError(0, 0, 'Unrecognized field') end select end function logical function isWithinBounds(field, i, j, k, SINPML_fullsize) - TYPE(limit_t), DIMENSION(:), INTENT(IN) :: SINPML_fullsize - integer(kind=4) :: field, i, j, k + implicit none + TYPE(limit_t),pointer, DIMENSION(:), INTENT(IN) :: SINPML_fullsize + integer(kind=4), intent(in) :: field, i, j, k isWithinBounds = (i <= SINPML_fullsize(field)%XE) .and. & (j <= SINPML_fullsize(field)%YE) .and. & (k <= SINPML_fullsize(field)%ZE) end function logical function isMediaVacuum(field, i, j, k, media) - TYPE(media_matrices_t), INTENT(IN) :: media + implicit none + TYPE(media_matrices_t), pointer ,INTENT(IN) :: media integer(kind=4) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex, vacuum = 1 mediaIndex = getMedia(field, i, j, k, media) @@ -300,13 +315,179 @@ logical function isMediaVacuum(field, i, j, k, media) end function logical function isSplitOrAdvanced(field, i, j, k, media, simulationMedia) + implicit none type(MediaData_t), pointer, dimension(:), intent(in) :: simulationMedia - type(media_matrices_t), intent(in) :: media + type(media_matrices_t), pointer, intent(in) :: media integer(kind=4) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex mediaIndex = getMedia(field, i, j, k, media) - isSplitOrAdvanced = sgg%med(mediaIndex)%is%split_and_useless .or. & - sgg%med(mediaIndex)%is%already_YEEadvanced_byconformal + isSplitOrAdvanced = simulationMedia(mediaIndex)%is%split_and_useless .or. & + simulationMedia(mediaIndex)%is%already_YEEadvanced_byconformal end function + + function computej(field, i, j, k, fields_reference) result(res) + implicit none + + ! Input Arguments + integer(kind=single), intent(in) :: field, i, j, k + type(fields_reference_t), pointer, intent(in) :: fields_reference + + ! Local Variables + integer(kind=single) :: i_shift_a, j_shift_a, k_shift_a ! Shift for Term A (Offset for H/M field) + integer(kind=single) :: i_shift_b, j_shift_b, k_shift_b ! Shift for Term B (Offset for H/M field) + + integer(kind=single) :: curl_component_a ! H/M field component for Term A + integer(kind=single) :: curl_component_b ! H/M field component for Term B + + real(kind=rkind) :: res + + ! ----------------------------------------------------------- + ! 1. Determine Curl Components + ! The MOD 3 operation cyclically maps the E-field to the two required H-field components. + ! ----------------------------------------------------------- + + ! Component A (The 'next' component in the sequence) + curl_component_a = 1 + mod(field + 1, 3) + + ! Component B (The 'current' component in the sequence) + curl_component_b = 1 + mod(field, 3) + + ! ----------------------------------------------------------- + ! 2. Calculate Spatial Shifts (Yee Cell Staggering) + ! We use MERGE to apply the (i-1) shift only in the relevant direction. + ! ----------------------------------------------------------- + + ! Shift for Term A + i_shift_a = i - merge(1, 0, curl_component_a == iex) + j_shift_a = j - merge(1, 0, curl_component_a == iey) + k_shift_a = k - merge(1, 0, curl_component_a == iez) + + ! Shift for Term B + i_shift_b = i - merge(1, 0, curl_component_b == iex) + j_shift_b = j - merge(1, 0, curl_component_b == iey) + k_shift_b = k - merge(1, 0, curl_component_b == iez) + + ! ----------------------------------------------------------- + ! 3. Calculate J (Curl Difference) + ! The H/M fields are accessed using an offset (+3) from the E-field index. + ! ----------------------------------------------------------- + + res = & + ! TERM B: (Positive term in the difference) + (get_delta(curl_component_b, i, j, k, fields_reference)* & + ( get_field(curl_component_b + 3, i, j, k, fields_reference) - get_field(curl_component_b + 3, i_shift_b, j_shift_b, k_shift_b, fields_reference) ) & + ) - & + ! TERM A: (Negative term in the difference) + (get_delta(curl_component_a, i, j, k, fields_reference)* & + ( get_field(curl_component_a + 3, i, j, k, fields_reference) - get_field(curl_component_a + 3, i_shift_a, j_shift_a, k_shift_a, fields_reference) ) & + ) + + end function computej + + function computeJ1(f, i, j, k, fields_reference) result(res) + implicit none + integer(kind=4), intent(in) :: f, i, j, k + type(fields_reference_t), pointer, intent(in) :: fields_reference + integer(kind=4) :: c ! Complementary H-field index (Hy/Hz) + real(kind=rkind) :: res + real(kind=rkind) :: curl_h_term_a, curl_h_term_b, field_diff_term + + ! Calculate complementary H-field index (e.g., if f=1 (Ex), c=5 (Hy) and c+1=6 (Hz) or vice versa depending on definitions) + ! For f=1 (Ex), c = mod(1-2, 3)+4 = mod(-1, 3)+4 = 2+4 = 6 (Hz). + + c = mod(f - 2, 3) + 4 ! This typically corresponds to H_z for J_x, or H_x for J_y, etc. + + ! First set of H-field terms + curl_h_term_a = get_delta(c, i, j, k, fields_reference)*get_field(c, i, j, k, fields_reference) + & + get_delta(c, i+u(f,iHy), j+u(f,iHz), k+u(f,iHx), fields_reference) * get_field(c, i+u(f,iHy), j+u(f,iHz), k+u(f,iHx), fields_reference) + + ! Second set of H-field terms + curl_h_term_b = get_delta(c, i, j, k, fields_reference) * get_field(c, i-u(f,iHx), j-u(f,iHy), k-u(f,iHz), fields_reference) + & + get_delta(c, i+u(f,iHy), j+u(f,iHz), k+u(f,iHx), fields_reference) * get_field(c, i-u(f,iHx)+u(f,iHy), j-u(f,iHy)+u(f,iHz), k-u(f,iHz)+u(f,iHx), fields_reference) + + ! E-field term (approximates the change in E-field at the J-node) + field_diff_term = get_delta(f, i, j, k, fields_reference)*( & + get_field(f, i - u(f, iHy), j - u(f, iHz), k - u(f, iHx), fields_reference) - & + get_field(f, i + u(f, iHy), j + u(f, iHz), k + u(f, iHx), fields_reference)) + + ! Final computation: J1 = - ((Curl_H_A) - (Curl_H_B) + (E_diff)) + res = -((curl_h_term_a - curl_h_term_b) + field_diff_term) + + end function computeJ1 + + function computeJ2(f, i, j, k, fields_reference) result(res) + implicit none + integer(kind=4), intent(in) :: f, i, j, k + type(fields_reference_t), pointer, intent(in) :: fields_reference + integer(kind=4) :: c ! Complementary H-field index (Hx/Hy/Hz) + real(kind=rkind) :: res + real(kind=rkind) :: curl_h_term_a, curl_h_term_b, field_diff_term + + ! Calculate complementary H-field index (e.g., if f=1 (Ex), c=4 (Hx) or c=5 (Hy)) + ! For f=1 (Ex), c = mod(1-3, 3)+4 = mod(-2, 3)+4 = 1+4 = 5 (Hy). This is the second H-field curl component. + c = mod(f - 3, 3) + 4 + + ! First set of H-field terms + curl_h_term_a = get_delta(c, i, j, k, fields_reference)*get_field(c, i, j, k, fields_reference) + & + get_delta(c, i+u(f,iHz), j+u(f,iHx), k+u(f,iHy), fields_reference) * get_field(c, i+u(f,iHz), j+u(f,iHx), k+u(f,iHy), fields_reference) + + ! Second set of H-field terms + curl_h_term_b = get_delta(c, i, j, k, fields_reference) * get_field(c, i-u(f,iHx), j-u(f,iHy), k-u(f,iHz), fields_reference) + & + get_delta(c, i+u(f,iHz), j+u(f,iHx), k+u(f,iHy), fields_reference) * get_field(c, i-u(f,iHx)+u(f,iHz), j-u(f,iHy)+u(f,iHx), k-u(f,iHz)+u(f,iHy), fields_reference) + + ! E-field term (approximates the change in E-field at the J-node) + field_diff_term = get_delta(f, i, j, k, fields_reference)*( & + get_field(f, i - u(f, iHz), j - u(f, iHx), k - u(f, iHy), fields_reference) - & + get_field(f, i + u(f, iHz), j + u(f, iHx), k + u(f, iHy), fields_reference)) + + ! Final computation: J2 = (Curl_H_A) - (Curl_H_B) + (E_diff) + res = (curl_h_term_a - curl_h_term_b) + field_diff_term + + end function computeJ2 + + integer function u(field1, field2) + integer(kind=4) :: field1, field2 + if (field1 == field2) then + u = 1 + else + u = 0 + end if + end function + + function get_field(field, i, j, k, fields_reference) result(res) + implicit none + real(kind=rkind) :: res + integer(kind=4), intent(in) :: field, i, j, k + type(fields_reference_t), pointer, intent(in) :: fields_reference + + ! Retrieves the field value based on the field index (1-3 for E, 4-6 for H) + select case (field) + case (iex); res = fields_reference%e%x(i, j, k) + case (iey); res = fields_reference%e%y(i, j, k) + case (iez); res = fields_reference%e%z(i, j, k) + case (ihx); res = fields_reference%h%x(i, j, k) + case (ihy); res = fields_reference%h%y(i, j, k) + case (ihz); res = fields_reference%h%z(i, j, k) + end select + end function get_field + + function get_delta(field, i, j, k, fields_reference) result(res) + implicit none + real(kind=rkind) :: res + integer(kind=4), intent(in) :: field, i, j, k + type(fields_reference_t), pointer, intent(in) :: fields_reference + + ! Retrieves the spatial step size (delta) corresponding to the field direction + ! Note: i, j, k are used to select the correct array index if the grid is non-uniform. + select case (field) + case (iex); res = fields_reference%e%deltax(i) + case (iey); res = fields_reference%e%deltay(j) + case (iez); res = fields_reference%e%deltaz(k) + case (ihx); res = fields_reference%h%deltax(i) + case (ihy); res = fields_reference%h%deltay(j) + case (ihz); res = fields_reference%h%deltaz(k) + end select + end function get_delta + end module mod_outputUtils diff --git a/src_output/volumic_probe_output.F90 b/src_output/volumic_probe_output.F90 index cdf17bde..054bd35e 100644 --- a/src_output/volumic_probe_output.F90 +++ b/src_output/volumic_probe_output.F90 @@ -18,11 +18,12 @@ module mod_volumicProbe !Time Domain (requires first allocation) integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(:) :: timeStep - real(kind=RKIND), dimension(:, :) :: xValueForTime - real(kind=RKIND), dimension(:, :) :: yValueForTime - real(kind=RKIND), dimension(:, :) :: zValueForTime + real(kind=RKIND_tiempo), dimension(:), allocatable :: timeStep + real(kind=RKIND), dimension(:, :), allocatable :: xValueForTime + real(kind=RKIND), dimension(:, :), allocatable :: yValueForTime + real(kind=RKIND), dimension(:, :), allocatable :: zValueForTime + !Intent storage order: !(:) == (frquencyinstance) => timeValue !(:,:) == (frquencyinstance, componentId) => escalar @@ -44,12 +45,12 @@ subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Co character(len=BUFSIZE), intent(in) :: outputTypeExtension type(MediaData_t), pointer, dimension(:) :: simulationMedia - type(media_matrices_t), intent(in) :: media - type(limit_t), dimension(1:6), intent(in) :: sinpml_fullsize + type(media_matrices_t), pointer, intent(in) :: media + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize type(domain_t), intent(in) :: domain - integer(kind=SINGLE) :: i + integer(kind=SINGLE) :: i, totalPecSurfaces this%xCoord = iCoord this%yCoord = jCoord @@ -67,21 +68,21 @@ subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Co totalPecSurfaces = count_pec_surfaces() if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then - allocate (timeStep(BuffObse, totalPecSurfaces) & - xValueForTime(BuffObse, totalPecSurfaces) & - yValueForTime(BuffObse, totalPecSurfaces) & - zValueForTime(BuffObse, totalPecSurfaces)) - xValueForTime = 0.0_RKIND - yValueForTime = 0.0_RKIND - zValueForTime = 0.0_RKIND + allocate (this%timeStep(BuffObse)) + allocate (this%xValueForTime(BuffObse, totalPecSurfaces)) + allocate (this%yValueForTime(BuffObse, totalPecSurfaces)) + allocate (this%zValueForTime(BuffObse, totalPecSurfaces)) + this%xValueForTime = 0.0_RKIND + this%yValueForTime = 0.0_RKIND + this%zValueForTime = 0.0_RKIND end if if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then this%nFreq = this%domain%fnum allocate (this%frequencySlice(this%domain%fnum)) - allocate (this%xValueForFreq(this%domain%fnum, totalPecSurfaces) & - this%yValueForFreq(this%domain%fnum, totalPecSurfaces) & - this%zValueForFreq(this%domain%fnum, totalPecSurfaces)) + allocate (this%xValueForFreq(this%domain%fnum, totalPecSurfaces)) + allocate (this%yValueForFreq(this%domain%fnum, totalPecSurfaces)) + allocate (this%zValueForFreq(this%domain%fnum, totalPecSurfaces)) do i = 1, this%nFreq call init_frequency_slice(this%frequencySlice, this%domain) end do @@ -103,13 +104,17 @@ end function get_output_path function count_pec_surfaces() result(n) integer(kind=SINGLE) :: i, j, k, field - integer(kind=SINGLE) :: n = 0_SINGLE - do concurrent(i=icoord:i2coord, j=jcoord:j2coord, k=kcoord:k2coord, field= iEx:iEz) !Ejecuta todas las combinaciones de (i, j, k, field) - if (isWithinBounds(field, iii, jjj, kkk)) then - if (isThinWire(field, iii, jjj, kkk)) then + integer(kind=SINGLE) :: n, iii, jjj, kkk + n = 0_SINGLE + do i = icoord,i2coord + do j = jcoord,j2coord + do k = kcoord,k2coord + do field = iEx,iEz + if (isWithinBounds(field, iii, jjj, kkk, sinpml_fullsize)) then + if (isThinWire(field, iii, jjj, kkk, simulationMedia, media)) then n = n + 1 end if - if (.not. isMediaVacuum(field, iii, jjj, kkk, media) .and. .not. isSplitOrAdvanced(field, iii, jjj, kkk)) then + if (.not. isMediaVacuum(field, iii, jjj, kkk, media) .and. .not. isSplitOrAdvanced(field, iii, jjj, kkk, media, simulationMedia)) then n = n + 1 end if if (isPECorSurface(field, iii, jjj, kkk, media, simulationMedia) .or. field == blockCurrent(field)) then @@ -117,15 +122,23 @@ function count_pec_surfaces() result(n) end if end if end do + end do + end do + end do - end function count_pec_surface + end function count_pec_surfaces end subroutine init_volumic_probe_output - subroutine update_volumic_probe_output(this, step) + subroutine update_volumic_probe_output(this, step, media, simulationMedia, sinpml_fullsize, fieldsReference) type(volumic_current_probe_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step - integer(kind=SINGLE) :: Efield, iii, jjj, kkk + type(media_matrices_t), pointer, intent(in) :: media + type(MediaData_t), pointer, dimension(:) :: simulationMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + type(fields_reference_t), pointer, intent(in) :: fieldsReference + + integer(kind=SINGLE) :: Efield, Hfield, iii, jjj, kkk integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2, conta if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then @@ -137,7 +150,14 @@ subroutine update_volumic_probe_output(this, step) do Efield = iEx, iEz if (isRelevantCell(Efield, iii, jjj, kkk)) then conta = conta + 1 - call save_current(this, Efield, iii, jjj, kkk, conta) + call save_current(this, Efield, iii, jjj, kkk, conta, fieldsReference) + + end if + end do + do Hfield = iHx, iHz + if (isRelevantSurfaceCell(Hfield, iii, jjj, kkk, this%fieldComponent)) then + conta = conta + 1 + call save_current_surfaces(this, Hfield, iii, jjj, kkk, conta, fieldsReference) end if end do end do @@ -147,25 +167,55 @@ subroutine update_volumic_probe_output(this, step) if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then end if contains - LOGICAL FUNCTION isRelevantCell(Efield, I, J, K) - IMPLICIT NONE - INTEGER, INTENT(IN) :: Efield, I, J, K + logical function isRelevantCell(Efield, I, J, K) + integer(kind=SINGLE), intent(in) :: Efield, I, J, K - isRelevantCell = isWithinBounds(Efield, I, J, K) .AND. & - (isThinWire(Efield, I, J, K) .OR. & - (.NOT. isMediaVacuum(Efield, I, J, K) .AND. & - .NOT. isSplitOrAdvanced(Efield, I, J, K))) + if (isWithinBounds(Efield, I, J, K, sinpml_fullsize)) then + isRelevantCell = isThinWire(Efield, I, J, K, simulationMedia, media) .OR. & + (.NOT. isMediaVacuum(Efield, I, J, K, media) .AND. .NOT. isSplitOrAdvanced(Efield, I, J, K, media, simulationMedia)) + else + isRelevantCell = .false. + end if END FUNCTION isRelevantCell - subroutine save_current(this, Efield, iii, jjj, kkk, conta) + logical function isRelevantSurfaceCell(Hfield, I, J, K, outputType) + integer(kind=SINGLE), intent(in) :: Hfield, I, J, K, outputType + + if (isWithinBounds(Hfield, I, J, K, sinpml_fullsize)) then + isRelevantSurfaceCell = isPECorSurface(Hfield, iii, jjj, kkk, media, simulationMedia) .or. outputType == blockCurrent(Hfield) + else + isRelevantSurfaceCell = .false. + end if + end function + + subroutine save_current(this, Efield, iii, jjj, kkk, conta, field_reference) + type(fields_reference_t), pointer, intent(in) :: field_reference type(volumic_current_probe_t), intent(inout) :: this integer(kind=SINGLE), intent(in) :: Efield, iii, jjj, kkk, conta - jdir = computeJ(EField, iii, jjj, kkk) + + real(kind=RKIND) :: jdir + + jdir = computeJ(EField, iii, jjj, kkk, field_reference) this%xValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEx) this%yValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEy) this%zValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEz) end subroutine save_current + + subroutine save_current_surfaces(this, Hfield, iii, jjj, kkk, conta, field_reference) + implicit none + type(fields_reference_t), pointer, intent(in) :: field_reference + type(volumic_current_probe_t), intent(inout) :: this + integer(kind=SINGLE), intent(in) :: Hfield, iii, jjj, kkk, conta + + real(kind=RKIND) :: jdir1, jdir2 + jdir1 = computeJ1(HField, iii, jjj, kkk, field_reference) + jdir2 = computeJ2(HField, iii, jjj, kkk, field_reference) + + this%xValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHz), Hfield == iHx) + this%yValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHx), Hfield == iHy) + this%zValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHy), Hfield == iHz) + end subroutine save_current_surfaces end subroutine update_volumic_probe_output end module mod_volumicProbe diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 134ce76a..61ba6b88 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -5,6 +5,8 @@ function test_initialize() bind(C) result(err) type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl + type(media_matrices_t), pointer:: dummymedia + type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .true. @@ -21,7 +23,7 @@ function test_initialize() bind(C) result(err) !Set control flags dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') - call init_outputs(dummysgg, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, outputs, ThereAreWires) deallocate (dummysgg%Observation) deallocate (outputs) From aae97ce641a7202eff53b32f115fde644de56378 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 3 Dec 2025 12:53:38 +0100 Subject: [PATCH 18/67] added material creation utils --- test/utils/fdetypes_tools.F90 | 221 ++++++++++++++++++++++++++++++---- 1 file changed, 196 insertions(+), 25 deletions(-) diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index dd3025b6..29e17e77 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -1,5 +1,6 @@ module FDETYPES_TOOLS use FDETYPES + use NFDETypes contains function create_limit_t(XI, XE, YI, YE, ZI, ZE, NX, NY, NZ) result(r) type(limit_t) :: r @@ -114,7 +115,7 @@ function create_base_sgg(NumMedia, dt, time_steps) result(sgg) sgg%dt = merge(dt, 0.1_RKIND_tiempo, present(dt)) nTimes = merge(time_steps, 100, present(time_steps)) - allocate(sgg%tiempo(nTimes)) + allocate (sgg%tiempo(nTimes)) sgg%tiempo = create_time_array(nTimes, sgg%dt) ! Hardcoded array limits now call the optional-aware function @@ -136,8 +137,6 @@ function create_time_array(array_size, interval) result(arr) size_val = merge(array_size, 100, present(array_size)) interval_val = merge(interval, 1.0_RKIND_tiempo, present(interval)) - - allocate (arr(size_val)) DO i = 1, size_val @@ -192,10 +191,6 @@ function create_facesNF2FF(tr, fr, iz, de, ab, ar) result(faces) if (present(ar)) faces%ar = ar end function create_facesNF2FF - function create_basic_media() result(media) - type(MediaData_t) :: media - end function create_basic_media - function define_point_observation() result(obs) type(Obses_t) :: obs @@ -225,7 +220,7 @@ function define_point_observation() result(obs) end function define_point_observation function define_wire_current_observation() result(obs) - type(Obses_t) :: obs + type(Obses_t) :: obs obs%nP = 1 allocate (obs%P(obs%nP)) @@ -251,9 +246,8 @@ function define_wire_current_observation() result(obs) obs%Flushed = .false. end function define_wire_current_observation - function define_wire_charge_observation() result(obs) - type(Obses_t) :: obs + type(Obses_t) :: obs obs%nP = 1 allocate (obs%P(obs%nP)) @@ -279,23 +273,200 @@ function define_wire_charge_observation() result(obs) obs%Flushed = .false. end function define_wire_charge_observation - function create_observable(XI,YI,ZI,XE,YE,ZE, what) result(observable) - type(observable_t) :: observable - integer (kind=4) :: XI,YI,ZI,XE,YE,ZE, what - - observable%XI = XI - observable%YI = YI - observable%ZI = ZI + function create_observable(XI, YI, ZI, XE, YE, ZE, what) result(observable) + type(observable_t) :: observable + integer(kind=4) :: XI, YI, ZI, XE, YE, ZE, what + + observable%XI = XI + observable%YI = YI + observable%ZI = ZI + + observable%XE = XE + observable%YE = YE + observable%ZE = ZE + + observable%Xtrancos = 1 + observable%Ytrancos = 1 + observable%Ztrancos = 1 + + observable%What = what + end function create_observable + + subroutine add_media_data_to_sgg(sgg, mediaData) + implicit none + + type(SGGFDTDINFO), intent(inout) :: sgg + type(MediaData_t), intent(in) :: mediaData + + type(MediaData_t), dimension(:), allocatable :: temp_Med + integer :: new_size, istat + + new_size = sgg%NumMedia + 1 + + allocate (temp_Med(new_size), stat=istat) + if (istat /= 0) then + stop "Allocation failed for temporary media array." + end if + + if (sgg%NumMedia > 0) then + temp_Med(1:sgg%NumMedia) = sgg%Med + + deallocate (sgg%Med) + end if + + temp_Med(new_size) = mediaData + + sgg%Med => temp_Med + + sgg%NumMedia = new_size + + end subroutine add_media_data_to_sgg + + function get_default_mediadata() result(res) + implicit none + + type(MediaData_t) :: res + + ! Reals + res%Priority = prior_BV + res%Epr = 1.0_RKIND + res%Sigma = 0.0_RKIND + res%Mur = 1.0_RKIND + res%SigmaM = 0.0_RKIND + + ! Logical + res%sigmareasignado = .false. + + ! exists_t logicals + res%Is%PML = .false. + res%Is%PEC = .false. + res%Is%PMC = .false. + res%Is%ThinWire = .false. + res%Is%SlantedWire = .false. + res%Is%EDispersive = .false. + res%Is%MDispersive = .false. + res%Is%EDispersiveAnis = .false. + res%Is%MDispersiveAnis = .false. + res%Is%ThinSlot = .false. + res%Is%PMLbody = .false. + res%Is%SGBC = .false. + res%Is%SGBCDispersive = .false. + res%Is%Lumped = .false. + res%Is%Lossy = .false. + res%Is%AnisMultiport = .false. + res%Is%Multiport = .false. + res%Is%MultiportPadding = .false. + res%Is%Dielectric = .false. + res%Is%Anisotropic = .false. + res%Is%Volume = .false. + res%Is%Line = .false. + res%Is%Surface = .false. + res%Is%Needed = .true. + res%Is%Interfase = .false. + res%Is%already_YEEadvanced_byconformal = .false. + res%Is%split_and_useless = .false. + + ! Pointers: They are automatically unassociated (nullified) + ! when a function returns a type with pointer components, + ! unless explicitly associated before return. + ! For safety, we can explicitly nullify them, although Fortran often handles this. + nullify (res%Wire) + nullify (res%SlantedWire) + nullify (res%PMLbody) + nullify (res%Multiport) + nullify (res%AnisMultiport) + nullify (res%EDispersive) + nullify (res%MDispersive) + nullify (res%Anisotropic) + nullify (res%Lumped) + + end function get_default_mediadata + + function create_pec_media() result(res) + implicit none + + type(MediaData_t) :: res + + res = get_default_mediadata() + + res%Is%PEC = .TRUE. + + res%Priority = prior_PEC + res%Epr = this%mats%mats(1)%eps/Eps0 + res%Sigma = 1.0e29_RKIND + res%Mur = this%mats%mats(1)%mu/Mu0 + res%SigmaM = 0.0_RKIND + + end function create_pec_media + + function create_empty_material() result(mat) + implicit none + type(Material) :: mat + end function create_empty_material + + function create_material(eps_in, mu_in, sigma_in, sigmam_in, id_in) result(mat) + implicit none + real(kind=RK), intent(in) :: eps_in, mu_in, sigma_in, sigmam_in + integer(kind=4), intent(in) :: id_in + type(Material) :: mat + + ! Error if restricted IDs + if ((id_in == 0) .or. (id_in == 1) .or. (id_in == 2)) then + stop 'ERROR in create_material: Material ID cannot be 0, 1, or 2, as they are reserved to vacuum, pec and pmc.' + end if + + mat%eps = eps_in + mat%mu = mu_in + mat%sigma = sigma_in + mat%sigmam = sigmam_in + mat%id = id_in + end function create_material + + function create_vacuum_material() result(mat) + mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, 0.0, 1) + end function create_vacuum_material + + function create_pec_material() result(mat) + type(Material) :: mat + mat = create_material(EPSILON_VACUUM, MU_VACUUM, SIGMA_PEC, 0.0, 2) + end function create_pec_material + + function create_pmc_material() result(mat) + type(Material) :: mat + mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, SIGMA_PMC, 3) + end function create_pec_material + + function create_empty_materials() result(mats) + implicit none + type(Materials) :: mats + end function create_empty_materials + + subroutine add_material_to_materials(mats_collection, new_mat) + implicit none + type(Materials), intent(inout) :: mats_collection + type(Material), intent(in) :: new_mat + + type(Material), dimension(:), allocatable :: temp_Mats + integer :: old_size, new_size + + old_size = mats_collection%n_Mats + new_size = old_size + 1 + + allocate (temp_Mats(new_size)) + + if (old_size > 0) then + temp_Mats(1:old_size) = mats_collection%Mats + + deallocate (mats_collection%Mats) + end if + + temp_Mats(new_size) = new_mat - observable%XE = XE - observable%YE = YE - observable%ZE = ZE + mats_collection%Mats => temp_Mats - observable%Xtrancos = 1 - observable%Ytrancos = 1 - observable%Ztrancos = 1 + mats_collection%n_Mats = new_size + mats_collection%n_Mats_max = new_size - observable%What = what - end function create_observable + end subroutine add_material_to_materials end module FDETYPES_TOOLS From 2560a12ecb800740f228b19d29bf4ce2916243dd Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 3 Dec 2025 15:10:31 +0100 Subject: [PATCH 19/67] Added eps0 y mu0 to fdetypes utils --- test/output/test_output.F90 | 3 +- test/utils/fdetypes_tools.F90 | 77 ++++++++++++++++++++++++++--------- 2 files changed, 60 insertions(+), 20 deletions(-) diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 61ba6b88..6755f59e 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -8,12 +8,13 @@ function test_initialize() bind(C) result(err) type(media_matrices_t), pointer:: dummymedia type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize type(solver_output_t), dimension(:), allocatable :: outputs + type(MediaData_t) :: defaultMaterial, pecMaterial logical :: ThereAreWires = .true. integer(kind=SINGLE) :: test_err = 0 !Set requested observables - dummysgg = create_base_sgg(nummedia=5, dt=0.1_RKIND_tiempo, time_steps=100) + dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) dummysgg%NumberRequest = 3 allocate (dummysgg%Observation(3)) dummysgg%Observation(1) = define_point_observation() diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index 29e17e77..87335d8e 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -1,6 +1,10 @@ module FDETYPES_TOOLS use FDETYPES use NFDETypes + + implicit none + real(kind=rkind) :: EPS0 = 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 + real(kind=rkind) :: MU0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 contains function create_limit_t(XI, XE, YI, YE, ZI, ZE, NX, NY, NZ) result(r) type(limit_t) :: r @@ -103,14 +107,20 @@ function create_control_flags(layoutnumber, size, mpidir, finaltimestep, & end function create_control_flags - function create_base_sgg(NumMedia, dt, time_steps) result(sgg) + function create_base_sgg(dt, time_steps) result(sgg) + implicit none type(SGGFDTDINFO) :: sgg - integer, optional, intent(in) :: NumMedia, time_steps + type(MediaData_t), dimension(:), allocatable, target :: media + integer, optional, intent(in) :: time_steps real(kind=RKIND_tiempo), optional, intent(in) :: dt - sgg%NumMedia = merge(NumMedia, 3, present(NumMedia)) + integer(kind=SINGLE) :: nTimes + + media = create_base_media() + sgg%NumMedia = 3 + sgg%med => media + allocate (sgg%Med(1:sgg%NumMedia)) - sgg%Med = create_basic_media() sgg%NumberRequest = 1 sgg%dt = merge(dt, 0.1_RKIND_tiempo, present(dt)) @@ -118,7 +128,6 @@ function create_base_sgg(NumMedia, dt, time_steps) result(sgg) allocate (sgg%tiempo(nTimes)) sgg%tiempo = create_time_array(nTimes, sgg%dt) - ! Hardcoded array limits now call the optional-aware function sgg%Sweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) sgg%SINPMLSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) sgg%NumPlaneWaves = 1 @@ -126,6 +135,18 @@ function create_base_sgg(NumMedia, dt, time_steps) result(sgg) end function create_base_sgg + function create_base_media() result(media) + implicit none + + type(MediaData_t), dimension(3) :: media + + media(1) = get_default_mediadata() + media(2) = create_pec_media() + media(3) = create_pmc_media() + + + end function create_base_media + function create_time_array(array_size, interval) result(arr) integer, intent(in), optional :: array_size real(kind=RKIND_tiempo), intent(in), optional :: interval @@ -298,7 +319,7 @@ subroutine add_media_data_to_sgg(sgg, mediaData) type(SGGFDTDINFO), intent(inout) :: sgg type(MediaData_t), intent(in) :: mediaData - type(MediaData_t), dimension(:), allocatable :: temp_Med + type(MediaData_t), dimension(:), target, allocatable :: temp_Med integer :: new_size, istat new_size = sgg%NumMedia + 1 @@ -328,7 +349,7 @@ function get_default_mediadata() result(res) type(MediaData_t) :: res ! Reals - res%Priority = prior_BV + res%Priority = 10 res%Epr = 1.0_RKIND res%Sigma = 0.0_RKIND res%Mur = 1.0_RKIND @@ -386,19 +407,41 @@ function create_pec_media() result(res) implicit none type(MediaData_t) :: res + type(Material) :: mat + mat = create_pec_material() res = get_default_mediadata() res%Is%PEC = .TRUE. - res%Priority = prior_PEC - res%Epr = this%mats%mats(1)%eps/Eps0 - res%Sigma = 1.0e29_RKIND - res%Mur = this%mats%mats(1)%mu/Mu0 - res%SigmaM = 0.0_RKIND + res%Priority = 150 + res%Epr = mat%eps/EPS0 + res%Sigma = mat%sigma + res%Mur = mat%mu/MU0 + res%SigmaM = mat%sigmam end function create_pec_media + function create_pmc_media() result(res) + implicit none + + type(MediaData_t) :: res + type(Material) :: mat + + mat = create_pmc_material() + res = get_default_mediadata() + + res%Is%PMC = .TRUE. + + res%Priority = 160 + res%Epr = mat%eps/EPS0 + res%Sigma = mat%sigma + res%Mur = mat%mu/MU0 + res%SigmaM = mat%sigmam + + end function create_pmc_media + + function create_empty_material() result(mat) implicit none type(Material) :: mat @@ -410,11 +453,6 @@ function create_material(eps_in, mu_in, sigma_in, sigmam_in, id_in) result(mat) integer(kind=4), intent(in) :: id_in type(Material) :: mat - ! Error if restricted IDs - if ((id_in == 0) .or. (id_in == 1) .or. (id_in == 2)) then - stop 'ERROR in create_material: Material ID cannot be 0, 1, or 2, as they are reserved to vacuum, pec and pmc.' - end if - mat%eps = eps_in mat%mu = mu_in mat%sigma = sigma_in @@ -423,6 +461,7 @@ function create_material(eps_in, mu_in, sigma_in, sigmam_in, id_in) result(mat) end function create_material function create_vacuum_material() result(mat) + type(Material) :: mat mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, 0.0, 1) end function create_vacuum_material @@ -434,7 +473,7 @@ end function create_pec_material function create_pmc_material() result(mat) type(Material) :: mat mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, SIGMA_PMC, 3) - end function create_pec_material + end function create_pmc_material function create_empty_materials() result(mats) implicit none @@ -446,7 +485,7 @@ subroutine add_material_to_materials(mats_collection, new_mat) type(Materials), intent(inout) :: mats_collection type(Material), intent(in) :: new_mat - type(Material), dimension(:), allocatable :: temp_Mats + type(Material), dimension(:), target, allocatable :: temp_Mats integer :: old_size, new_size old_size = mats_collection%n_Mats From 8be886555070315fd9745e8746635c616a6f0d8f Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 3 Dec 2025 17:56:08 +0100 Subject: [PATCH 20/67] Added observation utils for testing outputs --- src_main_pub/fdetypes.F90 | 12 +- test/observation/test_observation_init.F90 | 2 +- test/output/CMakeLists.txt | 1 + test/output/test_output.F90 | 15 +- test/output/test_output_utils.F90 | 19 ++ test/utils/fdetypes_tools.F90 | 283 ++++++++++++++++++++- 6 files changed, 308 insertions(+), 24 deletions(-) create mode 100644 test/output/test_output_utils.F90 diff --git a/src_main_pub/fdetypes.F90 b/src_main_pub/fdetypes.F90 index b317bb34..c0fd857c 100755 --- a/src_main_pub/fdetypes.F90 +++ b/src_main_pub/fdetypes.F90 @@ -594,15 +594,15 @@ module FDETYPES REAL (KIND=RKIND_tiempo) :: dt character (len=BUFSIZE) :: extraswitches !! - integer (kind=4) :: NumMedia,AllocMed - integer (kind=4) :: IniPMLMedia,EndPMLMedia - integer (kind=4) :: NumPlaneWaves,TimeSteps,InitialTimeStep - integer (kind=4) :: NumNodalSources - integer (kind=4) :: NumberRequest + integer (kind=SINGLE) :: NumMedia,AllocMed + integer (kind=SINGLE) :: IniPMLMedia,EndPMLMedia + integer (kind=SINGLE) :: NumPlaneWaves,TimeSteps,InitialTimeStep + integer (kind=SINGLE) :: NumNodalSources + integer (kind=SINGLE) :: NumberRequest = 0_SINGLE !!! REAL (KIND=RKIND) , pointer, dimension ( : ) :: LineX,LineY,LineZ REAL (KIND=RKIND) , pointer, dimension ( : ) :: DX,DY,DZ - integer (kind=4) :: AllocDxI,AllocDyI,AllocDzI,AllocDxE,AllocDyE,AllocDzE + integer (kind=SINGLE) :: AllocDxI,AllocDyI,AllocDzI,AllocDxE,AllocDyE,AllocDzE type (planeonde_t), pointer, dimension ( : ) :: PlaneWave type (Border_t) :: Border type (PML_t) :: PML diff --git a/test/observation/test_observation_init.F90 b/test/observation/test_observation_init.F90 index 85e65483..e4f75d85 100644 --- a/test/observation/test_observation_init.F90 +++ b/test/observation/test_observation_init.F90 @@ -19,7 +19,7 @@ integer function test_init_time_movie_observation() bind(C) result(err) type(output_t), pointer, dimension(:) :: output - sgg = create_base_sgg() + sgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) call set_sgg_data(sgg) media = create_media(sgg%Alloc) diff --git a/test/output/CMakeLists.txt b/test/output/CMakeLists.txt index 3c66ad8a..ce30ba47 100644 --- a/test/output/CMakeLists.txt +++ b/test/output/CMakeLists.txt @@ -3,6 +3,7 @@ message(STATUS "Creating build system for test/output") add_library( output_test_fortran "test_output.F90" + "test_output_utils.F90" ) target_link_libraries(output_test_fortran diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 6755f59e..551a713c 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -2,6 +2,7 @@ function test_initialize() bind(C) result(err) use FDETYPES use FDETYPES_TOOLS use output + use mod_testOutputUtils type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl @@ -11,15 +12,19 @@ function test_initialize() bind(C) result(err) type(MediaData_t) :: defaultMaterial, pecMaterial logical :: ThereAreWires = .true. + type(Obses_t) :: pointProbeObservable + integer(kind=SINGLE) :: test_err = 0 !Set requested observables dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) - dummysgg%NumberRequest = 3 - allocate (dummysgg%Observation(3)) - dummysgg%Observation(1) = define_point_observation() - dummysgg%Observation(2) = define_wire_current_observation() - dummysgg%Observation(3) = define_wire_charge_observation() + + pointProbeObservable = create_point_probe_observable() + call add_observation_to_sgg(dummysgg, pointProbeObservable) + + !Set dummymedia + + !set dummysinpml_fullsize !Set control flags dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 new file mode 100644 index 00000000..1e0754c1 --- /dev/null +++ b/test/output/test_output_utils.F90 @@ -0,0 +1,19 @@ +module mod_testOutputUtils + use FDETYPES + use FDETYPES_TOOLS + + implicit none +contains + function create_point_probe_observable() result(obs) + type(Obses_t) :: obs + + type(observable_t), dimension(:), allocatable :: P + type(observation_domain_t) :: domain + + call initialize_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) + allocate(P(1)) + P(1) = create_observable(0, 0, 0, 6, 6, 6, iEx) + call set_observable(obs, P, 'poinProbe', domain, 'DummyFileNormalize') + + end function +end module mod_testOutputUtils diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index 87335d8e..5569254f 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -3,8 +3,32 @@ module FDETYPES_TOOLS use NFDETypes implicit none - real(kind=rkind) :: EPS0 = 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 - real(kind=rkind) :: MU0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 + real(kind=rkind) :: UTILEPS0 = 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 + real(kind=rkind) :: UTILMU0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 + type :: observation_domain_t + real(kind=RKIND) :: InitialTime = 0.0_RKIND + real(kind=RKIND) :: FinalTime = 0.0_RKIND + real(kind=RKIND) :: TimeStep = 0.0_RKIND + + real(kind=RKIND) :: InitialFreq = 0.0_RKIND + real(kind=RKIND) :: FinalFreq = 0.0_RKIND + real(kind=RKIND) :: FreqStep = 0.0_RKIND + + real(kind=RKIND) :: thetaStart = 0.0_RKIND + real(kind=RKIND) :: thetaStop = 0.0_RKIND + real(kind=RKIND) :: thetaStep = 0.0_RKIND + + real(kind=RKIND) :: phiStart = 0.0_RKIND + real(kind=RKIND) :: phiStop = 0.0_RKIND + real(kind=RKIND) :: phiStep = 0.0_RKIND + + logical :: FreqDomain = .FALSE. + logical :: TimeDomain = .TRUE. + logical :: Saveall = .FALSE. + logical :: TransFer = .FALSE. + logical :: Volumic = .FALSE. + end type observation_domain_t + contains function create_limit_t(XI, XE, YI, YE, ZI, ZE, NX, NY, NZ) result(r) type(limit_t) :: r @@ -120,8 +144,6 @@ function create_base_sgg(dt, time_steps) result(sgg) sgg%NumMedia = 3 sgg%med => media - allocate (sgg%Med(1:sgg%NumMedia)) - sgg%NumberRequest = 1 sgg%dt = merge(dt, 0.1_RKIND_tiempo, present(dt)) nTimes = merge(time_steps, 100, present(time_steps)) @@ -144,7 +166,6 @@ function create_base_media() result(media) media(2) = create_pec_media() media(3) = create_pmc_media() - end function create_base_media function create_time_array(array_size, interval) result(arr) @@ -294,9 +315,12 @@ function define_wire_charge_observation() result(obs) obs%Flushed = .false. end function define_wire_charge_observation - function create_observable(XI, YI, ZI, XE, YE, ZE, what) result(observable) + function create_observable(XI, YI, ZI, XE, YE, ZE, what, line_in) result(observable) type(observable_t) :: observable - integer(kind=4) :: XI, YI, ZI, XE, YE, ZE, what + integer(kind=4), intent(in) :: XI, YI, ZI, XE, YE, ZE, what + type(direction_t), dimension(:), optional, intent(in) :: line_in + + integer(kind=SINGLE) :: line_size observable%XI = XI observable%YI = YI @@ -311,6 +335,18 @@ function create_observable(XI, YI, ZI, XE, YE, ZE, what) result(observable) observable%Ztrancos = 1 observable%What = what + + if (present(line_in)) then + line_size = size(line_in) + + if (line_size > 0) then + allocate (observable%line(1:line_size)) + + observable%line = line_in + else + + end if + end if end function create_observable subroutine add_media_data_to_sgg(sgg, mediaData) @@ -414,10 +450,10 @@ function create_pec_media() result(res) res%Is%PEC = .TRUE. - res%Priority = 150 - res%Epr = mat%eps/EPS0 + res%Priority = 150 + res%Epr = mat%eps/UTILEPS0 res%Sigma = mat%sigma - res%Mur = mat%mu/MU0 + res%Mur = mat%mu/UTILMU0 res%SigmaM = mat%sigmam end function create_pec_media @@ -434,13 +470,36 @@ function create_pmc_media() result(res) res%Is%PMC = .TRUE. res%Priority = 160 - res%Epr = mat%eps/EPS0 + res%Epr = mat%eps/UTILEPS0 res%Sigma = mat%sigma - res%Mur = mat%mu/MU0 + res%Mur = mat%mu/UTILMU0 res%SigmaM = mat%sigmam end function create_pmc_media +!function create_thinwire_media() result(res) +! implicit none +! +! type(MediaData_t) :: res +! type(Material) :: mat +! +! type(Wires_t), target :: wire +! +! mat = create_thinwire_material() +! res = get_default_mediadata() +! +! res%Is%ThinWire = .TRUE. +! +! allocate (res%Wire(1)) +! wire = create_wire() +! res%Wire(1) => wire +! +! res%Priority = 15 +! res%Epr = mat%eps/UTILEPS0 +! res%Sigma = mat%sigma +! res%Mur = mat%mu/UTILMU0 +! res%SigmaM = mat%sigmam +!end function create_thinwire_media function create_empty_material() result(mat) implicit none @@ -508,4 +567,204 @@ subroutine add_material_to_materials(mats_collection, new_mat) end subroutine add_material_to_materials + function get_default_wire() result(wire) + implicit none + type(Wires_t) :: wire + + wire%Radius = 0.0_RKIND_wires + wire%R = 0.0_RKIND_wires + wire%L = 0.0_RKIND_wires + wire%C = 0.0_RKIND_wires + wire%P_R = 0.0_RKIND_wires + wire%P_L = 0.0_RKIND_wires + wire%P_C = 0.0_RKIND_wires + wire%Radius_devia = 0.0_RKIND_wires + wire%R_devia = 0.0_RKIND_wires + wire%L_devia = 0.0_RKIND_wires + wire%C_devia = 0.0_RKIND_wires + + wire%numsegmentos = 0 + wire%NUMVOLTAGESOURCES = 0 + wire%NUMCURRENTSOURCES = 0 + + nullify (wire%segm) + nullify (wire%Vsource) + nullify (wire%Isource) + + wire%VsourceExists = .false. + wire%IsourceExists = .false. + wire%HasParallel_LeftEnd = .false. + wire%HasParallel_RightEnd = .false. + wire%HasSeries_LeftEnd = .false. + wire%HasSeries_RightEnd = .false. + wire%HasAbsorbing_LeftEnd = .false. + wire%HasAbsorbing_RightEnd = .false. + + wire%Parallel_R_RightEnd = 0.0_RKIND_wires + wire%Parallel_R_LeftEnd = 0.0_RKIND_wires + wire%Series_R_RightEnd = 0.0_RKIND_wires + wire%Series_R_LeftEnd = 0.0_RKIND_wires + wire%Parallel_L_RightEnd = 0.0_RKIND_wires + wire%Parallel_L_LeftEnd = 0.0_RKIND_wires + wire%Series_L_RightEnd = 0.0_RKIND_wires + wire%Series_L_LeftEnd = 0.0_RKIND_wires + wire%Parallel_C_RightEnd = 0.0_RKIND_wires + wire%Parallel_C_LeftEnd = 0.0_RKIND_wires + wire%Series_C_RightEnd = 2.0e7_RKIND ! Valor por defecto de corto + wire%Series_C_LeftEnd = 2.0e7_RKIND ! Valor por defecto de corto + + wire%Parallel_R_RightEnd_devia = 0.0_RKIND_wires + wire%Parallel_R_LeftEnd_devia = 0.0_RKIND_wires + wire%Series_R_RightEnd_devia = 0.0_RKIND_wires + wire%Series_R_LeftEnd_devia = 0.0_RKIND_wires + wire%Parallel_L_RightEnd_devia = 0.0_RKIND_wires + wire%Parallel_L_LeftEnd_devia = 0.0_RKIND_wires + wire%Series_L_RightEnd_devia = 0.0_RKIND_wires + wire%Series_L_LeftEnd_devia = 0.0_RKIND_wires + wire%Parallel_C_RightEnd_devia = 0.0_RKIND_wires + wire%Parallel_C_LeftEnd_devia = 0.0_RKIND_wires + wire%Series_C_RightEnd_devia = 0.0_RKIND_wires + wire%Series_C_LeftEnd_devia = 0.0_RKIND_wires + + wire%LeftEnd = 0 + wire%RightEnd = 0 + end function get_default_wire + + subroutine add_observation_to_sgg(sgg, new_observation) + implicit none + + type(SGGFDTDINFO), intent(inout) :: sgg + type(Obses_t), intent(in), target :: new_observation + + type(Obses_t), dimension(:), pointer :: temp_obs + integer :: old_size, new_size + + old_size = sgg%NumberRequest + new_size = old_size + 1 + + allocate (temp_obs(1:new_size)) + + if (old_size > 0) then + temp_obs(1:old_size) = sgg%Observation(1:old_size) + deallocate (sgg%Observation) + end if + + temp_obs(new_size) = new_observation + + sgg%Observation => temp_obs + + sgg%NumberRequest = new_size + + end subroutine add_observation_to_sgg + + subroutine set_observable(obs, P_in, outputrequest_in, domain_params, FileNormalize_in) + implicit none + + type(observable_t), dimension(:), intent(in) :: P_in + character(LEN=*), intent(in) :: outputrequest_in, FileNormalize_in + type(observation_domain_t), intent(in) :: domain_params + + type(Obses_t), intent(out) :: obs + integer(kind=4) :: n_count + + n_count = size(P_in) + obs%nP = n_count + + allocate (obs%P(1:n_count)) + + obs%P(1:n_count) = P_in(1:n_count) + + obs%outputrequest = outputrequest_in + obs%FileNormalize = FileNormalize_in + + obs%InitialTime = domain_params%InitialTime + obs%FinalTime = domain_params%FinalTime + obs%TimeStep = domain_params%TimeStep + + obs%InitialFreq = domain_params%InitialFreq + obs%FinalFreq = domain_params%FinalFreq + obs%FreqStep = domain_params%FreqStep + + obs%thetaStart = domain_params%thetaStart + obs%thetaStop = domain_params%thetaStop + obs%thetaStep = domain_params%thetaStep + + obs%phiStart = domain_params%phiStart + obs%phiStop = domain_params%phiStop + obs%phiStep = domain_params%phiStep + + obs%FreqDomain = domain_params%FreqDomain + obs%TimeDomain = domain_params%TimeDomain + obs%Saveall = domain_params%Saveall + obs%TransFer = domain_params%TransFer + obs%Volumic = domain_params%Volumic + + end subroutine set_observable + + subroutine initialize_time_domain(domain, InitialTime, FinalTime, TimeStep) + implicit none + + type(observation_domain_t), intent(inout) :: domain + real(kind=RKIND), intent(in) :: InitialTime, FinalTime, TimeStep + + + domain%InitialTime = InitialTime + domain%FinalTime = FinalTime + domain%TimeStep = TimeStep + + domain%TimeDomain = .true. + + end subroutine initialize_time_domain + + subroutine initialize_frequency_domain(domain, InitialFreq, FinalFreq, FreqStep) + implicit none + + type(observation_domain_t), intent(inout) :: domain + real(kind=RKIND), intent(in) :: InitialFreq, FinalFreq, FreqStep + + + domain%InitialFreq = InitialFreq + domain%FinalFreq = FinalFreq + domain%FreqStep = FreqStep + + domain%FreqDomain = .true. + + end subroutine initialize_frequency_domain + + subroutine initialize_theta_domain(domain, thetaStart, thetaStop, thetaStep) + implicit none + + type(observation_domain_t), intent(inout) :: domain + real(kind=RKIND), intent(in) :: thetaStart, thetaStop, thetaStep + + domain%thetaStart = thetaStart + domain%thetaStop = thetaStop + domain%thetaStep = thetaStep + + end subroutine initialize_theta_domain + + subroutine initialize_phi_domain(domain, phiStart, phiStop, phiStep) + implicit none + + type(observation_domain_t), intent(inout) :: domain + real(kind=RKIND), intent(in) :: phiStart, phiStop, phiStep + + domain%phiStart = phiStart + domain%phiStop = phiStop + domain%phiStep = phiStep + + end subroutine initialize_phi_domain + + subroutine initialize_domain_logical_flags(domain, Saveall_flag, TransFer_flag, Volumic_flag) + implicit none + + type(observation_domain_t), intent(inout) :: domain + logical, intent(in) :: Saveall_flag, TransFer_flag, Volumic_flag + + domain%Saveall = Saveall_flag + domain%TransFer = TransFer_flag + domain%Volumic = Volumic_flag + +end subroutine initialize_domain_logical_flags + end module FDETYPES_TOOLS From 33215ee762b1a705fd96da53b859b9aa676de748 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 4 Dec 2025 10:04:39 +0100 Subject: [PATCH 21/67] WIP Working on tests --- src_output/output.F90 | 59 +++++++++++++++++++++++------ src_output/outputUtils.F90 | 63 +++++++++++++++++++++++++++---- test/output/output_tests.h | 2 + test/output/test_output.F90 | 49 +++++++++++++++++++++++- test/output/test_output_utils.F90 | 1 + 5 files changed, 154 insertions(+), 20 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index 7aa18c59..bdd51f6d 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -91,6 +91,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW integer(kind=SINGLE) :: I1, J1, K1, I2, J2, K2, NODE integer(kind=SINGLE) :: outputCount = 0 character(len=BUFSIZE) :: outputTypeExtension + allocate (outputs(sgg%NumberRequest)) allocate (InvEps(0:sgg%NumMedia), InvMu(0:sgg%NumMedia)) @@ -132,13 +133,13 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW case (iQx, iQy, iQz) outputCount = outputCount + 1 outputs(outputCount)%outputID = WIRE_CHARGE_PROBE_ID - + allocate (outputs(outputCount)%wireChargeProbe) call init_solver_output(outputs(outputCount)%wireChargeProbe, I1, J1, K1, NODE, outputRequestType, domain, outputTypeExtension, control%mpidir, control%wiresflavor) case (iBloqueJx, iBloqueJy, iBloqueJz, iBloqueMx, iBloqueMy, iBloqueMz) outputCount = outputCount + 1 outputs(outputCount)%outputID = BULK_PROBE_ID - + allocate (outputs(outputCount)%bulkProbe) call init_solver_output(outputs(outputCount)%bulkProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, outputTypeExtension, control%mpidir) !! call adjust_computation_range --- Required due to issues in mpi region edges @@ -146,7 +147,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW case (iCur, iCurX, iCurY, iCurZ) outputCount = outputCount + 1 outputs(outputCount)%outputID = VOLUMIC_CURRENT_PROBE_ID - + allocate (outputs(outputCount)%volumicCurrentProbe) call init_solver_output(outputs(outputCount)%volumicCurrentProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir) @@ -213,7 +214,7 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d type(XYZlimit_t), dimension(1:6), intent(in) :: alloc type(sim_control_t), intent(in) :: control real(kind=RKIND), pointer, dimension(:, :, :) :: fieldComponent - type(field_data_t), pointer :: fieldReference + type(field_data_t), pointer :: fieldReference type(fields_reference_t), pointer :: fields real(KIND=RKIND), intent(in), target :: & @@ -225,11 +226,11 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d Hz(alloc(iHz)%XI:alloc(iHz)%XE, alloc(iHz)%YI:alloc(iHz)%YE, alloc(iHz)%ZI:alloc(iHz)%ZE) !---> real(KIND=RKIND), dimension(:), intent(in), target :: dxh(alloc(iEx)%XI:alloc(iEx)%XE), & - dyh(alloc(iEy)%YI:alloc(iEy)%YE), & - dzh(alloc(iEz)%ZI:alloc(iEz)%ZE), & - dxe(alloc(iHx)%XI:alloc(iHx)%XE), & - dye(alloc(iHy)%YI:alloc(iHy)%YE), & - dze(alloc(iHz)%ZI:alloc(iHz)%ZE) + dyh(alloc(iEy)%YI:alloc(iEy)%YE), & + dzh(alloc(iEz)%ZI:alloc(iEz)%ZE), & + dxe(alloc(iHx)%XI:alloc(iHx)%XE), & + dye(alloc(iHy)%YI:alloc(iHy)%YE), & + dze(alloc(iHz)%ZI:alloc(iHz)%ZE) fields%E%x => Ex fields%E%y => Ey @@ -297,11 +298,47 @@ function get_field_reference(fieldId) result(field) field%deltaX => dxh field%deltaY => dyh - field%deltaZ => dzh + field%deltaZ => dzh end select end function get_field_reference - end subroutine update_outputs + subroutine clean_solver_output_array(output_array) + + type(solver_output_t), dimension(:), allocatable, intent(inout) :: output_array + integer :: i + + if (.not. allocated(output_array)) then + return + end if + + do i = 1, size(output_array) + + if (allocated(output_array(i)%pointProbe)) then + deallocate (output_array(i)%pointProbe) + end if + + if (allocated(output_array(i)%wireCurrentProbe)) then + deallocate (output_array(i)%wireCurrentProbe) + end if + + if (allocated(output_array(i)%wireChargeProbe)) then + deallocate (output_array(i)%wireChargeProbe) + end if + + if (allocated(output_array(i)%bulkProbe)) then + deallocate (output_array(i)%bulkProbe) + end if + + if (allocated(output_array(i)%volumicCurrentProbe)) then + deallocate (output_array(i)%volumicCurrentProbe) + end if + + end do + + deallocate (output_array) + + end subroutine clean_solver_output_array + end module output diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index bbf0c436..9429aba6 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -266,7 +266,7 @@ integer function blockCurrent(field) logical function isThinWire(field, i, j, k, simulationMedia, media) integer(kind=4), intent(in) :: field, i, j, k type(MediaData_t), pointer, dimension(:), intent(in) :: simulationMedia - type(media_matrices_t),pointer, intent(in) :: media + type(media_matrices_t), pointer, intent(in) :: media integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex mediaIndex = getMedia(field, i, j, k, media) isThinWire = simulationMedia(mediaIndex)%is%ThinWire @@ -298,7 +298,7 @@ function getMedia(field, i, j, k, media) result(res) logical function isWithinBounds(field, i, j, k, SINPML_fullsize) implicit none - TYPE(limit_t),pointer, DIMENSION(:), INTENT(IN) :: SINPML_fullsize + TYPE(limit_t), pointer, DIMENSION(:), INTENT(IN) :: SINPML_fullsize integer(kind=4), intent(in) :: field, i, j, k isWithinBounds = (i <= SINPML_fullsize(field)%XE) .and. & (j <= SINPML_fullsize(field)%YE) .and. & @@ -307,7 +307,7 @@ logical function isWithinBounds(field, i, j, k, SINPML_fullsize) logical function isMediaVacuum(field, i, j, k, media) implicit none - TYPE(media_matrices_t), pointer ,INTENT(IN) :: media + TYPE(media_matrices_t), pointer, INTENT(IN) :: media integer(kind=4) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex, vacuum = 1 mediaIndex = getMedia(field, i, j, k, media) @@ -398,11 +398,11 @@ function computeJ1(f, i, j, k, fields_reference) result(res) c = mod(f - 2, 3) + 4 ! This typically corresponds to H_z for J_x, or H_x for J_y, etc. - ! First set of H-field terms + ! First set of H-field terms curl_h_term_a = get_delta(c, i, j, k, fields_reference)*get_field(c, i, j, k, fields_reference) + & get_delta(c, i+u(f,iHy), j+u(f,iHz), k+u(f,iHx), fields_reference) * get_field(c, i+u(f,iHy), j+u(f,iHz), k+u(f,iHx), fields_reference) - ! Second set of H-field terms + ! Second set of H-field terms curl_h_term_b = get_delta(c, i, j, k, fields_reference) * get_field(c, i-u(f,iHx), j-u(f,iHy), k-u(f,iHz), fields_reference) + & get_delta(c, i+u(f,iHy), j+u(f,iHz), k+u(f,iHx), fields_reference) * get_field(c, i-u(f,iHx)+u(f,iHy), j-u(f,iHy)+u(f,iHz), k-u(f,iHz)+u(f,iHx), fields_reference) @@ -428,11 +428,11 @@ function computeJ2(f, i, j, k, fields_reference) result(res) ! For f=1 (Ex), c = mod(1-3, 3)+4 = mod(-2, 3)+4 = 1+4 = 5 (Hy). This is the second H-field curl component. c = mod(f - 3, 3) + 4 - ! First set of H-field terms + ! First set of H-field terms curl_h_term_a = get_delta(c, i, j, k, fields_reference)*get_field(c, i, j, k, fields_reference) + & get_delta(c, i+u(f,iHz), j+u(f,iHx), k+u(f,iHy), fields_reference) * get_field(c, i+u(f,iHz), j+u(f,iHx), k+u(f,iHy), fields_reference) - ! Second set of H-field terms + ! Second set of H-field terms curl_h_term_b = get_delta(c, i, j, k, fields_reference) * get_field(c, i-u(f,iHx), j-u(f,iHy), k-u(f,iHz), fields_reference) + & get_delta(c, i+u(f,iHz), j+u(f,iHx), k+u(f,iHy), fields_reference) * get_field(c, i-u(f,iHx)+u(f,iHz), j-u(f,iHy)+u(f,iHx), k-u(f,iHz)+u(f,iHy), fields_reference) @@ -490,4 +490,53 @@ function get_delta(field, i, j, k, fields_reference) result(res) end select end function get_delta + function assert_integer_equal(val, expected, errorMessage) result(err) + + integer, intent(in) :: val + integer, intent(in) :: expected + character(*), intent(in) :: errorMessage + integer :: err + + if (val == expected) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, " Value: ", val, ". Expected: ", expected + end if + end function assert_integer_equal + + function assert_real_equal(val, expected, tolerance, errorMessage) result(err) + + real, intent(in) :: val + real, intent(in) :: expected + real, intent(in) :: tolerance + character(*), intent(in) :: errorMessage + integer :: err + + if (abs(val - expected) <= tolerance) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance + end if + end function assert_real_equal + + function assert_string_equal(val, expected, errorMessage) result(err) + + character(*), intent(in) :: val + character(*), intent(in) :: expected + character(*), intent(in) :: errorMessage + integer :: err + + if (trim(val) == trim(expected)) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, ' Value: "', trim(val), '". Expected: "', trim(expected), '"' + end if + end function assert_string_equal + end module mod_outputUtils diff --git a/test/output/output_tests.h b/test/output/output_tests.h index 54107b97..23355cc5 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -1,5 +1,7 @@ #include extern "C" int test_initialize(); +extern "C" int test_init_point_probe(); TEST(output, test_initialize) {EXPECT_EQ(0, test_initialize()); } +TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 551a713c..5dd94428 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -15,6 +15,7 @@ function test_initialize() bind(C) result(err) type(Obses_t) :: pointProbeObservable integer(kind=SINGLE) :: test_err = 0 + if (allocated(outputs)) deallocate(outputs) !Set requested observables dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) @@ -31,8 +32,52 @@ function test_initialize() bind(C) result(err) call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, outputs, ThereAreWires) - deallocate (dummysgg%Observation) - deallocate (outputs) + call clean_solver_output_array(outputs) err = test_err end function test_initialize + +function test_init_point_probe() bind(c) result(err) + use FDETYPES + use FDETYPES_TOOLS + use output + use mod_testOutputUtils + + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(media_matrices_t), pointer:: dummymedia + type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize + type(solver_output_t), dimension(:), allocatable :: outputs + type(MediaData_t) :: defaultMaterial, pecMaterial + logical :: ThereAreWires = .true. + + type(Obses_t) :: pointProbeObservable + + integer(kind=SINGLE) :: test_err = 0 + + !Cleanup + if (allocated(outputs)) deallocate(outputs) + + !Set requested observables + dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) + + pointProbeObservable = create_point_probe_observable() + call add_observation_to_sgg(dummysgg, pointProbeObservable) + + !Set dummymedia + + !set dummysinpml_fullsize + + !Set control flags + dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') + + call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, outputs, ThereAreWires) + + test_err = assert_integer_equal(outputs(1)%outputID, POINT_PROBE_ID, 'Unexpected probe id') + test_err = assert_integer_equal(outputs(1)%pointProbe%columnas, 2, 'Unexpected number of columns') + test_err = assert_string_equal(outputs(1)%pointProbe%path, 'test', 'Unexpected path') + + deallocate (dummysgg%Observation) + deallocate (outputs) + err = test_err +end function test_init_point_probe diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index 1e0754c1..91453195 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -16,4 +16,5 @@ function create_point_probe_observable() result(obs) call set_observable(obs, P, 'poinProbe', domain, 'DummyFileNormalize') end function + end module mod_testOutputUtils From ff85ef8faefd5e5b886080689a3898845c011e7e Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 4 Dec 2025 15:56:19 +0100 Subject: [PATCH 22/67] fix allocation error on update --- src_output/output.F90 | 122 +++++++----------------------- src_output/outputUtils.F90 | 34 +++++++-- src_output/point_probe_output.F90 | 2 +- test/output/output_tests.h | 4 +- test/output/test_output.F90 | 76 +++++++++++++------ test/output/test_output_utils.F90 | 44 ++++++++++- 6 files changed, 154 insertions(+), 128 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index bdd51f6d..ed473cc2 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -89,12 +89,13 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW type(domain_t) :: domain integer(kind=SINGLE) :: i, ii, outputRequestType integer(kind=SINGLE) :: I1, J1, K1, I2, J2, K2, NODE - integer(kind=SINGLE) :: outputCount = 0 + integer(kind=SINGLE) :: outputCount character(len=BUFSIZE) :: outputTypeExtension allocate (outputs(sgg%NumberRequest)) allocate (InvEps(0:sgg%NumMedia), InvMu(0:sgg%NumMedia)) + outputCount = 0 InvEps(0:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia)%Epr) InvMu(0:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia)%Mur) @@ -207,58 +208,26 @@ end function preprocess_domain end subroutine init_outputs - subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh, alloc) + subroutine update_outputs(outputs, control, step, fields) type(solver_output_t), dimension(:), intent(inout) :: outputs real(kind=RKIND_tiempo) :: step integer(kind=SINGLE) :: i, id - type(XYZlimit_t), dimension(1:6), intent(in) :: alloc type(sim_control_t), intent(in) :: control real(kind=RKIND), pointer, dimension(:, :, :) :: fieldComponent type(field_data_t), pointer :: fieldReference - type(fields_reference_t), pointer :: fields - - real(KIND=RKIND), intent(in), target :: & - Ex(alloc(iEx)%XI:alloc(iEx)%XE, alloc(iEx)%YI:alloc(iEx)%YE, alloc(iEx)%ZI:alloc(iEx)%ZE), & - Ey(alloc(iEy)%XI:alloc(iEy)%XE, alloc(iEy)%YI:alloc(iEy)%YE, alloc(iEy)%ZI:alloc(iEy)%ZE), & - Ez(alloc(iEz)%XI:alloc(iEz)%XE, alloc(iEz)%YI:alloc(iEz)%YE, alloc(iEz)%ZI:alloc(iEz)%ZE), & - Hx(alloc(iHx)%XI:alloc(iHx)%XE, alloc(iHx)%YI:alloc(iHx)%YE, alloc(iHx)%ZI:alloc(iHx)%ZE), & - Hy(alloc(iHy)%XI:alloc(iHy)%XE, alloc(iHy)%YI:alloc(iHy)%YE, alloc(iHy)%ZI:alloc(iHy)%ZE), & - Hz(alloc(iHz)%XI:alloc(iHz)%XE, alloc(iHz)%YI:alloc(iHz)%YE, alloc(iHz)%ZI:alloc(iHz)%ZE) - !---> - real(KIND=RKIND), dimension(:), intent(in), target :: dxh(alloc(iEx)%XI:alloc(iEx)%XE), & - dyh(alloc(iEy)%YI:alloc(iEy)%YE), & - dzh(alloc(iEz)%ZI:alloc(iEz)%ZE), & - dxe(alloc(iHx)%XI:alloc(iHx)%XE), & - dye(alloc(iHy)%YI:alloc(iHy)%YE), & - dze(alloc(iHz)%ZI:alloc(iHz)%ZE) - - fields%E%x => Ex - fields%E%y => Ey - fields%E%z => Ez - - fields%H%x => Hx - fields%H%y => Hy - fields%H%z => Hz - - fields%E%deltax => dxe - fields%E%deltay => dye - fields%E%deltaz => dze - - fields%H%deltax => dxh - fields%H%deltay => dyh - fields%H%deltaz => dzh + type(fields_reference_t) :: fields do i = 1, size(outputs) select case (outputs(i)%outputID) case (POINT_PROBE_ID) - fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos + fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent, fields) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos call update_solver_output(outputs(i)%pointProbe, step, fieldComponent) case (WIRE_CURRENT_PROBE_ID) call update_solver_output(outputs(i)%wireCurrentProbe, step, control%wiresflavor, control%wirecrank, InvEps, InvMu) case (WIRE_CHARGE_PROBE_ID) call update_solver_output(outputs(i)%wireChargeProbe, step) case (BULK_PROBE_ID) - fieldReference => get_field_reference(outputs(i)%bulkProbe%fieldComponent) + fieldReference => get_field_reference(outputs(i)%bulkProbe%fieldComponent, fields) call update_solver_output(outputs(i)%bulkProbe, step, fieldReference) case default call stoponerror(0, 0, 'Output update not implemented') @@ -266,79 +235,44 @@ subroutine update_outputs(outputs, control, step, Ex, Ey, Ez, Hx, Hy, Hz, dxe, d end do contains - function get_field_component(fieldId) result(field) + function get_field_component(fieldId, fieldsReference) result(field) integer(kind=SINGLE), intent(in) :: fieldId + type(fields_reference_t), intent(in) :: fieldsReference real(kind=RKIND), pointer, dimension(:, :, :) :: field select case (fieldId) - case (iEx); field => Ex - case (iEy); field => Ey - case (iEz); field => Ez - case (iHx); field => Hx - case (iHy); field => Hy - case (iHz); field => Hz + case (iEx); field => fieldsReference%E%x + case (iEy); field => fieldsReference%E%y + case (iEz); field => fieldsReference%E%z + case (iHx); field => fieldsReference%H%x + case (iHy); field => fieldsReference%H%y + case (iHz); field => fieldsReference%H%z end select end function get_field_component - function get_field_reference(fieldId) result(field) + function get_field_reference(fieldId, fieldsReference) result(field) integer(kind=SINGLE), intent(in) :: fieldId + type(fields_reference_t), intent(in) :: fieldsReference type(field_data_t), pointer :: field select case (fieldId) case (iBloqueJx, iBloqueJy, iBloqueJz) - field%x => Ex - field%y => Ey - field%z => Ez + field%x => fieldsReference%E%x + field%y => fieldsReference%E%y + field%z => fieldsReference%E%z - field%deltaX => dxe - field%deltaY => dye - field%deltaZ => dze + field%deltaX => fieldsReference%E%deltax + field%deltaY => fieldsReference%E%deltay + field%deltaZ => fieldsReference%E%deltaz case (iBloqueMx, iBloqueMy, iBloqueMz) - field%x => Hx - field%y => Hy - field%z => Hz + field%x => fieldsReference%H%x + field%y => fieldsReference%H%y + field%z => fieldsReference%H%z - field%deltaX => dxh - field%deltaY => dyh - field%deltaZ => dzh + field%deltaX => fieldsReference%H%deltax + field%deltaY => fieldsReference%H%deltay + field%deltaZ => fieldsReference%H%deltaz end select end function get_field_reference end subroutine update_outputs - subroutine clean_solver_output_array(output_array) - - type(solver_output_t), dimension(:), allocatable, intent(inout) :: output_array - integer :: i - - if (.not. allocated(output_array)) then - return - end if - - do i = 1, size(output_array) - - if (allocated(output_array(i)%pointProbe)) then - deallocate (output_array(i)%pointProbe) - end if - - if (allocated(output_array(i)%wireCurrentProbe)) then - deallocate (output_array(i)%wireCurrentProbe) - end if - - if (allocated(output_array(i)%wireChargeProbe)) then - deallocate (output_array(i)%wireChargeProbe) - end if - - if (allocated(output_array(i)%bulkProbe)) then - deallocate (output_array(i)%bulkProbe) - end if - - if (allocated(output_array(i)%volumicCurrentProbe)) then - deallocate (output_array(i)%volumicCurrentProbe) - end if - - end do - - deallocate (output_array) - - end subroutine clean_solver_output_array - end module output diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 9429aba6..c75fee96 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -7,12 +7,17 @@ module mod_outputUtils integer(kind=SINGLE), parameter :: FILE_UNIT = 400 type field_data_t - real(kind=RKIND), pointer, dimension(:, :, :) :: x, y, z - real(kind=RKIND), pointer, dimension(:) :: deltaX, deltaY, deltaZ + real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: x => NULL() + real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: y => NULL() + real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: z => NULL() + real(kind=RKIND), pointer, dimension(:), contiguous :: deltaX => NULL() + real(kind=RKIND), pointer, dimension(:), contiguous :: deltaY => NULL() + real(kind=RKIND), pointer, dimension(:), contiguous :: deltaZ => NULL() end type field_data_t type fields_reference_t - type(field_data_t), pointer :: E, H + type(field_data_t) :: E + type(field_data_t) :: H end type fields_reference_t contains @@ -508,9 +513,9 @@ end function assert_integer_equal function assert_real_equal(val, expected, tolerance, errorMessage) result(err) - real, intent(in) :: val - real, intent(in) :: expected - real, intent(in) :: tolerance + real(kind=rkind), intent(in) :: val + real(kind=rkind), intent(in) :: expected + real(kind=rkind), intent(in) :: tolerance character(*), intent(in) :: errorMessage integer :: err @@ -523,6 +528,23 @@ function assert_real_equal(val, expected, tolerance, errorMessage) result(err) end if end function assert_real_equal + function assert_real_time_equal(val, expected, tolerance, errorMessage) result(err) + + real(kind=RKIND_tiempo), intent(in) :: val + real(kind=RKIND_tiempo), intent(in) :: expected + real(kind=RKIND_tiempo), intent(in) :: tolerance + character(*), intent(in) :: errorMessage + integer :: err + + if (abs(val - expected) <= tolerance) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance + end if + end function assert_real_time_equal + function assert_string_equal(val, expected, errorMessage) result(err) character(*), intent(in) :: val diff --git a/src_output/point_probe_output.F90 b/src_output/point_probe_output.F90 index cd828fbc..20b3d94d 100644 --- a/src_output/point_probe_output.F90 +++ b/src_output/point_probe_output.F90 @@ -55,7 +55,7 @@ function get_output_path() result(outputPath) probeBoundsExtension = get_probe_bounds_extension() prefixFieldExtension = get_prefix_extension(field, mpidir) outputPath = & - trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension)) + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) return end function get_output_path diff --git a/test/output/output_tests.h b/test/output/output_tests.h index 23355cc5..87449304 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -1,7 +1,7 @@ #include -extern "C" int test_initialize(); extern "C" int test_init_point_probe(); +extern "C" int test_update_point_probe(); -TEST(output, test_initialize) {EXPECT_EQ(0, test_initialize()); } TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe()); } +TEST(output, test_update_point_probe) {EXPECT_EQ(0, test_update_point_probe()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 5dd94428..3693d5a3 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -1,4 +1,4 @@ -function test_initialize() bind(C) result(err) +integer function test_init_point_probe() bind(c) result(err) use FDETYPES use FDETYPES_TOOLS use output @@ -10,11 +10,13 @@ function test_initialize() bind(C) result(err) type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize type(solver_output_t), dimension(:), allocatable :: outputs type(MediaData_t) :: defaultMaterial, pecMaterial - logical :: ThereAreWires = .true. + logical :: ThereAreWires = .false. type(Obses_t) :: pointProbeObservable integer(kind=SINGLE) :: test_err = 0 + + !Cleanup if (allocated(outputs)) deallocate(outputs) !Set requested observables @@ -32,12 +34,16 @@ function test_initialize() bind(C) result(err) call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, outputs, ThereAreWires) - call clean_solver_output_array(outputs) + test_err = test_err + assert_integer_equal(outputs(1)%outputID, POINT_PROBE_ID, 'Unexpected probe id') + test_err = test_err + assert_integer_equal(outputs(1)%pointProbe%columnas, 2, 'Unexpected number of columns') + test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') + + deallocate (dummysgg%Observation) + deallocate (outputs) err = test_err -end function test_initialize - +end function test_init_point_probe -function test_init_point_probe() bind(c) result(err) +integer function test_update_point_probe() bind(c) result(err) use FDETYPES use FDETYPES_TOOLS use output @@ -49,35 +55,57 @@ function test_init_point_probe() bind(c) result(err) type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize type(solver_output_t), dimension(:), allocatable :: outputs type(MediaData_t) :: defaultMaterial, pecMaterial - logical :: ThereAreWires = .true. + logical :: ThereAreWires = .false. type(Obses_t) :: pointProbeObservable + type(dummyFields_t), target :: dummyfields + type(fields_reference_t) :: fields + type(XYZlimit_t), dimension(6) :: alloc + REAL(KIND=RKIND), DIMENSION(:,:,:), POINTER :: temp_ptr => NULL() - integer(kind=SINGLE) :: test_err = 0 + real(kind=rkind) :: fieldValue + real(kind=RKIND_tiempo) :: timestep - !Cleanup - if (allocated(outputs)) deallocate(outputs) - !Set requested observables + integer(kind=SINGLE) :: test_err = 0 + dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) - pointProbeObservable = create_point_probe_observable() call add_observation_to_sgg(dummysgg, pointProbeObservable) - - !Set dummymedia - - !set dummysinpml_fullsize - - !Set control flags dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, outputs, ThereAreWires) - test_err = assert_integer_equal(outputs(1)%outputID, POINT_PROBE_ID, 'Unexpected probe id') - test_err = assert_integer_equal(outputs(1)%pointProbe%columnas, 2, 'Unexpected number of columns') - test_err = assert_string_equal(outputs(1)%pointProbe%path, 'test', 'Unexpected path') + call create_dummy_fields(dummyfields, 1, 10, 0.01) - deallocate (dummysgg%Observation) - deallocate (outputs) + dummyfields%Ex(4,4,4) = 5 + + fields%E%x => dummyfields%Ex + fields%E%y => dummyfields%Ey + fields%E%z => dummyfields%Ez + fields%E%deltax => dummyfields%dxe + fields%E%deltaY => dummyfields%dye + fields%E%deltaZ => dummyfields%dze + fields%H%x => dummyfields%Hx + fields%H%y => dummyfields%Hy + fields%H%z => dummyfields%Hz + fields%H%deltax => dummyfields%dxh + fields%H%deltaY => dummyfields%dyh + fields%H%deltaZ => dummyfields%dzh + + + call update_outputs(outputs, dummyControl, 0.5_RKIND_tiempo, fields) + + test_err = test_err + assert_real_equal(outputs%pointProbe(1)%timeStep(1), 0.5_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep') + test_err = test_err + assert_real_equal(outputs%pointProbe(1)%valueForTime(1), 5, 0.00001_RKIND_tiempo, 'Unexpected field') + + dummyfields%Ex(4,4,4) = -4 + + call update_outputs(outputs, dummyControl, 0.8_RKIND_tiempo, fields) + + test_err = test_err + assert_real_equal(outputs%pointProbe%timeStep(2), 0.8_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep') + test_err = test_err + assert_real_equal(outputs%pointProbe%valueForTime(2), -4, 0.00001_RKIND_tiempo, 'Unexpected field') + + err = test_err -end function test_init_point_probe +end function test_update_point_probe diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index 91453195..a9a0962a 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -3,6 +3,12 @@ module mod_testOutputUtils use FDETYPES_TOOLS implicit none + type :: dummyFields_t + real(kind=RKIND),allocatable, dimension(:,:,:) :: Ex, Ey, Ez, Hx, Hy, Hz + real(kind=RKIND),allocatable, dimension(:) :: dxe, dye, dze, dxh, dyh, dzh + contains + procedure, public :: createDummyFields => create_dummy_fields + end type dummyFields_t contains function create_point_probe_observable() result(obs) type(Obses_t) :: obs @@ -12,9 +18,45 @@ function create_point_probe_observable() result(obs) call initialize_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) allocate(P(1)) - P(1) = create_observable(0, 0, 0, 6, 6, 6, iEx) + P(1) = create_observable(4, 4, 4, 6, 6, 6, iEx) call set_observable(obs, P, 'poinProbe', domain, 'DummyFileNormalize') end function + subroutine create_dummy_fields(this, lower, upper, delta) + class(dummyFields_t), intent(inout) :: this + integer, intent(in) :: lower, upper + real(kind=rkind), intent(in) :: delta + allocate(& + this%Ex(lower:upper, lower:upper, lower:upper),& + this%Ey(lower:upper, lower:upper, lower:upper),& + this%Ez(lower:upper, lower:upper, lower:upper),& + this%Hx(lower:upper, lower:upper, lower:upper),& + this%Hy(lower:upper, lower:upper, lower:upper),& + this%Hz(lower:upper, lower:upper, lower:upper)& + ) + + this%Ex = 0.0_RKIND + this%Ey = 0.0_RKIND + this%Ez = 0.0_RKIND + this%Hx = 0.0_RKIND + this%Hy = 0.0_RKIND + this%Hz = 0.0_RKIND + + allocate(& + this%dxh(lower:upper), & + this%dyh(lower:upper), & + this%dzh(lower:upper), & + this%dxe(lower:upper), & + this%dye(lower:upper), & + this%dze(lower:upper)& + ) + this%dxh = delta + this%dyh = delta + this%dzh = delta + this%dxe = delta + this%dye = delta + this%dze = delta + end subroutine create_dummy_fields + end module mod_testOutputUtils From b432c6e2127e78ed9e9cc8306da6c547f15d359c Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 5 Dec 2025 14:00:06 +0100 Subject: [PATCH 23/67] Finish with point probe tests --- src_output/output.F90 | 43 ++++--- src_output/outputUtils.F90 | 96 ++++++---------- src_output/point_probe_output.F90 | 99 +++++++++++----- test/output/output_tests.h | 7 +- test/output/test_output.F90 | 180 +++++++++++++++++++++++++----- test/output/test_output_utils.F90 | 145 +++++++++++++++++++++--- 6 files changed, 427 insertions(+), 143 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index ed473cc2..b8617dca 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -45,6 +45,11 @@ module output !init_frequency_slice_output end interface + interface create_empty_files + module procedure & + create_point_probe_output_files + end interface + interface update_solver_output module procedure & update_point_probe_output, & @@ -67,15 +72,15 @@ module output !flush_frequency_slice_output end interface - interface delete_solver_output - module procedure & - delete_point_probe_output - !delete_wire_probe_output, & - !delete_bulk_current_probe_output, & - !delete_far_field, & - !deleteime_movie_output, & - !delete_frequency_slice_output - end interface + !interface delete_solver_output + ! module procedure & + ! delete_point_probe_output + ! !delete_wire_probe_output, & + ! !delete_bulk_current_probe_output, & + ! !delete_far_field, & + ! !deleteime_movie_output, & + ! !delete_frequency_slice_output + !end interface contains subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreWires) @@ -120,7 +125,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW outputs(outputCount)%outputID = POINT_PROBE_ID allocate (outputs(outputCount)%pointProbe) - call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir) +call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir) case (iJx, iJy, iJz) if (ThereAreWires) then @@ -169,9 +174,9 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep integer(kind=SINGLE) :: nFreq if (observation%TimeDomain) then - newdomain = domain_t(real(observation%InitialTime, kind=RKIND_tiempo), & - real(observation%FinalTime, kind=RKIND_tiempo), & - real(observation%TimeStep, kind=RKIND_tiempo)) + newdomain = create_domain(real(observation%InitialTime, kind=RKIND_tiempo), & + real(observation%FinalTime, kind=RKIND_tiempo), & + real(observation%TimeStep, kind=RKIND_tiempo)) newdomain%tstep = max(newdomain%tstep, simulationTimeStep) @@ -190,7 +195,7 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep elseif (observation%FreqDomain) then !Just linear progression for now. Need to bring logartihmic info to here nFreq = int((observation%FinalFreq - observation%InitialFreq)/observation%FreqStep, kind=SINGLE) - newdomain = domain_t(observation%InitialFreq, observation%FinalFreq, nFreq, logarithmicspacing=.false.) + newdomain = create_domain(observation%InitialFreq, observation%FinalFreq, nFreq, logarithmicspacing=.false.) newDomain%fstep = min(newDomain%fstep, 2.0_RKIND/simulationTimeStep) if ((newDomain%fstep > newDomain%fstop - newDomain%fstart) .or. (newDomain%fstep == 0)) then @@ -208,6 +213,16 @@ end function preprocess_domain end subroutine init_outputs + subroutine create_output_files(outputs) + type(solver_output_t), dimension(:), intent(inout) :: outputs + integer(kind=SINGLE) :: i + do i = 1, size(outputs) + select case (outputs(i)%outputID) + case (POINT_PROBE_ID); call create_empty_files(outputs(i)%pointProbe) + end select + end do + end subroutine create_output_files + subroutine update_outputs(outputs, control, step, fields) type(solver_output_t), dimension(:), intent(inout) :: outputs real(kind=RKIND_tiempo) :: step diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index c75fee96..fde8b032 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -495,70 +495,48 @@ function get_delta(field, i, j, k, fields_reference) result(res) end select end function get_delta - function assert_integer_equal(val, expected, errorMessage) result(err) - - integer, intent(in) :: val - integer, intent(in) :: expected - character(*), intent(in) :: errorMessage - integer :: err - - if (val == expected) then - err = 0 - else - err = 1 - print *, 'ASSERTION FAILED: ', trim(errorMessage) - print *, " Value: ", val, ". Expected: ", expected - end if - end function assert_integer_equal - - function assert_real_equal(val, expected, tolerance, errorMessage) result(err) - - real(kind=rkind), intent(in) :: val - real(kind=rkind), intent(in) :: expected - real(kind=rkind), intent(in) :: tolerance - character(*), intent(in) :: errorMessage - integer :: err - - if (abs(val - expected) <= tolerance) then - err = 0 - else + subroutine create_or_clear_file(path, unit_out, err) + implicit none + character(len=*), intent(in) :: path + integer, intent(out) :: unit_out + integer, intent(out) :: err + integer :: unit, ios + logical :: opened + character(len=BUFSIZE) :: fname + integer, parameter :: unit_min = 10, unit_max = 99 + + err = 0 + unit_out = -1 + + ! --- Find a free unit --- + do unit = unit_min, unit_max + inquire (unit=unit, opened=opened, name=fname) + if (.not. opened) exit ! Found free unit + if (trim(fname) == trim(path)) then + ! Unit is already associated with the same file -> safe to clear + close (unit) + exit + end if + end do + + ! Check if no free unit was found + inquire (unit=unit, opened=opened) + if (opened) then err = 1 - print *, 'ASSERTION FAILED: ', trim(errorMessage) - print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance + return end if - end function assert_real_equal - - function assert_real_time_equal(val, expected, tolerance, errorMessage) result(err) - - real(kind=RKIND_tiempo), intent(in) :: val - real(kind=RKIND_tiempo), intent(in) :: expected - real(kind=RKIND_tiempo), intent(in) :: tolerance - character(*), intent(in) :: errorMessage - integer :: err - if (abs(val - expected) <= tolerance) then - err = 0 - else - err = 1 - print *, 'ASSERTION FAILED: ', trim(errorMessage) - print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance + ! --- Open the file, replacing it if it exists --- + open (unit=unit, file=path, status="replace", action="write", iostat=ios) + if (ios /= 0) then + err = 2 + return end if - end function assert_real_time_equal - function assert_string_equal(val, expected, errorMessage) result(err) + close(unit) - character(*), intent(in) :: val - character(*), intent(in) :: expected - character(*), intent(in) :: errorMessage - integer :: err - - if (trim(val) == trim(expected)) then - err = 0 - else - err = 1 - print *, 'ASSERTION FAILED: ', trim(errorMessage) - print *, ' Value: "', trim(val), '". Expected: "', trim(expected), '"' - end if - end function assert_string_equal + ! --- Success --- + unit_out = unit + end subroutine create_or_clear_file end module mod_outputUtils diff --git a/src_output/point_probe_output.F90 b/src_output/point_probe_output.F90 index 20b3d94d..c806437e 100644 --- a/src_output/point_probe_output.F90 +++ b/src_output/point_probe_output.F90 @@ -2,13 +2,14 @@ module mod_pointProbeOutput use FDETYPES use mod_domain use mod_outputUtils - + implicit none type point_probe_output_t integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field type(domain_t) :: domain integer(kind=SINGLE) :: xCoord, yCoord, zCoord + integer(kind=SINGLE) :: fileUnitTime, fileUnitFreq character(len=BUFSIZE) :: path integer(kind=SINGLE) :: fieldComponent integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE, nFreq = 0_SINGLE @@ -24,7 +25,7 @@ subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, type(point_probe_output_t), intent(out) :: this integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord integer(kind=SINGLE), intent(in) :: mpidir, field - character(len=BUFSIZE), intent(in) :: outputTypeExtension + character(len=*), intent(in) :: outputTypeExtension type(domain_t), intent(in) :: domain integer(kind=SINGLE) :: i @@ -85,6 +86,26 @@ function get_probe_bounds_extension() result(ext) end function get_probe_bounds_extension end subroutine init_point_probe_output + subroutine create_point_probe_output_files(this) + implicit none + type(point_probe_output_t), intent(inout) :: this + character(len=BUFSIZE) :: file_time, file_freq + integer(kind=SINGLE) :: err + err = 0 + + file_time = trim(adjustl(this%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & + trim(adjustl(datFileExtension)) + + file_freq = trim(adjustl(this%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & + trim(adjustl(datFileExtension)) + + call create_or_clear_file(file_time, this%fileUnitTime, err) + call create_or_clear_file(file_freq, this%fileUnitFreq, err) + +end subroutine create_point_probe_output_files + subroutine update_point_probe_output(this, step, field) type(point_probe_output_t), intent(inout) :: this real(kind=RKIND), pointer, dimension(:, :, :) :: field @@ -100,48 +121,74 @@ subroutine update_point_probe_output(this, step, field) if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then do iter = 1, this%nFreq this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord) !*get_auxExp(this%frequencySlice(iter), this%fieldComponent) + this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord) !*get_auxExp(this%frequencySlice(iter), this%fieldComponent) end do end if end subroutine update_point_probe_output subroutine flush_point_probe_output(this) type(point_probe_output_t), intent(inout) :: this + if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + call flush_time_domain(this) + call clear_time_data(this) + end if + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + call flush_frequency_domain(this) + end if + contains - integer(kind=SINGLE) :: timeUnitFile, frequencyUnitFile, status - character(len=BUFSIZE) :: timeFileName, frequencyFileName - integer(kind=SINGLE) :: i + subroutine flush_time_domain(this) + type(point_probe_output_t), intent(in) :: this + integer :: i + character(len=BUFSIZE) :: filename - if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then - timeFileName = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) - timeUnitFile = FILE_UNIT + 1 + if (this%serializedTimeSize <= 0) then + print *, "No data to write." + return + end if - status = open_file(timeUnitFile, timeFileName) - if (status /= 0) call stoponerror(0,0,'Failed to open timeDomainFile. ') + filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) + open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") do i = 1, this%serializedTimeSize - write (timeUnitFile, '(F12.4, 2X, F12.4)') this%timeStep(i), this%valueForTime(i) + write (this%fileUnitTime, '(F12.6,1X,F12.6)') this%timeStep(i), this%valueForTime(i) end do - status = close_file(timeUnitFile) - end if + close (this%fileUnitTime) + end subroutine flush_time_domain - if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - frequencyFileName = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) - frequencyUnitFile = FILE_UNIT + 2 + subroutine flush_frequency_domain(this) + type(point_probe_output_t), intent(in) :: this + integer ::i + character(len=BUFSIZE) :: filename + + if (.not. allocated(this%frequencySlice) .or. .not. allocated(this%valueForFreq)) then + print *, "Error: arrays not allocated." + return + end if - OPEN (UNIT=frequencyUnitFile, FILE=frequencyFileName, STATUS='REPLACE', ACTION='WRITE', iostat=status) - if (status /= 0) call stoponerror(0,0, 'Failed to open frequencyDomainFile. ') + if (this%nFreq <= 0) then + print *, "No data to write." + return + end if + filename = trim(adjustl(this%path))//'_'//trim(adjustl(frequencyExtension))//'_'//trim(adjustl(datFileExtension)) + open (unit=this%fileUnitFreq, file=filename, status="replace", action="write") do i = 1, this%nFreq - write (frequencyUnitFile, '(F12.4, 2X, F12.4)') this%frequencySlice(i), this%valueForFreq(i) + write (this%fileUnitFreq, '(F12.6,1X,F12.6)') this%frequencySlice(i), this%valueForFreq(i) end do - status = close_file(frequencyUnitFile) - end if - end subroutine flush_point_probe_output + close (this%fileUnitFreq) + end subroutine flush_frequency_domain - subroutine delete_point_probe_output() - !TODO - end subroutine delete_point_probe_output + subroutine clear_time_data(this) + type(point_probe_output_t), intent(inout) :: this + !Only required for time domain, frequency overwrites itself on every update + this%timeStep = 0.0_RKIND_tiempo + this%valueForTime = 0.0_RKIND + + this%serializedTimeSize = 0 + end subroutine clear_time_data + + end subroutine flush_point_probe_output end module diff --git a/test/output/output_tests.h b/test/output/output_tests.h index 87449304..af114fac 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -2,6 +2,11 @@ extern "C" int test_init_point_probe(); extern "C" int test_update_point_probe(); +extern "C" int test_flush_point_probe(); +extern "C" int test_multiple_flush_point_probe(); + TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe()); } -TEST(output, test_update_point_probe) {EXPECT_EQ(0, test_update_point_probe()); } +TEST(output, test_update_point_probe_info) {EXPECT_EQ(0, test_update_point_probe()); } +TEST(output, test_flush_point_probe_info) {EXPECT_EQ(0, test_flush_point_probe()); } +TEST(output, test_flush_multiple_point_probe_info) {EXPECT_EQ(0, test_multiple_flush_point_probe()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 3693d5a3..7e3507ea 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -6,8 +6,8 @@ integer function test_init_point_probe() bind(c) result(err) type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl - type(media_matrices_t), pointer:: dummymedia - type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize + type(media_matrices_t), pointer:: dummymedia => NULL() + type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize => NULL() type(solver_output_t), dimension(:), allocatable :: outputs type(MediaData_t) :: defaultMaterial, pecMaterial logical :: ThereAreWires = .false. @@ -16,19 +16,15 @@ integer function test_init_point_probe() bind(c) result(err) integer(kind=SINGLE) :: test_err = 0 - !Cleanup - if (allocated(outputs)) deallocate(outputs) + !Cleanup + if (allocated(outputs)) deallocate (outputs) !Set requested observables dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) - + pointProbeObservable = create_point_probe_observable() call add_observation_to_sgg(dummysgg, pointProbeObservable) - !Set dummymedia - - !set dummysinpml_fullsize - !Set control flags dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') @@ -37,7 +33,7 @@ integer function test_init_point_probe() bind(c) result(err) test_err = test_err + assert_integer_equal(outputs(1)%outputID, POINT_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%pointProbe%columnas, 2, 'Unexpected number of columns') test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') - + deallocate (dummysgg%Observation) deallocate (outputs) err = test_err @@ -51,21 +47,14 @@ integer function test_update_point_probe() bind(c) result(err) type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl - type(media_matrices_t), pointer:: dummymedia - type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize + type(media_matrices_t), pointer:: dummymedia => NULL() + type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize => NULL() type(solver_output_t), dimension(:), allocatable :: outputs - type(MediaData_t) :: defaultMaterial, pecMaterial logical :: ThereAreWires = .false. type(Obses_t) :: pointProbeObservable type(dummyFields_t), target :: dummyfields type(fields_reference_t) :: fields - type(XYZlimit_t), dimension(6) :: alloc - REAL(KIND=RKIND), DIMENSION(:,:,:), POINTER :: temp_ptr => NULL() - - real(kind=rkind) :: fieldValue - real(kind=RKIND_tiempo) :: timestep - integer(kind=SINGLE) :: test_err = 0 @@ -77,8 +66,6 @@ integer function test_update_point_probe() bind(c) result(err) call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, outputs, ThereAreWires) call create_dummy_fields(dummyfields, 1, 10, 0.01) - - dummyfields%Ex(4,4,4) = 5 fields%E%x => dummyfields%Ex fields%E%y => dummyfields%Ey @@ -93,19 +80,156 @@ integer function test_update_point_probe() bind(c) result(err) fields%H%deltaY => dummyfields%dyh fields%H%deltaZ => dummyfields%dzh - + dummyfields%Ex(4, 4, 4) = 5.0_RKIND call update_outputs(outputs, dummyControl, 0.5_RKIND_tiempo, fields) - test_err = test_err + assert_real_equal(outputs%pointProbe(1)%timeStep(1), 0.5_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep') - test_err = test_err + assert_real_equal(outputs%pointProbe(1)%valueForTime(1), 5, 0.00001_RKIND_tiempo, 'Unexpected field') - - dummyfields%Ex(4,4,4) = -4 + test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(1), 0.5_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 1') + test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(1), 5.0_RKIND, 0.00001_RKIND, 'Unexpected field 1') + dummyfields%Ex(4, 4, 4) = -4.0_RKIND call update_outputs(outputs, dummyControl, 0.8_RKIND_tiempo, fields) - test_err = test_err + assert_real_equal(outputs%pointProbe%timeStep(2), 0.8_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep') - test_err = test_err + assert_real_equal(outputs%pointProbe%valueForTime(2), -4, 0.00001_RKIND_tiempo, 'Unexpected field') + test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(2), 0.8_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 2') + test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(2), -4.0_RKIND, 0.00001_RKIND, 'Unexpected field 2') + if (associated(dummymedia)) deallocate (dummymedia) + if (associated(dummysinpml_fullsize)) deallocate (dummysinpml_fullsize) err = test_err end function test_update_point_probe + +integer function test_flush_point_probe() bind(c) result(err) + use output + use mod_domain + use mod_testOutputUtils + type(point_probe_output_t) :: probe + type(domain_t):: domain + character(len=BUFSIZE) :: file_time, file_freq + character(len=27) :: test_extension + integer :: n, i + err = 1 !If test_err is not updated at the end it will be shown + test_err = 0 + test_extension = 'tmp_cases/flush_point_probe' + domain = create_domain(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) + call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3) + call create_point_probe_output_files(probe) + + n = 10 + do i = 1, n + probe%timeStep(i) = real(i) + probe%valueForTime(i) = 10.0*i + probe%frequencySlice(i) = 0.1*i + probe%valueForFreq(i) = 0.2*i + end do + probe%serializedTimeSize = n + probe%nFreq = n + + file_time = trim(adjustl(probe%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & + trim(adjustl(datFileExtension)) + + file_freq = trim(adjustl(probe%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & ! <-- SAME naming in your code + trim(adjustl(datFileExtension)) + + call flush_point_probe_output(probe) + + test_err = test_err + assert_written_output_file(file_time) + test_err = test_err + assert_written_output_file(file_freq) + + test_err = test_err + assert_integer_equal(probe%serializedTimeSize, 0, "ERROR: clear_time_data did not reset serializedTimeSize!") + test_err = test_err + assert_integer_equal(probe%serializedTimeSize, 0, "ERROR: clear_time_data did not reset serializedTimeSize!") + + if (all(probe%timeStep == 0.0) .and. all(probe%valueForTime == 0.0)) then + print *, "Time arrays cleared correctly." + else + print *, "ERROR: time arrays not cleared!" + test_err = test_err + 1 + end if + + if (probe%nFreq == 0) then + print *, "ERROR: Destroyed frequency reference!" + test_err = test_err + 1 + end if + + err = test_err +end function test_flush_point_probe + +integer function test_multiple_flush_point_probe() bind(c) result(err) + use output + use mod_domain + use mod_testOutputUtils + type(point_probe_output_t) :: probe + type(domain_t):: domain + character(len=BUFSIZE) :: file_time, file_freq + real(kind=RKIND), allocatable :: expectedTime(:,:), expectedFreq(:,:) + character(len=36) :: test_extension + integer :: n, i + err = 1 !If test_err is not updated at the end it will be shown + test_err = 0 + test_extension = 'tmp_cases/multiple_flush_point_probe' + + domain = create_domain(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) + call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3) + call create_point_probe_output_files(probe) + + file_time = trim(adjustl(probe%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & + trim(adjustl(datFileExtension)) + + file_freq = trim(adjustl(probe%path))//'_'// & + trim(adjustl(frequencyExtension))//'_'// & + trim(adjustl(datFileExtension)) + + n = 10 + + allocate(expectedTime(2*n,2)) + allocate(expectedFreq(n,2)) + !Simulate updates in probe + do i = 1, n + probe%timeStep(i) = real(i) + probe%valueForTime(i) = 10.0*i + probe%frequencySlice(i) = 0.1*i + probe%valueForFreq(i) = 0.2*i + + expectedTime(i,1) = real(i) + expectedTime(i,2) = 10.0*i + + expectedFreq(i,1) = 0.1*i + expectedFreq(i,2) = 0.2*i + end do + probe%serializedTimeSize = n + probe%nFreq = n + !!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + call flush_point_probe_output(probe) + + !Simulate new updates in probe + do i = 1, n + probe%timeStep(i) = real(i+10) + probe%valueForTime(i) = 10.0*(i+10) + probe%valueForFreq(i) = -0.5*i + + expectedTime(i+10,1) = real(i+10) + expectedTime(i+10,2) = 10.0*(i+10) + + expectedFreq(i,1) = 0.1*i ! frequency file overwrites, so expectedFreq(i,1) remains 0.1*i ? + expectedFreq(i,2) = -0.5*i + end do + probe%serializedTimeSize = n + !!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + call flush_point_probe_output(probe) + + open(unit=probe%fileUnitTime, file=file_time, status="old", action="read") + test_err = test_err + assert_file_content(probe%fileUnitTime, expectedTime, 2*n, 2) + close(probe%fileUnitTime) + + open(unit=probe%fileUnitFreq, file=file_freq, status="old", action="read") + test_err = test_err + assert_file_content(probe%fileUnitFreq, expectedFreq, n, 2) + close(probe%fileUnitFreq) + + err = test_err + + +end function test_multiple_flush_point_probe diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index a9a0962a..0efcb033 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -4,9 +4,9 @@ module mod_testOutputUtils implicit none type :: dummyFields_t - real(kind=RKIND),allocatable, dimension(:,:,:) :: Ex, Ey, Ez, Hx, Hy, Hz - real(kind=RKIND),allocatable, dimension(:) :: dxe, dye, dze, dxh, dyh, dzh - contains + real(kind=RKIND), allocatable, dimension(:, :, :) :: Ex, Ey, Ez, Hx, Hy, Hz + real(kind=RKIND), allocatable, dimension(:) :: dxe, dye, dze, dxh, dyh, dzh + contains procedure, public :: createDummyFields => create_dummy_fields end type dummyFields_t contains @@ -17,7 +17,7 @@ function create_point_probe_observable() result(obs) type(observation_domain_t) :: domain call initialize_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) - allocate(P(1)) + allocate (P(1)) P(1) = create_observable(4, 4, 4, 6, 6, 6, iEx) call set_observable(obs, P, 'poinProbe', domain, 'DummyFileNormalize') @@ -27,14 +27,14 @@ subroutine create_dummy_fields(this, lower, upper, delta) class(dummyFields_t), intent(inout) :: this integer, intent(in) :: lower, upper real(kind=rkind), intent(in) :: delta - allocate(& - this%Ex(lower:upper, lower:upper, lower:upper),& - this%Ey(lower:upper, lower:upper, lower:upper),& - this%Ez(lower:upper, lower:upper, lower:upper),& - this%Hx(lower:upper, lower:upper, lower:upper),& - this%Hy(lower:upper, lower:upper, lower:upper),& - this%Hz(lower:upper, lower:upper, lower:upper)& - ) + allocate ( & + this%Ex(lower:upper, lower:upper, lower:upper), & + this%Ey(lower:upper, lower:upper, lower:upper), & + this%Ez(lower:upper, lower:upper, lower:upper), & + this%Hx(lower:upper, lower:upper, lower:upper), & + this%Hy(lower:upper, lower:upper, lower:upper), & + this%Hz(lower:upper, lower:upper, lower:upper) & + ) this%Ex = 0.0_RKIND this%Ey = 0.0_RKIND @@ -43,14 +43,14 @@ subroutine create_dummy_fields(this, lower, upper, delta) this%Hy = 0.0_RKIND this%Hz = 0.0_RKIND - allocate(& + allocate ( & this%dxh(lower:upper), & this%dyh(lower:upper), & this%dzh(lower:upper), & this%dxe(lower:upper), & this%dye(lower:upper), & - this%dze(lower:upper)& - ) + this%dze(lower:upper) & + ) this%dxh = delta this%dyh = delta this%dzh = delta @@ -59,4 +59,119 @@ subroutine create_dummy_fields(this, lower, upper, delta) this%dze = delta end subroutine create_dummy_fields + function assert_integer_equal(val, expected, errorMessage) result(err) + + integer, intent(in) :: val + integer, intent(in) :: expected + character(*), intent(in) :: errorMessage + integer :: err + + if (val == expected) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, " Value: ", val, ". Expected: ", expected + end if + end function assert_integer_equal + + function assert_real_equal(val, expected, tolerance, errorMessage) result(err) + + real(kind=rkind), intent(in) :: val + real(kind=rkind), intent(in) :: expected + real(kind=rkind), intent(in) :: tolerance + character(*), intent(in) :: errorMessage + integer :: err + + if (abs(val - expected) <= tolerance) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance + end if + end function assert_real_equal + + function assert_real_time_equal(val, expected, tolerance, errorMessage) result(err) + + real(kind=RKIND_tiempo), intent(in) :: val + real(kind=RKIND_tiempo), intent(in) :: expected + real(kind=RKIND_tiempo), intent(in) :: tolerance + character(*), intent(in) :: errorMessage + integer :: err + + if (abs(val - expected) <= tolerance) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance + end if + end function assert_real_time_equal + + function assert_string_equal(val, expected, errorMessage) result(err) + + character(*), intent(in) :: val + character(*), intent(in) :: expected + character(*), intent(in) :: errorMessage + integer :: err + + if (trim(val) == trim(expected)) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, ' Value: "', trim(val), '". Expected: "', trim(expected), '"' + end if + end function assert_string_equal + + integer function assert_written_output_file(filename) result(code) + implicit none + character(len=*), intent(in) :: filename + logical :: ex + integer :: filesize + + code = 0 + + inquire (file=filename, exist=ex, size=filesize) + + if (.not. ex) then + print *, "ERROR: Output file not created:", trim(filename) + code = 1 + else if (filesize <= 0) then + print *, "ERROR: Output file is empty:", trim(filename) + code = 2 + end if + end function assert_written_output_file + + integer function assert_file_content(unit, expectedValues, nRows, nCols, headers) result(flag) + implicit none + integer(kind=SINGLE), intent(in) :: unit + real(kind=RKIND), intent(in) :: expectedValues(:, :) + integer(kind=SINGLE), intent(in) :: nRows, nCols + character(len=*), intent(in), optional :: headers(:) + integer(kind=SINGLE) :: i, j, ios + real(kind=RKIND), dimension(nCols) :: val + character(len=BUFSIZE) :: line + flag = 0 + + if (present(headers)) then + read (unit, '(F12.6,1X,F12.6)', iostat=ios) line + if (ios /= 0) return + end if + + do i = 1, nRows + read (unit, *, iostat=ios) val + if (ios /= 0) then + flag = flag + 1 + return + end if + do j = 1, nCols + if (abs(val(j) - expectedValues(i, j)) > 1d-6) then + flag = flag + 1 + end if + end do + end do + end function assert_file_content + end module mod_testOutputUtils From 6596a3de87f98d7ad25fdcaf83d9f749296d2b8d Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 9 Dec 2025 13:26:32 +0100 Subject: [PATCH 24/67] Added test for volumic probe valid surfaces. Fix error in point probe flush --- src_main_pub/fdetypes.F90 | 1 + src_output/output.F90 | 4 +- src_output/outputUtils.F90 | 8 +- src_output/volumic_probe_output.F90 | 4 +- test/observation/test_observation_init.F90 | 1 - test/output/output_tests.h | 2 + test/output/test_output.F90 | 83 ++++++++--- test/utils/fdetypes_tools.F90 | 157 ++++++++++++++------- 8 files changed, 183 insertions(+), 77 deletions(-) diff --git a/src_main_pub/fdetypes.F90 b/src_main_pub/fdetypes.F90 index c0fd857c..afe3abd6 100755 --- a/src_main_pub/fdetypes.F90 +++ b/src_main_pub/fdetypes.F90 @@ -572,6 +572,7 @@ module FDETYPES type :: MediaData_t + integer(kind=SINGLE) :: Id REAL (KIND=RKIND) :: Priority,Epr,Sigma,Mur,SigmaM logical :: sigmareasignado !solo afecta a un chequeo de errores en lumped 120123 type (exists_t) :: Is diff --git a/src_output/output.F90 b/src_output/output.F90 index b8617dca..7d0111ec 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -174,7 +174,7 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep integer(kind=SINGLE) :: nFreq if (observation%TimeDomain) then - newdomain = create_domain(real(observation%InitialTime, kind=RKIND_tiempo), & + newdomain = domain_t(real(observation%InitialTime, kind=RKIND_tiempo), & real(observation%FinalTime, kind=RKIND_tiempo), & real(observation%TimeStep, kind=RKIND_tiempo)) @@ -195,7 +195,7 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep elseif (observation%FreqDomain) then !Just linear progression for now. Need to bring logartihmic info to here nFreq = int((observation%FinalFreq - observation%InitialFreq)/observation%FreqStep, kind=SINGLE) - newdomain = create_domain(observation%InitialFreq, observation%FinalFreq, nFreq, logarithmicspacing=.false.) + newdomain = domain_t(observation%InitialFreq, observation%FinalFreq, nFreq, logarithmicspacing=.false.) newDomain%fstep = min(newDomain%fstep, 2.0_RKIND/simulationTimeStep) if ((newDomain%fstep > newDomain%fstop - newDomain%fstart) .or. (newDomain%fstep == 0)) then diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index fde8b032..0a2ae63d 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -258,12 +258,12 @@ subroutine init_frequency_slice(frequencySlice, domain) end if end subroutine init_frequency_slice - integer function blockCurrent(field) + integer function getBlockCurrentDirection(field) integer(kind=4) :: field select case (field) - case (iHx); blockCurrent = iCurX - case (iHy); blockCurrent = iCurY - case (iHz); blockCurrent = iCurZ + case (iHx); getBlockCurrentDirection = iCurX + case (iHy); getBlockCurrentDirection = iCurY + case (iHz); getBlockCurrentDirection = iCurZ case default; call StopOnError(0, 0, 'field is not H field') end select end function diff --git a/src_output/volumic_probe_output.F90 b/src_output/volumic_probe_output.F90 index 054bd35e..e7161a76 100644 --- a/src_output/volumic_probe_output.F90 +++ b/src_output/volumic_probe_output.F90 @@ -117,7 +117,7 @@ function count_pec_surfaces() result(n) if (.not. isMediaVacuum(field, iii, jjj, kkk, media) .and. .not. isSplitOrAdvanced(field, iii, jjj, kkk, media, simulationMedia)) then n = n + 1 end if - if (isPECorSurface(field, iii, jjj, kkk, media, simulationMedia) .or. field == blockCurrent(field)) then + if (isPECorSurface(field, iii, jjj, kkk, media, simulationMedia) .or. field == getBlockCurrentDirection(field)) then n = n + 1 end if end if @@ -183,7 +183,7 @@ logical function isRelevantSurfaceCell(Hfield, I, J, K, outputType) integer(kind=SINGLE), intent(in) :: Hfield, I, J, K, outputType if (isWithinBounds(Hfield, I, J, K, sinpml_fullsize)) then - isRelevantSurfaceCell = isPECorSurface(Hfield, iii, jjj, kkk, media, simulationMedia) .or. outputType == blockCurrent(Hfield) + isRelevantSurfaceCell = isPECorSurface(Hfield, iii, jjj, kkk, media, simulationMedia) .or. outputType == getBlockCurrentDirection(Hfield) else isRelevantSurfaceCell = .false. end if diff --git a/test/observation/test_observation_init.F90 b/test/observation/test_observation_init.F90 index e4f75d85..ad9c37da 100644 --- a/test/observation/test_observation_init.F90 +++ b/test/observation/test_observation_init.F90 @@ -72,7 +72,6 @@ integer function test_init_time_movie_observation() bind(C) result(err) err = err + 1 end if - !Extra func contains subroutine set_sgg_data(baseSGG) type(SGGFDTDINFO), intent(inout) :: baseSGG diff --git a/test/output/output_tests.h b/test/output/output_tests.h index af114fac..e4be4014 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -4,9 +4,11 @@ extern "C" int test_init_point_probe(); extern "C" int test_update_point_probe(); extern "C" int test_flush_point_probe(); extern "C" int test_multiple_flush_point_probe(); +extern "C" int test_volumic_probe_count_relevant_surfaces(); TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe()); } TEST(output, test_update_point_probe_info) {EXPECT_EQ(0, test_update_point_probe()); } TEST(output, test_flush_point_probe_info) {EXPECT_EQ(0, test_flush_point_probe()); } TEST(output, test_flush_multiple_point_probe_info) {EXPECT_EQ(0, test_multiple_flush_point_probe()); } +TEST(output, test_volumic_probe_counter_relevant_surfaces) {EXPECT_EQ(0, test_volumic_probe_count_relevant_surfaces()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 7e3507ea..2b37f099 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -110,7 +110,7 @@ integer function test_flush_point_probe() bind(c) result(err) err = 1 !If test_err is not updated at the end it will be shown test_err = 0 test_extension = 'tmp_cases/flush_point_probe' - domain = create_domain(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) + domain = domain_t(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3) call create_point_probe_output_files(probe) @@ -162,14 +162,14 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) type(point_probe_output_t) :: probe type(domain_t):: domain character(len=BUFSIZE) :: file_time, file_freq - real(kind=RKIND), allocatable :: expectedTime(:,:), expectedFreq(:,:) + real(kind=RKIND), allocatable :: expectedTime(:, :), expectedFreq(:, :) character(len=36) :: test_extension integer :: n, i err = 1 !If test_err is not updated at the end it will be shown test_err = 0 test_extension = 'tmp_cases/multiple_flush_point_probe' - domain = create_domain(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) + domain = domain_t(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3) call create_point_probe_output_files(probe) @@ -183,8 +183,8 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) n = 10 - allocate(expectedTime(2*n,2)) - allocate(expectedFreq(n,2)) + allocate (expectedTime(2*n, 2)) + allocate (expectedFreq(n, 2)) !Simulate updates in probe do i = 1, n probe%timeStep(i) = real(i) @@ -192,11 +192,11 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) probe%frequencySlice(i) = 0.1*i probe%valueForFreq(i) = 0.2*i - expectedTime(i,1) = real(i) - expectedTime(i,2) = 10.0*i + expectedTime(i, 1) = real(i) + expectedTime(i, 2) = 10.0*i - expectedFreq(i,1) = 0.1*i - expectedFreq(i,2) = 0.2*i + expectedFreq(i, 1) = 0.1*i + expectedFreq(i, 2) = 0.2*i end do probe%serializedTimeSize = n probe%nFreq = n @@ -206,30 +206,73 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) !Simulate new updates in probe do i = 1, n - probe%timeStep(i) = real(i+10) - probe%valueForTime(i) = 10.0*(i+10) + probe%timeStep(i) = real(i + 10) + probe%valueForTime(i) = 10.0*(i + 10) probe%valueForFreq(i) = -0.5*i - expectedTime(i+10,1) = real(i+10) - expectedTime(i+10,2) = 10.0*(i+10) + expectedTime(i + 10, 1) = real(i + 10) + expectedTime(i + 10, 2) = 10.0*(i + 10) - expectedFreq(i,1) = 0.1*i ! frequency file overwrites, so expectedFreq(i,1) remains 0.1*i ? - expectedFreq(i,2) = -0.5*i + expectedFreq(i, 1) = 0.1*i ! frequency file overwrites, so expectedFreq(i,1) remains 0.1*i ? + expectedFreq(i, 2) = -0.5*i end do probe%serializedTimeSize = n !!!!!!!!!!!!!!!!!!!!!!!!!!!!! call flush_point_probe_output(probe) - open(unit=probe%fileUnitTime, file=file_time, status="old", action="read") + open (unit=probe%fileUnitTime, file=file_time, status="old", action="read") test_err = test_err + assert_file_content(probe%fileUnitTime, expectedTime, 2*n, 2) - close(probe%fileUnitTime) + close (probe%fileUnitTime) - open(unit=probe%fileUnitFreq, file=file_freq, status="old", action="read") + open (unit=probe%fileUnitFreq, file=file_freq, status="old", action="read") test_err = test_err + assert_file_content(probe%fileUnitFreq, expectedFreq, n, 2) - close(probe%fileUnitFreq) + close (probe%fileUnitFreq) err = test_err - end function test_multiple_flush_point_probe + +integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err) + use output + use FDETYPES_TOOLS + + type(volumic_current_probe_t) :: volumicProbe + integer(kind=RKIND) :: i, j, k, i2, j2, k2 + integer(kind=RKIND) :: field + type(domain_t) :: domain + type(media_matrices_t), target :: media + type(media_matrices_t), pointer :: mediaPtr + type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials + type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr + type(limit_t), dimension(1:6), target :: sinpml_fullsize + type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr + + type(MediaData_t) :: thinWireSimulationMaterial + character(len=27) :: test_extension = 'tmp_cases/flush_point_probe' + integer(kind=SINGLE) :: mpidir = 3 + integer(kind=SINGLE) :: pecId = 1 + integer(kind=SINGLE) :: pmcId = 2 + + domain = domain_t(tstart=0.0_RKIND_tiempo, tstop=0.0_RKIND_tiempo, tstep=0.0_RKIND_tiempo, fstart=0.0_RKIND, fstop=1000.0_RKIND, fnum=10_SINGLE, logarithmicspacing=.false.) + + do i=1,6 + sinpml_fullsize(i) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + end do + + simulationMaterials = create_base_simulation_material_list() + thinWireSimulationMaterial = create_thinWire_simulation_material(size(simulationMaterials) + 1) + call add_simulation_material(simulationMaterials, thinWireSimulationMaterial) + + call init_default_media_matrix(media, 0,8,0,8,0,8) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 1,1,1, pecId) + call assing_material_id_to_media_matrix_coordinate(media, iHz, 1,1,1, pmcId) + call assing_material_id_to_media_matrix_coordinate(media, iEx, 2,2,2, thinWireSimulationMaterial%Id) + + mediaPtr => media + simulationMaterialsPtr => simulationMaterials + sinpml_fullsizePtr => sinpml_fullsize + +call init_volumic_probe_output(volumicProbe, i, j, k, i2, j2, k2, field, domain, mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, test_extension, mpidir) + err = test_err +end function diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index 5569254f..8b5c468a 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -43,6 +43,7 @@ function create_limit_t(XI, XE, YI, YE, ZI, ZE, NX, NY, NZ) result(r) r%NY = NY r%NZ = NZ end function create_limit_t + function create_tag_list(sggAlloc) result(r) type(XYZlimit_t), dimension(6), intent(in) :: sggAlloc type(taglist_t) :: r @@ -140,7 +141,7 @@ function create_base_sgg(dt, time_steps) result(sgg) integer(kind=SINGLE) :: nTimes - media = create_base_media() + media = create_base_simulation_material_list() sgg%NumMedia = 3 sgg%med => media @@ -157,16 +158,16 @@ function create_base_sgg(dt, time_steps) result(sgg) end function create_base_sgg - function create_base_media() result(media) + function create_base_simulation_material_list() result(simulationMaterials) implicit none - type(MediaData_t), dimension(3) :: media + type(MediaData_t), dimension(3) :: simulationMaterials - media(1) = get_default_mediadata() - media(2) = create_pec_media() - media(3) = create_pmc_media() + simulationMaterials(1) = get_default_mediadata() + simulationMaterials(2) = create_pec_simulation_material() + simulationMaterials(3) = create_pmc_simulation_material() - end function create_base_media + end function create_base_simulation_material_list function create_time_array(array_size, interval) result(arr) integer, intent(in), optional :: array_size @@ -349,6 +350,28 @@ function create_observable(XI, YI, ZI, XE, YE, ZE, what, line_in) result(observa end if end function create_observable + subroutine add_simulation_material(simulationMaterials, newSimulationMaterial) + type(MediaData_t), dimension(:), intent(inout), allocatable :: simulationMaterials + type(MediaData_t), intent(in) :: newSimulationMaterial + + type(MediaData_t), dimension(:), target, allocatable :: tempSimulationMaterials + integer(kind=SINGLE) :: oldSize, newSize, istat + oldSize = size(simulationMaterials) + newSize = oldSize + 1 + allocate (tempSimulationMaterials(newSize), stat=istat) + if (istat /= 0) then + stop "Allocation failed for temporary media array." + end if + + if (oldSize > 0) then + tempSimulationMaterials(1:oldSize) = simulationMaterials + deallocate (simulationMaterials) + end if + tempSimulationMaterials(newSize) = newSimulationMaterial + + simulationMaterials = tempSimulationMaterials + end subroutine add_simulation_material + subroutine add_media_data_to_sgg(sgg, mediaData) implicit none @@ -379,10 +402,52 @@ subroutine add_media_data_to_sgg(sgg, mediaData) end subroutine add_media_data_to_sgg + subroutine init_default_media_matrix(res, xi, yi, zi, xe, ye, ze) + integer(kind=SINGLE) :: xi, yi, zi, xe, ye, ze + type(media_matrices_t), intent(inout) :: res + + allocate(res%sggMtag(xi:xe, yi:ye, zi:ze)) + + allocate(res%sggMiNo(xi:xe, yi:ye, zi:ze)) + allocate(res%sggMiEx(xi:xe, yi:ye, zi:ze)) + allocate(res%sggMiEy(xi:xe, yi:ye, zi:ze)) + allocate(res%sggMiEz(xi:xe, yi:ye, zi:ze)) + allocate(res%sggMiHx(xi:xe, yi:ye, zi:ze)) + allocate(res%sggMiHy(xi:xe, yi:ye, zi:ze)) + allocate(res%sggMiHz(xi:xe, yi:ye, zi:ze)) + + + res%sggMtag = 0_SINGLE + + res%sggMiNo = 0.0_RKIND + res%sggMiEx = 0.0_RKIND + res%sggMiEy = 0.0_RKIND + res%sggMiEz = 0.0_RKIND + res%sggMiHx = 0.0_RKIND + res%sggMiHy = 0.0_RKIND + res%sggMiHz = 0.0_RKIND + end subroutine init_default_media_matrix + + subroutine assing_material_id_to_media_matrix_coordinate(media, fieldComponent, i, j, k, materialId) + type(media_matrices_t), intent(out) :: media + integer(kind=SINGLE), intent(in) :: fieldComponent, i, j, k, materialId + selectcase(fieldComponent) + case(iEx); media%sggMiEx(i,j,k) = materialId + case(iEy); media%sggMiEy(i,j,k) = materialId + case(iEz); media%sggMiEz(i,j,k) = materialId + case(iHx); media%sggMiHx(i,j,k) = materialId + case(iHy); media%sggMiHy(i,j,k) = materialId + case(iHz); media%sggMiHz(i,j,k) = materialId + end select + + end subroutine assing_material_id_to_media_matrix_coordinate + function get_default_mediadata() result(res) implicit none type(MediaData_t) :: res + !Vacuum id + res%Id = 0 ! Reals res%Priority = 10 @@ -439,7 +504,7 @@ function get_default_mediadata() result(res) end function get_default_mediadata - function create_pec_media() result(res) + function create_pec_simulation_material() result(res) implicit none type(MediaData_t) :: res @@ -447,7 +512,7 @@ function create_pec_media() result(res) mat = create_pec_material() res = get_default_mediadata() - + res%Id = mat%id res%Is%PEC = .TRUE. res%Priority = 150 @@ -456,9 +521,9 @@ function create_pec_media() result(res) res%Mur = mat%mu/UTILMU0 res%SigmaM = mat%sigmam - end function create_pec_media + end function create_pec_simulation_material - function create_pmc_media() result(res) + function create_pmc_simulation_material() result(res) implicit none type(MediaData_t) :: res @@ -467,6 +532,7 @@ function create_pmc_media() result(res) mat = create_pmc_material() res = get_default_mediadata() + res%Id = mat%id res%Is%PMC = .TRUE. res%Priority = 160 @@ -475,31 +541,28 @@ function create_pmc_media() result(res) res%Mur = mat%mu/UTILMU0 res%SigmaM = mat%sigmam - end function create_pmc_media - -!function create_thinwire_media() result(res) -! implicit none -! -! type(MediaData_t) :: res -! type(Material) :: mat -! -! type(Wires_t), target :: wire -! -! mat = create_thinwire_material() -! res = get_default_mediadata() -! -! res%Is%ThinWire = .TRUE. -! -! allocate (res%Wire(1)) -! wire = create_wire() -! res%Wire(1) => wire -! -! res%Priority = 15 -! res%Epr = mat%eps/UTILEPS0 -! res%Sigma = mat%sigma -! res%Mur = mat%mu/UTILMU0 -! res%SigmaM = mat%sigmam -!end function create_thinwire_media + end function create_pmc_simulation_material + + function create_thinWire_simulation_material(materialId) result(res) + implicit none + integer(kind=SINGLE) :: materialId + + type(MediaData_t) :: res + type(Material) :: mat + + type(Wires_t), target, dimension(1) :: wire + + res = get_default_mediadata() + res%Id = materialId + res%Is%ThinWire = .TRUE. + + allocate (res%Wire(1)) + wire(1) = get_default_wire() + res%wire => wire + + res%Priority = 15 + + end function create_thinWire_simulation_material function create_empty_material() result(mat) implicit none @@ -707,7 +770,6 @@ subroutine initialize_time_domain(domain, InitialTime, FinalTime, TimeStep) type(observation_domain_t), intent(inout) :: domain real(kind=RKIND), intent(in) :: InitialTime, FinalTime, TimeStep - domain%InitialTime = InitialTime domain%FinalTime = FinalTime domain%TimeStep = TimeStep @@ -722,7 +784,6 @@ subroutine initialize_frequency_domain(domain, InitialFreq, FinalFreq, FreqStep) type(observation_domain_t), intent(inout) :: domain real(kind=RKIND), intent(in) :: InitialFreq, FinalFreq, FreqStep - domain%InitialFreq = InitialFreq domain%FinalFreq = FinalFreq domain%FreqStep = FreqStep @@ -756,15 +817,15 @@ subroutine initialize_phi_domain(domain, phiStart, phiStop, phiStep) end subroutine initialize_phi_domain subroutine initialize_domain_logical_flags(domain, Saveall_flag, TransFer_flag, Volumic_flag) - implicit none - - type(observation_domain_t), intent(inout) :: domain - logical, intent(in) :: Saveall_flag, TransFer_flag, Volumic_flag - - domain%Saveall = Saveall_flag - domain%TransFer = TransFer_flag - domain%Volumic = Volumic_flag - -end subroutine initialize_domain_logical_flags + implicit none + + type(observation_domain_t), intent(inout) :: domain + logical, intent(in) :: Saveall_flag, TransFer_flag, Volumic_flag + + domain%Saveall = Saveall_flag + domain%TransFer = TransFer_flag + domain%Volumic = Volumic_flag + + end subroutine initialize_domain_logical_flags end module FDETYPES_TOOLS From ef2ce09d8355faf856be433797df39738969bb0b Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 10 Dec 2025 13:30:16 +0100 Subject: [PATCH 25/67] Volumic update refactor --- CMakeLists.txt | 2 +- src_output/output.F90 | 9 +- src_output/outputUtils.F90 | 48 ++++++--- src_output/volumic_probe_output.F90 | 158 +++++++++++++++------------- test/output/test_output.F90 | 52 +++++---- test/output/test_output_utils.F90 | 13 +++ test/utils/fdetypes_tools.F90 | 4 +- 7 files changed, 171 insertions(+), 115 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index d7af112c..8f5a20fb 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -60,7 +60,7 @@ if (CMAKE_SYSTEM_NAME MATCHES "Linux") set(CMAKE_CXX_FLAGS_RELEASE "-Ofast") set(CMAKE_Fortran_FLAGS_RELEASE "-Ofast") - set(CMAKE_Fortran_FLAGS_DEBUG "-g -O0") + set(CMAKE_Fortran_FLAGS_DEBUG "-g -O0 -fno-inline -fcheck=all -fbacktrace") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "IntelLLVM") message(STATUS "Using IntelLLVM (ifx) flags") diff --git a/src_output/output.F90 b/src_output/output.F90 index 7d0111ec..4667366f 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -55,7 +55,8 @@ module output update_point_probe_output, & update_wire_current_probe_output, & update_wire_charge_probe_output, & - update_bulk_probe_output + update_bulk_probe_output, & + update_volumic_probe_output !update_bulk_current_probe_output, & !update_far_field, & !updateime_movie_output, & @@ -99,11 +100,11 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW allocate (outputs(sgg%NumberRequest)) - allocate (InvEps(0:sgg%NumMedia), InvMu(0:sgg%NumMedia)) + allocate (InvEps(1:sgg%NumMedia), InvMu(1:sgg%NumMedia)) outputCount = 0 - InvEps(0:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia)%Epr) - InvMu(0:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia)%Mur) + InvEps(1:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(1:sgg%NumMedia)%Epr) + InvMu(1:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(1:sgg%NumMedia)%Mur) do ii = 1, sgg%NumberRequest do i = 1, sgg%Observation(ii)%nP diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 0a2ae63d..bd05f692 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -268,25 +268,41 @@ integer function getBlockCurrentDirection(field) end select end function - logical function isThinWire(field, i, j, k, simulationMedia, media) + logical function isThinWire(field, i, j, k, geometryMedia, registeredMedia) integer(kind=4), intent(in) :: field, i, j, k - type(MediaData_t), pointer, dimension(:), intent(in) :: simulationMedia - type(media_matrices_t), pointer, intent(in) :: media - integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex - mediaIndex = getMedia(field, i, j, k, media) - isThinWire = simulationMedia(mediaIndex)%is%ThinWire + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + + integer(kind=SINGLE) :: mediaIndex + + mediaIndex = getMediaIndex(field, i, j, k, geometryMedia) + isThinWire = registeredMedia(mediaIndex)%is%ThinWire end function - logical function isPECorSurface(field, i, j, k, media, simulationMedia) - type(MediaData_t), pointer, dimension(:), intent(in) :: simulationMedia - type(media_matrices_t), pointer, intent(in) :: media + + logical function isPEC(field, i, j, k, geometryMedia, registeredMedia) integer(kind=4), intent(in) :: field, i, j, k - integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex - mediaIndex = getMedia(field, i, j, k, media) - isPECorSurface = simulationMedia(mediaIndex)%is%PEC .or. simulationMedia(mediaIndex)%is%Surface + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + + integer(kind=SINGLE) :: mediaIndex + + mediaIndex = getMediaIndex(field, i, j, k, geometryMedia) + isPEC = registeredMedia(mediaIndex)%is%PEC + end function + + logical function isSurface(field, i, j, k, geometryMedia, registeredMedia) + integer(kind=4), intent(in) :: field, i, j, k + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + + integer(kind=SINGLE) :: mediaIndex + + mediaIndex = getMediaIndex(field, i, j, k, geometryMedia) + isSurface = registeredMedia(mediaIndex)%is%Surface end function - function getMedia(field, i, j, k, media) result(res) + function getMediaIndex(field, i, j, k, media) result(res) type(media_matrices_t), pointer, intent(in) :: media integer(kind=4), intent(in) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: res @@ -315,7 +331,7 @@ logical function isMediaVacuum(field, i, j, k, media) TYPE(media_matrices_t), pointer, INTENT(IN) :: media integer(kind=4) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex, vacuum = 1 - mediaIndex = getMedia(field, i, j, k, media) + mediaIndex = getMediaIndex(field, i, j, k, media) isMediaVacuum = (mediaIndex == vacuum) end function @@ -325,7 +341,7 @@ logical function isSplitOrAdvanced(field, i, j, k, media, simulationMedia) type(media_matrices_t), pointer, intent(in) :: media integer(kind=4) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex - mediaIndex = getMedia(field, i, j, k, media) + mediaIndex = getMediaIndex(field, i, j, k, media) isSplitOrAdvanced = simulationMedia(mediaIndex)%is%split_and_useless .or. & simulationMedia(mediaIndex)%is%already_YEEadvanced_byconformal @@ -533,7 +549,7 @@ subroutine create_or_clear_file(path, unit_out, err) return end if - close(unit) + close (unit) ! --- Success --- unit_out = unit diff --git a/src_output/volumic_probe_output.F90 b/src_output/volumic_probe_output.F90 index e7161a76..0b392021 100644 --- a/src_output/volumic_probe_output.F90 +++ b/src_output/volumic_probe_output.F90 @@ -4,6 +4,8 @@ module mod_volumicProbe use mod_outputUtils implicit none + private :: isRelevantCell, isRelevantSurfaceCell + type volumic_current_probe_t integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components type(domain_t) :: domain @@ -37,15 +39,15 @@ module mod_volumicProbe contains - subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, field, domain, media, simulationMedia, sinpml_fullsize, outputTypeExtension, mpidir) - type(volumic_current_probe_t), intent(out) :: this + subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir) + type(volumic_current_probe_t), intent(inout) :: this integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord integer(kind=SINGLE), intent(in) :: i2Coord, j2Coord, k2Coord integer(kind=SINGLE), intent(in) :: mpidir, field character(len=BUFSIZE), intent(in) :: outputTypeExtension - type(MediaData_t), pointer, dimension(:) :: simulationMedia - type(media_matrices_t), pointer, intent(in) :: media + type(MediaData_t), pointer, dimension(:) :: registeredMedia + type(media_matrices_t), pointer, intent(in) :: geometryMedia type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize type(domain_t), intent(in) :: domain @@ -65,7 +67,7 @@ subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Co this%domain = domain this%path = get_output_path() - totalPecSurfaces = count_pec_surfaces() + totalPecSurfaces = count_pec_surfaces(this, geometryMedia, registeredMedia, sinpml_fullsize) if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then allocate (this%timeStep(BuffObse)) @@ -98,66 +100,67 @@ function get_output_path() result(outputPath) probeBoundsExtension = get_probe_bounds_coords_extension(iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, mpidir) prefixFieldExtension = get_prefix_extension(field, mpidir) outputPath = & - trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension)) + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) return end function get_output_path - function count_pec_surfaces() result(n) - integer(kind=SINGLE) :: i, j, k, field - integer(kind=SINGLE) :: n, iii, jjj, kkk - n = 0_SINGLE - do i = icoord,i2coord - do j = jcoord,j2coord - do k = kcoord,k2coord - do field = iEx,iEz - if (isWithinBounds(field, iii, jjj, kkk, sinpml_fullsize)) then - if (isThinWire(field, iii, jjj, kkk, simulationMedia, media)) then - n = n + 1 - end if - if (.not. isMediaVacuum(field, iii, jjj, kkk, media) .and. .not. isSplitOrAdvanced(field, iii, jjj, kkk, media, simulationMedia)) then - n = n + 1 - end if - if (isPECorSurface(field, iii, jjj, kkk, media, simulationMedia) .or. field == getBlockCurrentDirection(field)) then - n = n + 1 - end if + end subroutine init_volumic_probe_output + + function count_pec_surfaces(this, geometryMedia, registeredMedia, sinpml_fullsize) result(n) + type(volumic_current_probe_t), intent(in) :: this + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + integer(kind=SINGLE) :: i, j, k, field + integer(kind=SINGLE) :: n + n = 0_SINGLE + do i = this%xCoord, this%x2Coord + do j = this%yCoord, this%y2Coord + do k = this%zCoord, this%z2Coord + do field = iEx, iEz + if (isRelevantCell(field, i, j, k, geometryMedia, registeredMedia, sinpml_fullsize)) then + n = n + 1 end if end do + do field = iHx, iHz + if (isRelevantSurfaceCell(field, i, j, k, this%fieldComponent, geometryMedia, registeredMedia, sinpml_fullsize)) then + n = n + 1 + end if end do - end do - end do + end do + end do + end do + end function count_pec_surfaces - end function count_pec_surfaces - end subroutine init_volumic_probe_output - - subroutine update_volumic_probe_output(this, step, media, simulationMedia, sinpml_fullsize, fieldsReference) + subroutine update_volumic_probe_output(this, step, geometryMedia, registeredMedia, sinpml_fullsize, fieldsReference) type(volumic_current_probe_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step - type(media_matrices_t), pointer, intent(in) :: media - type(MediaData_t), pointer, dimension(:) :: simulationMedia + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:) :: registeredMedia type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize type(fields_reference_t), pointer, intent(in) :: fieldsReference - integer(kind=SINGLE) :: Efield, Hfield, iii, jjj, kkk - integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2, conta + integer(kind=SINGLE) :: Efield, Hfield, i, j, k, conta + integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2 + + conta = 0 if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then this%serializedTimeSize = this%serializedTimeSize + 1 - conta = 0 - do KKK = k1, k2 - do JJJ = j1, j2 - do III = i1, i2 + do k = k1, k2 + do j = j1, j2 + do i = i1, i2 do Efield = iEx, iEz - if (isRelevantCell(Efield, iii, jjj, kkk)) then + if (isRelevantCell(Efield, i, j, k, geometryMedia, registeredMedia, sinpml_fullsize)) then conta = conta + 1 - call save_current(this, Efield, iii, jjj, kkk, conta, fieldsReference) - + call save_current(this, Efield, i, j, k, conta, fieldsReference) end if end do do Hfield = iHx, iHz - if (isRelevantSurfaceCell(Hfield, iii, jjj, kkk, this%fieldComponent)) then + if (isRelevantSurfaceCell(Hfield, i, j, k, this%fieldComponent, geometryMedia, registeredMedia, sinpml_fullsize)) then conta = conta + 1 - call save_current_surfaces(this, Hfield, iii, jjj, kkk, conta, fieldsReference) + call save_current_surfaces(this, Hfield, i, j, k, conta, fieldsReference) end if end do end do @@ -167,50 +170,28 @@ subroutine update_volumic_probe_output(this, step, media, simulationMedia, sinpm if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then end if contains - logical function isRelevantCell(Efield, I, J, K) - integer(kind=SINGLE), intent(in) :: Efield, I, J, K - - if (isWithinBounds(Efield, I, J, K, sinpml_fullsize)) then - isRelevantCell = isThinWire(Efield, I, J, K, simulationMedia, media) .OR. & - (.NOT. isMediaVacuum(Efield, I, J, K, media) .AND. .NOT. isSplitOrAdvanced(Efield, I, J, K, media, simulationMedia)) - else - isRelevantCell = .false. - end if - - END FUNCTION isRelevantCell - - logical function isRelevantSurfaceCell(Hfield, I, J, K, outputType) - integer(kind=SINGLE), intent(in) :: Hfield, I, J, K, outputType - - if (isWithinBounds(Hfield, I, J, K, sinpml_fullsize)) then - isRelevantSurfaceCell = isPECorSurface(Hfield, iii, jjj, kkk, media, simulationMedia) .or. outputType == getBlockCurrentDirection(Hfield) - else - isRelevantSurfaceCell = .false. - end if - end function - - subroutine save_current(this, Efield, iii, jjj, kkk, conta, field_reference) + subroutine save_current(this, Efield, i, j, k, conta, field_reference) type(fields_reference_t), pointer, intent(in) :: field_reference type(volumic_current_probe_t), intent(inout) :: this - integer(kind=SINGLE), intent(in) :: Efield, iii, jjj, kkk, conta + integer(kind=SINGLE), intent(in) :: Efield, i, j, k, conta real(kind=RKIND) :: jdir - jdir = computeJ(EField, iii, jjj, kkk, field_reference) + jdir = computeJ(EField, i, j, k, field_reference) this%xValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEx) this%yValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEy) this%zValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEz) end subroutine save_current - subroutine save_current_surfaces(this, Hfield, iii, jjj, kkk, conta, field_reference) + subroutine save_current_surfaces(this, Hfield, i, j, k, conta, field_reference) implicit none type(fields_reference_t), pointer, intent(in) :: field_reference type(volumic_current_probe_t), intent(inout) :: this - integer(kind=SINGLE), intent(in) :: Hfield, iii, jjj, kkk, conta + integer(kind=SINGLE), intent(in) :: Hfield, i, j, k, conta real(kind=RKIND) :: jdir1, jdir2 - jdir1 = computeJ1(HField, iii, jjj, kkk, field_reference) - jdir2 = computeJ2(HField, iii, jjj, kkk, field_reference) + jdir1 = computeJ1(HField, i, j, k, field_reference) + jdir2 = computeJ2(HField, i, j, k, field_reference) this%xValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHz), Hfield == iHx) this%yValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHx), Hfield == iHy) @@ -218,4 +199,37 @@ subroutine save_current_surfaces(this, Hfield, iii, jjj, kkk, conta, field_refer end subroutine save_current_surfaces end subroutine update_volumic_probe_output + logical function isRelevantCell(Efield, I, J, K, geometryMedia, registeredMedia, sinpml_fullsize) + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + integer(kind=SINGLE), intent(in) :: Efield, I, J, K + isRelevantCell = .false. + + if (isWithinBounds(Efield, I, J, K, sinpml_fullsize)) then + if (isThinWire(Efield, I, J, K, geometryMedia, registeredMedia)) then + isRelevantCell = .true. + end if + if (.NOT. isMediaVacuum(Efield, I, J, K, geometryMedia)) then + if (.NOT. isSplitOrAdvanced(Efield, I, J, K, geometryMedia, registeredMedia)) then + isRelevantCell = .true. + end if + end if + end if + + end function + + logical function isRelevantSurfaceCell(field, i, j, k, outputType, geometryMedia, registeredMedia, sinpml_fullsize) + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + integer(kind=SINGLE), intent(in) :: field, i, j, k, outputType + + isRelevantSurfaceCell = .false. + if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then + isRelevantSurfaceCell = isPEC(field, i, j, k, geometryMedia, registeredMedia) + end if + + end function + end module mod_volumicProbe diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 2b37f099..0f8505eb 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -235,44 +235,56 @@ end function test_multiple_flush_point_probe integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err) use output + use mod_testOutputUtils use FDETYPES_TOOLS - type(volumic_current_probe_t) :: volumicProbe - integer(kind=RKIND) :: i, j, k, i2, j2, k2 - integer(kind=RKIND) :: field - type(domain_t) :: domain + integer(kind=RKIND) :: iter type(media_matrices_t), target :: media type(media_matrices_t), pointer :: mediaPtr type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials - type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr type(limit_t), dimension(1:6), target :: sinpml_fullsize type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr + type(Obses_t) :: volumicProbeObservable + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(solver_output_t), dimension(:), allocatable :: outputs type(MediaData_t) :: thinWireSimulationMaterial - character(len=27) :: test_extension = 'tmp_cases/flush_point_probe' + character(len=BUFSIZE) :: test_extension = trim(adjustl('tmp_cases/flush_point_probe')) integer(kind=SINGLE) :: mpidir = 3 - integer(kind=SINGLE) :: pecId = 1 - integer(kind=SINGLE) :: pmcId = 2 + logical :: ThereAreWires = .false. + err = 1 !If test_err is not updated at the end it will be shown + test_err = 0 - domain = domain_t(tstart=0.0_RKIND_tiempo, tstop=0.0_RKIND_tiempo, tstep=0.0_RKIND_tiempo, fstart=0.0_RKIND, fstop=1000.0_RKIND, fnum=10_SINGLE, logarithmicspacing=.false.) - - do i=1,6 - sinpml_fullsize(i) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + do iter = 1, 6 + sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) end do + sinpml_fullsizePtr => sinpml_fullsize simulationMaterials = create_base_simulation_material_list() thinWireSimulationMaterial = create_thinWire_simulation_material(size(simulationMaterials) + 1) call add_simulation_material(simulationMaterials, thinWireSimulationMaterial) - call init_default_media_matrix(media, 0,8,0,8,0,8) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 1,1,1, pecId) - call assing_material_id_to_media_matrix_coordinate(media, iHz, 1,1,1, pmcId) - call assing_material_id_to_media_matrix_coordinate(media, iEx, 2,2,2, thinWireSimulationMaterial%Id) - + call init_default_media_matrix(media, 0, 8, 0, 8, 0, 8) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 1, 1, 1, simulationMaterials(2)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iHz, 1, 1, 1, simulationMaterials(3)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEx, 2, 2, 2, thinWireSimulationMaterial%Id) mediaPtr => media - simulationMaterialsPtr => simulationMaterials - sinpml_fullsizePtr => sinpml_fullsize -call init_volumic_probe_output(volumicProbe, i, j, k, i2, j2, k2, field, domain, mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, test_extension, mpidir) + dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) + dummysgg%NumMedia = size(simulationMaterials) + dummysgg%med => simulationMaterials + + volumicProbeObservable = create_volumic_probe_observable() + call add_observation_to_sgg(dummysgg, volumicProbeObservable) + + dummyControl = create_control_flags(mpidir=mpidir, nEntradaRoot='entradaRoot', wiresflavor='holland') + + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + + test_err = test_err + assert_integer_equal(outputs(1)%outputID, VOLUMIC_CURRENT_PROBE_ID, 'Unexpected probe id') + test_err = test_err + assert_integer_equal(outputs(1)%volumicCurrentProbe%columnas, 4, 'Unexpected number of columns') + test_err = test_err + assert_string_equal(outputs(1)%volumicCurrentProbe%path, 'entradaRoot_volumicProbe_BCX_4_4_4__6_6_6', 'Unexpected path') + err = test_err end function diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index 0efcb033..66ab3e62 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -22,6 +22,19 @@ function create_point_probe_observable() result(obs) call set_observable(obs, P, 'poinProbe', domain, 'DummyFileNormalize') end function + + function create_volumic_probe_observable() result(obs) + type(Obses_t) :: obs + + type(observable_t), dimension(:), allocatable :: P + type(observation_domain_t) :: domain + + call initialize_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) + call initialize_frequency_domain(domain, 0.0_RKIND, 1000.0_RKIND, 50.0_RKIND) + allocate (P(1)) + P(1) = create_observable(4, 4, 4, 6, 6, 6, iCurX) + call set_observable(obs, P, 'volumicProbe', domain, 'DummyFileNormalize') + end function create_volumic_probe_observable subroutine create_dummy_fields(this, lower, upper, delta) class(dummyFields_t), intent(inout) :: this diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index 8b5c468a..a421c8da 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -402,7 +402,7 @@ subroutine add_media_data_to_sgg(sgg, mediaData) end subroutine add_media_data_to_sgg - subroutine init_default_media_matrix(res, xi, yi, zi, xe, ye, ze) + subroutine init_default_media_matrix(res, xi, xe, yi, ye, zi, ze) integer(kind=SINGLE) :: xi, yi, zi, xe, ye, ze type(media_matrices_t), intent(inout) :: res @@ -429,7 +429,7 @@ subroutine init_default_media_matrix(res, xi, yi, zi, xe, ye, ze) end subroutine init_default_media_matrix subroutine assing_material_id_to_media_matrix_coordinate(media, fieldComponent, i, j, k, materialId) - type(media_matrices_t), intent(out) :: media + type(media_matrices_t), intent(inout) :: media integer(kind=SINGLE), intent(in) :: fieldComponent, i, j, k, materialId selectcase(fieldComponent) case(iEx); media%sggMiEx(i,j,k) = materialId From b86861f4ae5cf46f945004bf02cb78b38221b64a Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 10 Dec 2025 15:51:22 +0100 Subject: [PATCH 26/67] Reorganize output files --- src_output/CMakeLists.txt | 10 +- ...k_probe_output.F90 => bulkProbeOutput.F90} | 38 ++-- src_output/domain.F90 | 13 +- src_output/output.F90 | 34 ++-- src_output/outputTypes.F90 | 165 ++++++++++++++++++ src_output/outputUtils.F90 | 15 +- ..._probe_output.F90 => pointProbeOutput.F90} | 75 ++++---- ...robe_output.F90 => volumicProbeOutput.F90} | 150 ++++++++++------ ...t_probe_output.F90 => wireProbeOutput.F90} | 135 ++++++++++---- src_output/wire_charge_probe_output.F90 | 121 ------------- test/output/test_output.F90 | 4 +- 11 files changed, 444 insertions(+), 316 deletions(-) rename src_output/{bulk_probe_output.F90 => bulkProbeOutput.F90} (88%) create mode 100644 src_output/outputTypes.F90 rename src_output/{point_probe_output.F90 => pointProbeOutput.F90} (75%) rename src_output/{volumic_probe_output.F90 => volumicProbeOutput.F90} (62%) rename src_output/{wire_current_probe_output.F90 => wireProbeOutput.F90} (74%) delete mode 100644 src_output/wire_charge_probe_output.F90 diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index d5368568..6eeeb227 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -1,11 +1,11 @@ add_library(fdtd-output "output.F90" + "outputTypes.F90" "domain.F90" "outputUtils.F90" - "point_probe_output.F90" - "wire_current_probe_output.F90" - "wire_charge_probe_output.F90" - "bulk_probe_output.F90" - "volumic_probe_output.F90" + "pointProbeOutput.F90" + "wireProbeOutput.F90" + "bulkProbeOutput.F90" + "volumicProbeOutput.F90" ) target_link_libraries(fdtd-output semba-types ) \ No newline at end of file diff --git a/src_output/bulk_probe_output.F90 b/src_output/bulkProbeOutput.F90 similarity index 88% rename from src_output/bulk_probe_output.F90 rename to src_output/bulkProbeOutput.F90 index 8910f5b5..36ae711e 100644 --- a/src_output/bulk_probe_output.F90 +++ b/src_output/bulkProbeOutput.F90 @@ -1,27 +1,14 @@ -module mod_bulkProbe +module mod_bulkProbeOutput use FDETYPES + use outputTypes use FDETYPES_TOOLS - use mod_domain use mod_outputUtils implicit none - type bulk_probe_output_t - integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field - type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord - integer(kind=SINGLE) :: x2Coord, y2Coord, z2Coord - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: fieldComponent - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND - - end type bulk_probe_output_t - contains subroutine init_bulk_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, field, domain, outputTypeExtension, mpidir) - type(bulk_probe_output_t), intent(out) :: this + type(bulk_current_probe_output_t), intent(out) :: this integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord integer(kind=SINGLE), intent(in) :: i2Coord, j2Coord, k2Coord integer(kind=SINGLE), intent(in) :: mpidir, field @@ -91,7 +78,7 @@ end function get_probe_bounds_extension end subroutine init_bulk_probe_output subroutine update_bulk_probe_output(this, step, field) - type(bulk_probe_output_t), intent(out) :: this + type(bulk_current_probe_output_t), intent(out) :: this real(kind=RKIND_tiempo), intent(in) :: step type(field_data_t), intent(in) :: field @@ -99,7 +86,7 @@ subroutine update_bulk_probe_output(this, step, field) 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(:, :, :) :: xF, yF, zF real(kind=RKIND), pointer, dimension(:) :: dx, dy, dz i1_m = this%xCoord @@ -109,12 +96,12 @@ subroutine update_bulk_probe_output(this, step, field) k1_m = this%zCoord k2_m = this%z2Coord - i1 = i1_m - j1 = i2_m - k1 = j1_m - i2 = j2_m - j2 = k1_m - k2 = k2_m + i1 = i1_m + j1 = i2_m + k1 = j1_m + i2 = j2_m + j2 = k1_m + k2 = k2_m xF => field%x yF => field%y @@ -123,7 +110,6 @@ subroutine update_bulk_probe_output(this, step, field) dy => field%deltaY dz => field%deltaZ - this%serializedTimeSize = this%serializedTimeSize + 1 this%timeStep(this%serializedTimeSize) = step this%valueForTime(this%serializedTimeSize) = 0.0_RKIND !Clear uninitialized value @@ -204,4 +190,4 @@ subroutine update_bulk_probe_output(this, step, field) end subroutine update_bulk_probe_output -end module mod_bulkProbe +end module mod_bulkProbeOutput diff --git a/src_output/domain.F90 b/src_output/domain.F90 index 72d4d3a3..3a789592 100644 --- a/src_output/domain.F90 +++ b/src_output/domain.F90 @@ -1,22 +1,13 @@ module mod_domain use FDETYPES + use outputTypes implicit none - integer, parameter :: UNDEFINED_DOMAIN = -1 - integer, parameter :: TIME_DOMAIN = 0 - integer, parameter :: FREQUENCY_DOMAIN = 1 - integer, parameter :: BOTH_DOMAIN = 2 + interface domain_t module procedure new_domain_time, new_domain_freq, new_domain_both end interface domain_t - type :: domain_t - real(kind=RKIND_tiempo) :: tstart = 0.0_RKIND_tiempo, tstop = 0.0_RKIND_tiempo, tstep = 0.0_RKIND_tiempo - real(kind=RKIND) :: fstart = 0.0_RKIND, fstop = 0.0_RKIND, fstep - integer(kind=SINGLE) :: fnum = 0 - integer(kind=SINGLE) :: domainType = UNDEFINED_DOMAIN - logical :: logarithmicSpacing = .false. - end type domain_t contains function new_domain_time(tstart, tstop, tstep) result(new_domain) diff --git a/src_output/output.F90 b/src_output/output.F90 index 4667366f..e924e996 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -3,10 +3,9 @@ module output use mod_domain use mod_outputUtils use mod_pointProbeOutput - use mod_wireCurrentProbeOutput - use mod_wireChargeProbeOutput - use mod_bulkProbe - use mod_volumicProbe + use mod_wireProbeOutput + use mod_bulkProbeOutput + use mod_volumicProbeOutput implicit none @@ -21,11 +20,16 @@ module output type solver_output_t integer(kind=SINGLE) :: outputID - type(point_probe_output_t), allocatable :: pointProbe - type(wire_current_probe_output_t), allocatable :: wireCurrentProbe - type(wire_charge_probe_output_t), allocatable :: wireChargeProbe - type(bulk_probe_output_t), allocatable :: bulkProbe - type(volumic_current_probe_t), allocatable :: volumicCurrentProbe + type(point_probe_output_t), allocatable :: pointProbe !iEx, iEy, iEz, iHx, iHy, iHz + type(wire_current_probe_output_t), allocatable :: wireCurrentProbe !Jx, Jy, Jz + type(wire_charge_probe_output_t), allocatable :: wireChargeProbe !Qx, Qy, Qz + type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !BloqueXJ, BloqueYJ, BloqueZJ, BloqueXM, BloqueYM, BloqueZM + type(volumic_current_probe_t), allocatable :: volumicCurrentProbe !icurX, icurY, icurZ + type(volumic_field_probe_output_t), allocatable :: volumicFieldProbe + type(line_integral_probe_output_t), allocatable :: lineIntegralProbe + type(far_field_probe_output_t), allocatable :: farFieldProbe + type(movie_probe_output_t), allocatable :: movieProbe + type(frequency_slice_probe_output_t), allocatable :: frequencySliceProbe !type(volumic_field_probe_t), allocatable :: volumicFieldProbe !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !type(far_field_t), allocatable :: farField @@ -126,7 +130,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW outputs(outputCount)%outputID = POINT_PROBE_ID allocate (outputs(outputCount)%pointProbe) -call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir) +call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir, sgg%dt) case (iJx, iJy, iJz) if (ThereAreWires) then @@ -147,8 +151,8 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW outputCount = outputCount + 1 outputs(outputCount)%outputID = BULK_PROBE_ID - allocate (outputs(outputCount)%bulkProbe) - call init_solver_output(outputs(outputCount)%bulkProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, outputTypeExtension, control%mpidir) + allocate (outputs(outputCount)%bulkCurrentProbe) + call init_solver_output(outputs(outputCount)%bulkCurrentProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, outputTypeExtension, control%mpidir) !! call adjust_computation_range --- Required due to issues in mpi region edges case (iCur, iCurX, iCurY, iCurZ) @@ -156,7 +160,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW outputs(outputCount)%outputID = VOLUMIC_CURRENT_PROBE_ID allocate (outputs(outputCount)%volumicCurrentProbe) - call init_solver_output(outputs(outputCount)%volumicCurrentProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir) + call init_solver_output(outputs(outputCount)%volumicCurrentProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir, sgg%dt) case default call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') @@ -243,8 +247,8 @@ subroutine update_outputs(outputs, control, step, fields) case (WIRE_CHARGE_PROBE_ID) call update_solver_output(outputs(i)%wireChargeProbe, step) case (BULK_PROBE_ID) - fieldReference => get_field_reference(outputs(i)%bulkProbe%fieldComponent, fields) - call update_solver_output(outputs(i)%bulkProbe, step, fieldReference) + fieldReference => get_field_reference(outputs(i)%bulkCurrentProbe%fieldComponent, fields) + call update_solver_output(outputs(i)%bulkCurrentProbe, step, fieldReference) case default call stoponerror(0, 0, 'Output update not implemented') end select diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 new file mode 100644 index 00000000..7c6e8eef --- /dev/null +++ b/src_output/outputTypes.F90 @@ -0,0 +1,165 @@ +module outputTypes + use FDETYPES + use HollandWires + use wiresHolland_constants +#ifdef CompileWithBerengerWires + use WiresBerenger +#endif +#ifdef CompileWithSlantedWires + use WiresSlanted + use WiresSlanted_Types + use WiresSlanted_Constants +#endif + implicit none + + integer, parameter :: UNDEFINED_DOMAIN = -1 + integer, parameter :: TIME_DOMAIN = 0 + integer, parameter :: FREQUENCY_DOMAIN = 1 + integer, parameter :: BOTH_DOMAIN = 2 + + type :: domain_t + real(kind=RKIND_tiempo) :: tstart = 0.0_RKIND_tiempo, tstop = 0.0_RKIND_tiempo, tstep = 0.0_RKIND_tiempo + real(kind=RKIND) :: fstart = 0.0_RKIND, fstop = 0.0_RKIND, fstep + integer(kind=SINGLE) :: fnum = 0 + integer(kind=SINGLE) :: domainType = UNDEFINED_DOMAIN + logical :: logarithmicSpacing = .false. + end type domain_t + + type field_data_t + real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: x => NULL() + real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: y => NULL() + real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: z => NULL() + real(kind=RKIND), pointer, dimension(:), contiguous :: deltaX => NULL() + real(kind=RKIND), pointer, dimension(:), contiguous :: deltaY => NULL() + real(kind=RKIND), pointer, dimension(:), contiguous :: deltaZ => NULL() + end type field_data_t + + type fields_reference_t + type(field_data_t) :: E + type(field_data_t) :: H + end type fields_reference_t + + type point_probe_output_t + integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + integer(kind=SINGLE) :: fileUnitTime, fileUnitFreq + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: fieldComponent + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE, nFreq = 0_SINGLE + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND + + real(kind=RKIND), dimension(:), allocatable :: frequencySlice + complex(kind=CKIND), dimension(:), allocatable :: valueForFreq + complex(kind=CKIND), dimension(:), allocatable :: auxExp_E + complex(kind=CKIND), dimension(:), allocatable :: auxExp_H + end type point_probe_output_t + + type wire_charge_probe_output_t + integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: chargeComponent + integer(kind=SINGLE) :: sign = +1 + + type(CurrentSegments), pointer :: segment + + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + real(kind=RKIND), dimension(BuffObse) :: chargeValue + end type wire_charge_probe_output_t + + type current_values_t + real(kind=RKIND) :: current = 0.0_RKIND, deltaVoltage = 0.0_RKIND + real(kind=RKIND) :: plusVoltage = 0.0_RKIND, minusVoltage = 0.0_RKIND, voltageDiference = 0.0_RKIND + end type + + type wire_current_probe_output_t + integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: currentComponent + integer(kind=SINGLE) :: sign = +1 + + type(CurrentSegments), pointer :: segment +#ifdef CompileWithBerengerWires + type(TSegment), pointer :: segmentBerenger +#endif +#ifdef CompileWithSlantedWires + class(Segment), pointer :: segmentSlanted +#endif + + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + type(current_values_t), dimension(BuffObse) :: currentValues + end type wire_current_probe_output_t + + type bulk_current_probe_output_t + integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + integer(kind=SINGLE) :: x2Coord, y2Coord, z2Coord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: fieldComponent + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND + real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND + + end type bulk_current_probe_output_t + + type volumic_current_probe_t + integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components + type(domain_t) :: domain + integer(kind=SINGLE) :: xCoord, yCoord, zCoord + integer(kind=SINGLE) :: x2Coord, y2Coord, z2Coord + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: fieldComponent + + !Intent storage order: + !(:) == (timeinstance) => timeValue + !(:,:) == (timeInstance, componentId) => escalar + + !Time Domain (requires first allocation) + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(:), allocatable :: timeStep + real(kind=RKIND), dimension(:, :), allocatable :: xValueForTime + real(kind=RKIND), dimension(:, :), allocatable :: yValueForTime + real(kind=RKIND), dimension(:, :), allocatable :: zValueForTime + + !Intent storage order: + !(:) == (frquencyinstance) => timeValue + !(:,:) == (frquencyinstance, componentId) => escalar + + !Frequency Domain (requires first allocation) + integer(kind=SINGLE) :: nFreq = 0_SINGLE + real(kind=RKIND), dimension(:), allocatable :: frequencySlice + complex(kind=CKIND), dimension(:, :), allocatable :: xValueForFreq + complex(kind=CKIND), dimension(:, :), allocatable :: yValueForFreq + complex(kind=CKIND), dimension(:, :), allocatable :: zValueForFreq + complex(kind=CKIND), dimension(:), allocatable :: auxExp_E + complex(kind=CKIND), dimension(:), allocatable :: auxExp_H + + end type volumic_current_probe_t + + type volumic_field_probe_output_t + !!!!!Pending + end type volumic_field_probe_output_t + type line_integral_probe_output_t + !!!!!Pending + end type line_integral_probe_output_t + type far_field_probe_output_t + !!!!!Pending + end type far_field_probe_output_t + type movie_probe_output_t + !!!!!Pending + end type movie_probe_output_t + type frequency_slice_probe_output_t + !!!!!Pending + end type frequency_slice_probe_output_t + +contains + +end module outputTypes diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index bd05f692..5806a758 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -1,25 +1,12 @@ module mod_outputUtils use FDETYPES + use outputTypes use mod_domain use report implicit none character(len=4), parameter :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' integer(kind=SINGLE), parameter :: FILE_UNIT = 400 - type field_data_t - real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: x => NULL() - real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: y => NULL() - real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: z => NULL() - real(kind=RKIND), pointer, dimension(:), contiguous :: deltaX => NULL() - real(kind=RKIND), pointer, dimension(:), contiguous :: deltaY => NULL() - real(kind=RKIND), pointer, dimension(:), contiguous :: deltaZ => NULL() - end type field_data_t - - type fields_reference_t - type(field_data_t) :: E - type(field_data_t) :: H - end type fields_reference_t - contains function get_probe_coords_extension(iCoord, jCoord, kCoord, mpidir) result(ext) diff --git a/src_output/point_probe_output.F90 b/src_output/pointProbeOutput.F90 similarity index 75% rename from src_output/point_probe_output.F90 rename to src_output/pointProbeOutput.F90 index c806437e..f2e5ca96 100644 --- a/src_output/point_probe_output.F90 +++ b/src_output/pointProbeOutput.F90 @@ -1,33 +1,21 @@ module mod_pointProbeOutput use FDETYPES + use outputTypes use mod_domain use mod_outputUtils implicit none - type point_probe_output_t - integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field - type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord - integer(kind=SINGLE) :: fileUnitTime, fileUnitFreq - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: fieldComponent - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE, nFreq = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND - - real(kind=RKIND), dimension(:), allocatable :: frequencySlice - real(kind=CKIND), dimension(:), allocatable :: valueForFreq - end type point_probe_output_t - contains - subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, outputTypeExtension, mpidir) + subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, outputTypeExtension, mpidir, timeInterval) type(point_probe_output_t), intent(out) :: this integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord integer(kind=SINGLE), intent(in) :: mpidir, field character(len=*), intent(in) :: outputTypeExtension type(domain_t), intent(in) :: domain + real(kind=RKIND_tiempo), intent(in) :: timeInterval + integer(kind=SINGLE) :: i this%xCoord = iCoord @@ -47,6 +35,13 @@ subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, call init_frequency_slice(this%frequencySlice, this%domain) end do this%valueForFreq = (0.0_RKIND, 0.0_RKIND) + + allocate (this%auxExp_E(this%nFreq)) + allocate (this%auxExp_H(this%nFreq)) + do i = 1, this%nFreq + this%auxExp_E(i) = timeInterval*(1.0E0_RKIND, 0.0E0_RKIND)*Exp(mcpi2*this%frequencySlice(i)) !el dt deberia ser algun tipo de promedio + this%auxExp_H(i) = this%auxExp_E(i)*Exp(mcpi2*this%frequencySlice(i)*timeInterval*0.5_RKIND) + end do end if contains @@ -87,29 +82,30 @@ end function get_probe_bounds_extension end subroutine init_point_probe_output subroutine create_point_probe_output_files(this) - implicit none - type(point_probe_output_t), intent(inout) :: this - character(len=BUFSIZE) :: file_time, file_freq - integer(kind=SINGLE) :: err - err = 0 + implicit none + type(point_probe_output_t), intent(inout) :: this + character(len=BUFSIZE) :: file_time, file_freq + integer(kind=SINGLE) :: err + err = 0 - file_time = trim(adjustl(this%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & - trim(adjustl(datFileExtension)) + file_time = trim(adjustl(this%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & + trim(adjustl(datFileExtension)) - file_freq = trim(adjustl(this%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & - trim(adjustl(datFileExtension)) + file_freq = trim(adjustl(this%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & + trim(adjustl(datFileExtension)) - call create_or_clear_file(file_time, this%fileUnitTime, err) - call create_or_clear_file(file_freq, this%fileUnitFreq, err) + call create_or_clear_file(file_time, this%fileUnitTime, err) + call create_or_clear_file(file_freq, this%fileUnitFreq, err) -end subroutine create_point_probe_output_files + end subroutine create_point_probe_output_files subroutine update_point_probe_output(this, step, field) type(point_probe_output_t), intent(inout) :: this - real(kind=RKIND), pointer, dimension(:, :, :) :: field + real(kind=RKIND), pointer, dimension(:, :, :), intent(in) :: field real(kind=RKIND_tiempo), intent(in) :: step + integer(kind=SINGLE) :: iter if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then @@ -119,10 +115,19 @@ subroutine update_point_probe_output(this, step, field) end if if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - do iter = 1, this%nFreq - this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord) !*get_auxExp(this%frequencySlice(iter), this%fieldComponent) - end do + select case (this%fieldComponent) + case (iEx, iEy, iEz) + do iter = 1, this%nFreq + this%valueForFreq(iter) = & + this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*(this%auxExp_E(iter)**step) + end do + case (iHx, iHy, iHz) + do iter = 1, this%nFreq + this%valueForFreq(iter) = & + this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*(this%auxExp_H(iter)**step) + end do + end select + end if end subroutine update_point_probe_output diff --git a/src_output/volumic_probe_output.F90 b/src_output/volumicProbeOutput.F90 similarity index 62% rename from src_output/volumic_probe_output.F90 rename to src_output/volumicProbeOutput.F90 index 0b392021..3075d886 100644 --- a/src_output/volumic_probe_output.F90 +++ b/src_output/volumicProbeOutput.F90 @@ -1,4 +1,4 @@ -module mod_volumicProbe +module mod_volumicProbeOutput use FDETYPES use mod_domain use mod_outputUtils @@ -6,40 +6,9 @@ module mod_volumicProbe implicit none private :: isRelevantCell, isRelevantSurfaceCell - type volumic_current_probe_t - integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components - type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord - integer(kind=SINGLE) :: x2Coord, y2Coord, z2Coord - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: fieldComponent - - !Intent storage order: - !(:) == (timeinstance) => timeValue - !(:,:) == (timeInstance, componentId) => escalar - - !Time Domain (requires first allocation) - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(:), allocatable :: timeStep - real(kind=RKIND), dimension(:, :), allocatable :: xValueForTime - real(kind=RKIND), dimension(:, :), allocatable :: yValueForTime - real(kind=RKIND), dimension(:, :), allocatable :: zValueForTime - - !Intent storage order: - !(:) == (frquencyinstance) => timeValue - !(:,:) == (frquencyinstance, componentId) => escalar - - !Frequency Domain (requires first allocation) - integer(kind=SINGLE) :: nFreq = 0_SINGLE - real(kind=RKIND), dimension(:), allocatable :: frequencySlice - real(kind=CKIND), dimension(:, :), allocatable :: xValueForFreq - real(kind=CKIND), dimension(:, :), allocatable :: yValueForFreq - real(kind=CKIND), dimension(:, :), allocatable :: zValueForFreq - end type volumic_current_probe_t - contains - subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir) + subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir, timeInterval) type(volumic_current_probe_t), intent(inout) :: this integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord integer(kind=SINGLE), intent(in) :: i2Coord, j2Coord, k2Coord @@ -50,9 +19,11 @@ subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Co type(media_matrices_t), pointer, intent(in) :: geometryMedia type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + real(kind=RKIND_tiempo), intent(in) :: timeInterval + type(domain_t), intent(in) :: domain - integer(kind=SINGLE) :: i, totalPecSurfaces + integer(kind=SINGLE) :: i, relevantGeometriesCount this%xCoord = iCoord this%yCoord = jCoord @@ -67,30 +38,37 @@ subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Co this%domain = domain this%path = get_output_path() - totalPecSurfaces = count_pec_surfaces(this, geometryMedia, registeredMedia, sinpml_fullsize) + relevantGeometriesCount = count_relevant_geometries(this, geometryMedia, registeredMedia, sinpml_fullsize) if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then allocate (this%timeStep(BuffObse)) - allocate (this%xValueForTime(BuffObse, totalPecSurfaces)) - allocate (this%yValueForTime(BuffObse, totalPecSurfaces)) - allocate (this%zValueForTime(BuffObse, totalPecSurfaces)) + allocate (this%xValueForTime(BuffObse, relevantGeometriesCount)) + allocate (this%yValueForTime(BuffObse, relevantGeometriesCount)) + allocate (this%zValueForTime(BuffObse, relevantGeometriesCount)) this%xValueForTime = 0.0_RKIND this%yValueForTime = 0.0_RKIND this%zValueForTime = 0.0_RKIND end if if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - this%nFreq = this%domain%fnum - allocate (this%frequencySlice(this%domain%fnum)) - allocate (this%xValueForFreq(this%domain%fnum, totalPecSurfaces)) - allocate (this%yValueForFreq(this%domain%fnum, totalPecSurfaces)) - allocate (this%zValueForFreq(this%domain%fnum, totalPecSurfaces)) + this%nFreq = this%nFreq + allocate (this%frequencySlice(this%nFreq)) + allocate (this%xValueForFreq(this%nFreq, relevantGeometriesCount)) + allocate (this%yValueForFreq(this%nFreq, relevantGeometriesCount)) + allocate (this%zValueForFreq(this%nFreq, relevantGeometriesCount)) do i = 1, this%nFreq call init_frequency_slice(this%frequencySlice, this%domain) end do this%xValueForFreq = (0.0_RKIND, 0.0_RKIND) this%yValueForFreq = (0.0_RKIND, 0.0_RKIND) this%zValueForFreq = (0.0_RKIND, 0.0_RKIND) + + allocate (this%auxExp_E(this%nFreq)) + allocate (this%auxExp_H(this%nFreq)) + do i = 1, this%nFreq + this%auxExp_E(i) = timeInterval*(1.0E0_RKIND, 0.0E0_RKIND)*Exp(mcpi2*this%frequencySlice(i)) !el dt deberia ser algun tipo de promedio + this%auxExp_H(i) = this%auxExp_E(i)*Exp(mcpi2*this%frequencySlice(i)*timeInterval*0.5_RKIND) + end do end if contains @@ -106,13 +84,14 @@ end function get_output_path end subroutine init_volumic_probe_output - function count_pec_surfaces(this, geometryMedia, registeredMedia, sinpml_fullsize) result(n) + function count_relevant_geometries(this, geometryMedia, registeredMedia, sinpml_fullsize) result(n) type(volumic_current_probe_t), intent(in) :: this type(media_matrices_t), pointer, intent(in) :: geometryMedia type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize integer(kind=SINGLE) :: i, j, k, field integer(kind=SINGLE) :: n + n = 0_SINGLE do i = this%xCoord, this%x2Coord do j = this%yCoord, this%y2Coord @@ -130,7 +109,7 @@ function count_pec_surfaces(this, geometryMedia, registeredMedia, sinpml_fullsiz end do end do end do - end function count_pec_surfaces + end function subroutine update_volumic_probe_output(this, step, geometryMedia, registeredMedia, sinpml_fullsize, fieldsReference) type(volumic_current_probe_t), intent(inout) :: this @@ -144,13 +123,12 @@ subroutine update_volumic_probe_output(this, step, geometryMedia, registeredMedi integer(kind=SINGLE) :: Efield, Hfield, i, j, k, conta integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2 - conta = 0 - if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + conta = 0 this%serializedTimeSize = this%serializedTimeSize + 1 - do k = k1, k2 - do j = j1, j2 do i = i1, i2 + do j = j1, j2 + do k = k1, k2 do Efield = iEx, iEz if (isRelevantCell(Efield, i, j, k, geometryMedia, registeredMedia, sinpml_fullsize)) then conta = conta + 1 @@ -167,7 +145,27 @@ subroutine update_volumic_probe_output(this, step, geometryMedia, registeredMedi end do end do end if + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + conta = 0 + do i = i1, i2 + do j = j1, j2 + do k = k1, k2 + do Efield = iEx, iEz + if (isRelevantCell(Efield, i, j, k, geometryMedia, registeredMedia, sinpml_fullsize)) then + conta = conta + 1 + call update_current(this, Efield, i, j, k, conta, fieldsReference, step) + end if + end do + do Hfield = iHx, iHz + if (isRelevantSurfaceCell(Hfield, i, j, k, this%fieldComponent, geometryMedia, registeredMedia, sinpml_fullsize)) then + conta = conta + 1 + call update_current_surfaces(this, Hfield, i, j, k, conta, fieldsReference, step) + end if + end do + end do + end do + end do end if contains subroutine save_current(this, Efield, i, j, k, conta, field_reference) @@ -197,6 +195,47 @@ subroutine save_current_surfaces(this, Hfield, i, j, k, conta, field_reference) this%yValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHx), Hfield == iHy) this%zValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHy), Hfield == iHz) end subroutine save_current_surfaces + + subroutine update_current(this, Efield, i, j, k, conta, field_reference, step) + integer(kind=SINGLE), intent(in) :: Efield, i, j, k, conta + type(volumic_current_probe_t), intent(inout) :: this + type(fields_reference_t), pointer, intent(in) :: field_reference + real(kind=RKIND_tiempo), intent(in) :: step + + integer(kind=SINGLE) :: freqIdx + real(kind=RKIND) :: jdir + + jdir = computeJ(Efield, i, j, k, field_reference) + do freqIdx = 1, this%nFreq + call updateComplexComponent(iEx, EField, this%xValueForFreq(freqIdx, conta), jdir, this%auxExp_E(freqIdx)**step) + call updateComplexComponent(iEy, EField, this%yValueForFreq(freqIdx, conta), jdir, this%auxExp_E(freqIdx)**step) + call updateComplexComponent(iEz, EField, this%zValueForFreq(freqIdx, conta), jdir, this%auxExp_E(freqIdx)**step) + end do + end subroutine update_current + + subroutine update_current_surfaces(this, Hfield, i, j, k, conta, field_reference, step) + integer(kind=SINGLE), intent(in) :: Hfield, i, j, k, conta + type(volumic_current_probe_t), intent(inout) :: this + type(fields_reference_t), pointer, intent(in) :: field_reference + real(kind=RKIND_tiempo), intent(in) :: step + + integer(kind=SINGLE) :: freqIdx + real(kind=RKIND) :: jdir, jdir1, jdir2 + + jdir1 = computeJ1(HField, i, j, k, field_reference) + jdir2 = computeJ2(HField, i, j, k, field_reference) + do freqIdx = 1, this%nFreq + jdir = merge(jdir1, jdir2, HField == iHz) + call updateComplexComponent(iHx, Hfield, this%xValueForFreq(freqIdx, conta), jdir, this%auxExp_H(freqIdx)**step) + + jdir = merge(jdir1, jdir2, HField == iHx) + call updateComplexComponent(iHy, Hfield, this%yValueForFreq(freqIdx, conta), jdir, this%auxExp_H(freqIdx)**step) + + jdir = merge(jdir1, jdir2, HField == iHy) + call updateComplexComponent(iHz, Hfield, this%zValueForFreq(freqIdx, conta), jdir, this%auxExp_H(freqIdx)**step) + end do + end subroutine update_current_surfaces + end subroutine update_volumic_probe_output logical function isRelevantCell(Efield, I, J, K, geometryMedia, registeredMedia, sinpml_fullsize) @@ -232,4 +271,15 @@ logical function isRelevantSurfaceCell(field, i, j, k, outputType, geometryMedia end function -end module mod_volumicProbe + subroutine updateComplexComponent(direction, fieldIndex, valorComplex, jdir, auxExp) + integer, intent(in) :: direction, fieldIndex + complex(kind=CKIND), intent(inout) :: valorComplex + complex(kind=CKIND), intent(in) :: auxExp + real(kind=RKIND), intent(in) :: jdir + + complex(kind=CKIND) :: z_cplx = (0.0_RKIND, 0.0_RKIND) + + valorComplex = merge(valorComplex + auxExp*jdir, z_cplx, fieldIndex == direction) + end subroutine updateComplexComponent + +end module mod_volumicProbeOutput diff --git a/src_output/wire_current_probe_output.F90 b/src_output/wireProbeOutput.F90 similarity index 74% rename from src_output/wire_current_probe_output.F90 rename to src_output/wireProbeOutput.F90 index aa7117a3..f52f24fb 100644 --- a/src_output/wire_current_probe_output.F90 +++ b/src_output/wireProbeOutput.F90 @@ -1,46 +1,12 @@ -module mod_wireCurrentProbeOutput +module mod_wireProbeOutput use FDETYPES - use mod_domain + use outputTypes use mod_outputUtils use wiresHolland_constants use HollandWires -#ifdef CompileWithBerengerWires - use WiresBerenger -#endif -#ifdef CompileWithSlantedWires - use WiresSlanted - use WiresSlanted_Types - use WiresSlanted_Constants -#endif implicit none - type current_values_t - real(kind=RKIND) :: current = 0.0_RKIND, deltaVoltage = 0.0_RKIND - real(kind=RKIND) :: plusVoltage = 0.0_RKIND, minusVoltage = 0.0_RKIND, voltageDiference = 0.0_RKIND - end type - - type wire_current_probe_output_t - integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus - type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: currentComponent - integer(kind=SINGLE) :: sign = +1 - - type(CurrentSegments), pointer :: segment -#ifdef CompileWithBerengerWires - type(TSegment), pointer :: segmentBerenger -#endif -#ifdef CompileWithSlantedWires - class(Segment), pointer :: segmentSlanted -#endif - - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - type(current_values_t), dimension(BuffObse) :: currentValues - end type wire_current_probe_output_t - contains subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, media, outputTypeExtension, mpidir, wiresflavor) type(wire_current_probe_output_t), intent(out) :: this @@ -205,6 +171,91 @@ end function get_probe_bounds_extension end subroutine init_wire_current_probe_output + subroutine init_wire_charge_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, outputTypeExtension, mpidir, wiresflavor) + type(wire_charge_probe_output_t), intent(out) :: this + integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node + integer(kind=SINGLE), intent(in) :: field, mpidir + character(len=*), intent(in) :: outputTypeExtension, wiresflavor + type(domain_t), intent(in) :: domain + + type(Thinwires_t), pointer :: Hwireslocal + type(CurrentSegments), pointer :: currentSegment + character(len=BUFSIZE) :: buff + integer(kind=SINGLE) :: n + if (trim(adjustl(wiresflavor)) == 'holland' .or. trim(adjustl(wiresflavor)) == 'transition') Hwireslocal => GetHwires() + + call find_segment() + + this%xCoord = iCoord + this%yCoord = jCoord + this%zCoord = kCoord + + this%chargeComponent = field + + this%domain = domain + this%path = get_output_path() + + contains + subroutine find_segment() + logical :: found = .false. + do n = 1, HWireslocal%NumCurrentSegments + currentSegment => HWireslocal%CurrentSegment(n) + if ((currentSegment%origindex == node) .and. & + (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & + (currentSegment%tipofield*10000 == field)) then + found = .true. + this%segment => currentSegment + if (currentSegment%orientadoalreves) this%sign = -1 + end if + end do + if (.not. found) then + write (buff, '(a,4i7,a)') 'ERROR: CHARGE probe ', node, iCoord, jCoord, kCoord, ' DOES NOT EXIST' + CALL WarnErrReport(buff, .true.) + end if + end subroutine find_segment + + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: outputPath + character(len=BUFSIZE) :: charNO + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension, prefixNodeExtension + + write (charNO, '(i7)') node + prefixNodeExtension = 's'//trim(adjustl(charNO)) + probeBoundsExtension = get_probe_bounds_extension() + prefixFieldExtension = get_prefix_extension(field, mpidir) + + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_' & + //trim(adjustl(probeBoundsExtension))//'_'//trim(adjustl(prefixNodeExtension)) + return + end function get_output_path + + function get_probe_bounds_extension() result(ext) + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark + + write (chari, '(i7)') iCoord + write (charj, '(i7)') jCoord + write (chark, '(i7)') kCoord + +#if CompileWithMPI + if (mpidir == 3) then + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + elseif (mpidir == 2) then + ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) + elseif (mpidir == 1) then + ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) + else + call stoponerror('Buggy error in mpidir. ') + end if +#else + ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) +#endif + + return + end function get_probe_bounds_extension + end subroutine init_wire_charge_probe_output + subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank, InvEps, InvMu) type(wire_current_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step @@ -284,4 +335,14 @@ subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank, end subroutine -end module mod_wireCurrentProbeOutput + subroutine update_wire_charge_probe_output(this, step) + type(wire_charge_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + type(CurrentSegments), pointer :: segmDumm + + this%serializedTimeSize = this%serializedTimeSize + 1 + this%timeStep(this%serializedTimeSize) = step + SegmDumm => this%segment + this%chargeValue(this%serializedTimeSize) = SegmDumm%ChargeMinus%ChargePresent + end subroutine update_wire_charge_probe_output +end module mod_wireProbeOutput diff --git a/src_output/wire_charge_probe_output.F90 b/src_output/wire_charge_probe_output.F90 deleted file mode 100644 index 0c5cd413..00000000 --- a/src_output/wire_charge_probe_output.F90 +++ /dev/null @@ -1,121 +0,0 @@ -module mod_wireChargeProbeOutput - use FDETYPES - use mod_domain - use mod_outputUtils - use wiresHolland_constants - use HollandWires - implicit none - type wire_charge_probe_output_t - integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus - type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: chargeComponent - integer(kind=SINGLE) :: sign = +1 - - type(CurrentSegments), pointer :: segment - - - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - real(kind=RKIND), dimension(BuffObse) :: chargeValue - end type wire_charge_probe_output_t -contains - - subroutine init_wire_charge_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, outputTypeExtension, mpidir, wiresflavor) - type(wire_charge_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node - integer(kind=SINGLE), intent(in) :: field, mpidir - character(len=*), intent(in) :: outputTypeExtension, wiresflavor - type(domain_t), intent(in) :: domain - - type(Thinwires_t), pointer :: Hwireslocal - type(CurrentSegments), pointer :: currentSegment - character(len=BUFSIZE) :: buff - integer(kind=SINGLE) :: n - if (trim(adjustl(wiresflavor))=='holland' .or. trim(adjustl(wiresflavor))=='transition') Hwireslocal => GetHwires() - - call find_segment() - - this%xCoord = iCoord - this%yCoord = jCoord - this%zCoord = kCoord - - this%chargeComponent = field - - this%domain = domain - this%path = get_output_path() - - contains - subroutine find_segment() - logical :: found = .false. - do n = 1, HWireslocal%NumCurrentSegments - currentSegment => HWireslocal%CurrentSegment(n) - if ((currentSegment%origindex == node) .and. & - (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & - (currentSegment%tipofield*10000 == field)) then - found = .true. - this%segment => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do - if (.not. found) then - write (buff, '(a,4i7,a)') 'ERROR: CHARGE probe ', node, iCoord, jCoord, kCoord, ' DOES NOT EXIST' - CALL WarnErrReport(buff, .true.) - end if - end subroutine find_segment - - function get_output_path() result(outputPath) - character(len=BUFSIZE) :: outputPath - character(len=BUFSIZE) :: charNO - character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension, prefixNodeExtension - - write (charNO, '(i7)') node - prefixNodeExtension = 's'//trim(adjustl(charNO)) - probeBoundsExtension = get_probe_bounds_extension() - prefixFieldExtension = get_prefix_extension(field, mpidir) - - outputPath = & - trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_' & - //trim(adjustl(probeBoundsExtension))//'_'//trim(adjustl(prefixNodeExtension)) - return - end function get_output_path - - function get_probe_bounds_extension() result(ext) - character(len=BUFSIZE) :: ext - character(len=BUFSIZE) :: chari, charj, chark - - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord - -#if CompileWithMPI - if (mpidir == 3) then - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) - elseif (mpidir == 2) then - ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) - elseif (mpidir == 1) then - ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) - else - call stoponerror('Buggy error in mpidir. ') - end if -#else - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) -#endif - - return - end function get_probe_bounds_extension - end subroutine init_wire_charge_probe_output - - subroutine update_wire_charge_probe_output(this, step) - type(wire_charge_probe_output_t), intent(inout) :: this - real(kind=RKIND_tiempo), intent(in) :: step - type(CurrentSegments), pointer :: segmDumm - - this%serializedTimeSize = this%serializedTimeSize + 1 - this%timeStep(this%serializedTimeSize) = step - SegmDumm => this%segment - this%chargeValue(this%serializedTimeSize) = SegmDumm%ChargeMinus%ChargePresent - end subroutine update_wire_charge_probe_output - -end module mod_wireChargeProbeOutput \ No newline at end of file diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 0f8505eb..e1d90c2e 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -111,7 +111,7 @@ integer function test_flush_point_probe() bind(c) result(err) test_err = 0 test_extension = 'tmp_cases/flush_point_probe' domain = domain_t(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) - call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3) + call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3, 0.1_RKIND_tiempo) call create_point_probe_output_files(probe) n = 10 @@ -170,7 +170,7 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) test_extension = 'tmp_cases/multiple_flush_point_probe' domain = domain_t(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) - call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3) + call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3, 0.1_RKIND_tiempo) call create_point_probe_output_files(probe) file_time = trim(adjustl(probe%path))//'_'// & From 53d5c5b6a6a0d495df2a915b79ce625d7722ee8b Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 10 Dec 2025 17:20:46 +0100 Subject: [PATCH 27/67] Pack bound coordinates --- src_output/bulkProbeOutput.F90 | 64 ++++++----------------------- src_output/output.F90 | 31 +++++++------- src_output/outputTypes.F90 | 40 ++++++++++++++---- src_output/outputUtils.F90 | 67 ++++++++++++++++++++++++------- src_output/pointProbeOutput.F90 | 40 ++++-------------- src_output/volumicProbeOutput.F90 | 56 +++++++++++++++++--------- src_output/wireProbeOutput.F90 | 31 +++++++++----- test/output/test_output.F90 | 13 +++++- 8 files changed, 191 insertions(+), 151 deletions(-) diff --git a/src_output/bulkProbeOutput.F90 b/src_output/bulkProbeOutput.F90 index 36ae711e..e1fdc6a3 100644 --- a/src_output/bulkProbeOutput.F90 +++ b/src_output/bulkProbeOutput.F90 @@ -7,24 +7,17 @@ module mod_bulkProbeOutput contains - subroutine init_bulk_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, field, domain, outputTypeExtension, mpidir) + subroutine init_bulk_probe_output(this, lowerBound, upperBound, field, domain, outputTypeExtension, mpidir) type(bulk_current_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord - integer(kind=SINGLE), intent(in) :: i2Coord, j2Coord, k2Coord + 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%xCoord = iCoord - this%yCoord = jCoord - this%zCoord = kCoord - - this%x2Coord = i2Coord - this%y2Coord = j2Coord - this%z2Coord = k2Coord - + this%lowerBound = lowerBound + this%upperBound = upperBound this%fieldComponent = field this%domain = domain @@ -35,46 +28,13 @@ subroutine init_bulk_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_probe_bounds_extension() + probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, mpidir) prefixFieldExtension = get_prefix_extension(field, mpidir) outputPath = & - trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//trim(adjustl(probeBoundsExtension)) + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) return end function get_output_path - function get_probe_bounds_extension() result(ext) - character(len=BUFSIZE) :: ext - character(len=BUFSIZE) :: chari, charj, chark, chari2, charj2, chark2 - - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord - - write (chari2, '(i7)') i2Coord - write (charj2, '(i7)') j2Coord - write (chark2, '(i7)') k2Coord - -#if CompileWithMPI - if (mpidir == 3) then - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark))//'__'// & - trim(adjustl(chari2))//'_'//trim(adjustl(charj2))//'_'//trim(adjustl(chark2)) - elseif (mpidir == 2) then - ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari))//'__'// & - trim(adjustl(charj2))//'_'//trim(adjustl(chark2))//'_'//trim(adjustl(chari2)) - elseif (mpidir == 1) then - ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj))//'__'// & - trim(adjustl(chark2))//'_'//trim(adjustl(chari2))//'_'//trim(adjustl(charj2)) - else - call stoponerror('Buggy error in mpidir. ') - end if -#else - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark))//'__'// & - trim(adjustl(chari2))//'_'//trim(adjustl(charj2))//'_'//trim(adjustl(chark2)) -#endif - - return - end function get_probe_bounds_extension - end subroutine init_bulk_probe_output subroutine update_bulk_probe_output(this, step, field) @@ -89,12 +49,12 @@ subroutine update_bulk_probe_output(this, step, field) real(kind=RKIND), pointer, dimension(:, :, :) :: xF, yF, zF real(kind=RKIND), pointer, dimension(:) :: dx, dy, dz - i1_m = this%xCoord - i2_m = this%x2Coord - j1_m = this%yCoord - j2_m = this%y2Coord - k1_m = this%zCoord - k2_m = this%z2Coord + i1_m = this%lowerBound%x + j1_m = this%lowerBound%y + k1_m = this%lowerBound%z + i2_m = this%upperBound%x + j2_m = this%upperBound%y + k2_m = this%upperBound%z i1 = i1_m j1 = i2_m diff --git a/src_output/output.F90 b/src_output/output.F90 index e924e996..95cd1874 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -1,5 +1,6 @@ module output use FDETYPES + use Report use mod_domain use mod_outputUtils use mod_pointProbeOutput @@ -97,8 +98,9 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW logical :: ThereAreWires type(domain_t) :: domain + type(cell_coordinate_t) :: lowerBound, upperBound integer(kind=SINGLE) :: i, ii, outputRequestType - integer(kind=SINGLE) :: I1, J1, K1, I2, J2, K2, NODE + integer(kind=SINGLE) :: NODE integer(kind=SINGLE) :: outputCount character(len=BUFSIZE) :: outputTypeExtension @@ -112,12 +114,13 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW do ii = 1, sgg%NumberRequest do i = 1, sgg%Observation(ii)%nP - I1 = sgg%observation(ii)%P(i)%XI - J1 = sgg%observation(ii)%P(i)%YI - K1 = sgg%observation(ii)%P(i)%ZI - I2 = sgg%observation(ii)%P(i)%XE - J2 = sgg%observation(ii)%P(i)%YE - K2 = sgg%observation(ii)%P(i)%ZE + lowerBound%x = sgg%observation(ii)%P(i)%XI + lowerBound%y = sgg%observation(ii)%P(i)%YI + lowerBound%z = sgg%observation(ii)%P(i)%ZI + + upperBound%x = sgg%observation(ii)%P(i)%XE + upperBound%y = sgg%observation(ii)%P(i)%YE + upperBound%z = sgg%observation(ii)%P(i)%ZE NODE = sgg%observation(ii)%P(i)%NODE domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, control%finaltimestep) @@ -130,7 +133,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW outputs(outputCount)%outputID = POINT_PROBE_ID allocate (outputs(outputCount)%pointProbe) -call init_solver_output(outputs(outputCount)%pointProbe, I1, J1, K1, outputRequestType, domain, outputTypeExtension, control%mpidir, sgg%dt) + call init_solver_output(outputs(outputCount)%pointProbe, lowerBound, outputRequestType, domain, outputTypeExtension, control%mpidir, sgg%dt) case (iJx, iJy, iJz) if (ThereAreWires) then @@ -138,7 +141,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW outputs(outputCount)%outputID = WIRE_CURRENT_PROBE_ID allocate (outputs(outputCount)%wireCurrentProbe) - call init_solver_output(outputs(outputCount)%wireCurrentProbe, I1, J1, K1, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) + call init_solver_output(outputs(outputCount)%wireCurrentProbe, lowerBound, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) end if case (iQx, iQy, iQz) @@ -146,13 +149,13 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW outputs(outputCount)%outputID = WIRE_CHARGE_PROBE_ID allocate (outputs(outputCount)%wireChargeProbe) - call init_solver_output(outputs(outputCount)%wireChargeProbe, I1, J1, K1, NODE, outputRequestType, domain, outputTypeExtension, control%mpidir, control%wiresflavor) + call init_solver_output(outputs(outputCount)%wireChargeProbe, lowerBound, NODE, outputRequestType, domain, outputTypeExtension, control%mpidir, control%wiresflavor) case (iBloqueJx, iBloqueJy, iBloqueJz, iBloqueMx, iBloqueMy, iBloqueMz) outputCount = outputCount + 1 outputs(outputCount)%outputID = BULK_PROBE_ID allocate (outputs(outputCount)%bulkCurrentProbe) - call init_solver_output(outputs(outputCount)%bulkCurrentProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, outputTypeExtension, control%mpidir) + call init_solver_output(outputs(outputCount)%bulkCurrentProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control%mpidir) !! call adjust_computation_range --- Required due to issues in mpi region edges case (iCur, iCurX, iCurY, iCurZ) @@ -160,7 +163,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW outputs(outputCount)%outputID = VOLUMIC_CURRENT_PROBE_ID allocate (outputs(outputCount)%volumicCurrentProbe) - call init_solver_output(outputs(outputCount)%volumicCurrentProbe, I1, J1, K1, I2, J2, K2, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir, sgg%dt) + call init_solver_output(outputs(outputCount)%volumicCurrentProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir, sgg%dt) case default call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') @@ -180,8 +183,8 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep if (observation%TimeDomain) then newdomain = domain_t(real(observation%InitialTime, kind=RKIND_tiempo), & - real(observation%FinalTime, kind=RKIND_tiempo), & - real(observation%TimeStep, kind=RKIND_tiempo)) + real(observation%FinalTime, kind=RKIND_tiempo), & + real(observation%TimeStep, kind=RKIND_tiempo)) newdomain%tstep = max(newdomain%tstep, simulationTimeStep) diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 7c6e8eef..09ea2af6 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -17,6 +17,10 @@ module outputTypes integer, parameter :: FREQUENCY_DOMAIN = 1 integer, parameter :: BOTH_DOMAIN = 2 + character(len=4), parameter :: datFileExtension = '.dat' + character(len=4), parameter :: timeExtension = 'tm' + character(len=4), parameter :: frequencyExtension = 'fq' + type :: domain_t real(kind=RKIND_tiempo) :: tstart = 0.0_RKIND_tiempo, tstop = 0.0_RKIND_tiempo, tstep = 0.0_RKIND_tiempo real(kind=RKIND) :: fstart = 0.0_RKIND, fstop = 0.0_RKIND, fstep @@ -25,6 +29,10 @@ module outputTypes logical :: logarithmicSpacing = .false. end type domain_t + type cell_coordinate_t + integer(kind=SINGLE) :: x,y,z + end type cell_coordinate_t + type field_data_t real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: x => NULL() real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: y => NULL() @@ -42,7 +50,7 @@ module outputTypes type point_probe_output_t integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord + type(cell_coordinate_t) :: coordinates integer(kind=SINGLE) :: fileUnitTime, fileUnitFreq character(len=BUFSIZE) :: path integer(kind=SINGLE) :: fieldComponent @@ -59,7 +67,7 @@ module outputTypes type wire_charge_probe_output_t integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord + type(cell_coordinate_t) :: coordinates character(len=BUFSIZE) :: path integer(kind=SINGLE) :: chargeComponent integer(kind=SINGLE) :: sign = +1 @@ -79,7 +87,7 @@ module outputTypes type wire_current_probe_output_t integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord + type(cell_coordinate_t) :: coordinates character(len=BUFSIZE) :: path integer(kind=SINGLE) :: currentComponent integer(kind=SINGLE) :: sign = +1 @@ -100,8 +108,8 @@ module outputTypes type bulk_current_probe_output_t integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord - integer(kind=SINGLE) :: x2Coord, y2Coord, z2Coord + type(cell_coordinate_t) :: lowerBound + type(cell_coordinate_t) :: upperBound character(len=BUFSIZE) :: path integer(kind=SINGLE) :: fieldComponent integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE @@ -113,8 +121,8 @@ module outputTypes type volumic_current_probe_t integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components type(domain_t) :: domain - integer(kind=SINGLE) :: xCoord, yCoord, zCoord - integer(kind=SINGLE) :: x2Coord, y2Coord, z2Coord + type(cell_coordinate_t) :: lowerBound + type(cell_coordinate_t) :: upperBound character(len=BUFSIZE) :: path integer(kind=SINGLE) :: fieldComponent @@ -154,7 +162,23 @@ module outputTypes !!!!!Pending end type far_field_probe_output_t type movie_probe_output_t - !!!!!Pending + integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components + type(domain_t) :: domain + type(cell_coordinate_t) :: lowerBound + type(cell_coordinate_t) :: upperBound + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: fieldComponent + + !Intent storage order: + !(:) == (timeinstance) => timeValue + !(:,:) == (timeInstance, componentId) => escalar + + !Time Domain (requires first allocation) + integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE + real(kind=RKIND_tiempo), dimension(:), allocatable :: timeStep + real(kind=RKIND), dimension(:, :), allocatable :: xValueForTime + real(kind=RKIND), dimension(:, :), allocatable :: yValueForTime + real(kind=RKIND), dimension(:, :), allocatable :: zValueForTime end type movie_probe_output_t type frequency_slice_probe_output_t !!!!!Pending diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 5806a758..fb783e67 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -4,19 +4,57 @@ module mod_outputUtils use mod_domain use report implicit none - character(len=4), parameter :: datFileExtension = '.dat', timeExtension = 'tm', frequencyExtension = 'fq' integer(kind=SINGLE), parameter :: FILE_UNIT = 400 + private + + !=========================== + ! Public interface summary + !=========================== + public :: get_coordinates_extension + public :: get_prefix_extension + public :: open_file + public :: close_file + public :: create_or_clear_file + public :: init_frequency_slice + public :: getBlockCurrentDirection + public :: isPEC + public :: isSplitOrAdvanced + public :: isThinWire + public :: isMediaVacuum + public :: isWithinBounds + public :: isSurface + public :: isFlush + public :: computej + public :: computeJ1 + public :: computeJ2 + !=========================== + + !=========================== + ! Private interface summary + !=========================== + private :: get_rotated_prefix + private :: prefix + private :: get_probe_coords_extension + private :: get_probe_bounds_coords_extension + private :: get_delta + !=========================== + + interface get_coordinates_extension + module procedure get_probe_coords_extension, get_probe_bounds_coords_extension + end interface get_coordinates_extension + contains - function get_probe_coords_extension(iCoord, jCoord, kCoord, mpidir) result(ext) - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, mpidir + function get_probe_coords_extension(coordinates, mpidir) result(ext) + type(cell_coordinate_t) :: coordinates + integer(kind=SINGLE), intent(in) :: mpidir character(len=BUFSIZE) :: ext character(len=BUFSIZE) :: chari, charj, chark - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord + write (chari, '(i7)') coordinates%x + write (charj, '(i7)') coordinates%y + write (chark, '(i7)') coordinates%z #if CompileWithMPI if (mpidir == 3) then @@ -35,18 +73,19 @@ function get_probe_coords_extension(iCoord, jCoord, kCoord, mpidir) result(ext) return end function get_probe_coords_extension - function get_probe_bounds_coords_extension(iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, mpidir) result(ext) - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, mpidir + function get_probe_bounds_coords_extension(lowerCoordinates, upperCoordinates, mpidir) result(ext) + type(cell_coordinate_t) :: lowerCoordinates, upperCoordinates + integer(kind=SINGLE), intent(in) :: mpidir character(len=BUFSIZE) :: ext character(len=BUFSIZE) :: chari, charj, chark, chari2, charj2, chark2 - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord + write (chari, '(i7)') lowerCoordinates%x + write (charj, '(i7)') lowerCoordinates%y + write (chark, '(i7)') lowerCoordinates%z - write (chari2, '(i7)') i2Coord - write (charj2, '(i7)') j2Coord - write (chark2, '(i7)') k2Coord + write (chari2, '(i7)') upperCoordinates%x + write (charj2, '(i7)') upperCoordinates%y + write (chark2, '(i7)') upperCoordinates%z #if CompileWithMPI if (mpidir == 3) then diff --git a/src_output/pointProbeOutput.F90 b/src_output/pointProbeOutput.F90 index f2e5ca96..4ca0886b 100644 --- a/src_output/pointProbeOutput.F90 +++ b/src_output/pointProbeOutput.F90 @@ -7,9 +7,9 @@ module mod_pointProbeOutput implicit none contains - subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, outputTypeExtension, mpidir, timeInterval) + subroutine init_point_probe_output(this, coordinates, field, domain, outputTypeExtension, mpidir, timeInterval) type(point_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord + type(cell_coordinate_t) :: coordinates integer(kind=SINGLE), intent(in) :: mpidir, field character(len=*), intent(in) :: outputTypeExtension type(domain_t), intent(in) :: domain @@ -18,9 +18,7 @@ subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, integer(kind=SINGLE) :: i - this%xCoord = iCoord - this%yCoord = jCoord - this%zCoord = kCoord + this%coordinates = coordinates this%fieldComponent = field @@ -48,37 +46,13 @@ subroutine init_point_probe_output(this, iCoord, jCoord, kCoord, field, domain, function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_probe_bounds_extension() + probeBoundsExtension = get_coordinates_extension(this%coordinates, mpidir) prefixFieldExtension = get_prefix_extension(field, mpidir) outputPath = & trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) return end function get_output_path - function get_probe_bounds_extension() result(ext) - character(len=BUFSIZE) :: ext - character(len=BUFSIZE) :: chari, charj, chark - - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord - -#if CompileWithMPI - if (mpidir == 3) then - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) - elseif (mpidir == 2) then - ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) - elseif (mpidir == 1) then - ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) - else - call stoponerror('Buggy error in mpidir. ') - end if -#else - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) -#endif - - return - end function get_probe_bounds_extension end subroutine init_point_probe_output subroutine create_point_probe_output_files(this) @@ -111,7 +85,7 @@ subroutine update_point_probe_output(this, step, field) if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then this%serializedTimeSize = this%serializedTimeSize + 1 this%timeStep(this%serializedTimeSize) = step - this%valueForTime(this%serializedTimeSize) = field(this%xCoord, this%yCoord, this%zCoord) + this%valueForTime(this%serializedTimeSize) = field(this%coordinates%x, this%coordinates%y, this%coordinates%z) end if if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then @@ -119,12 +93,12 @@ subroutine update_point_probe_output(this, step, field) case (iEx, iEy, iEz) do iter = 1, this%nFreq this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*(this%auxExp_E(iter)**step) + this%valueForFreq(iter) + field(this%coordinates%x, this%coordinates%y, this%coordinates%z)*(this%auxExp_E(iter)**step) end do case (iHx, iHy, iHz) do iter = 1, this%nFreq this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%xCoord, this%yCoord, this%zCoord)*(this%auxExp_H(iter)**step) + this%valueForFreq(iter) + field(this%coordinates%x, this%coordinates%y, this%coordinates%z)*(this%auxExp_H(iter)**step) end do end select diff --git a/src_output/volumicProbeOutput.F90 b/src_output/volumicProbeOutput.F90 index 3075d886..225709e9 100644 --- a/src_output/volumicProbeOutput.F90 +++ b/src_output/volumicProbeOutput.F90 @@ -2,16 +2,31 @@ module mod_volumicProbeOutput use FDETYPES use mod_domain use mod_outputUtils - implicit none - private :: isRelevantCell, isRelevantSurfaceCell + private + + !=========================== + ! Public interface summary + !=========================== + public :: init_volumic_probe_output + public :: update_volumic_probe_output + public :: flush_volumic_probe_output + !=========================== + + !=========================== + ! Private interface summary + !=========================== + private :: isRelevantCell + private :: isRelevantSurfaceCell + private :: updateComplexComponent + private :: count_relevant_geometries + !=========================== contains - subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir, timeInterval) + subroutine init_volumic_probe_output(this, lowerBound, upperBound, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir, timeInterval) type(volumic_current_probe_t), intent(inout) :: this - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord - integer(kind=SINGLE), intent(in) :: i2Coord, j2Coord, k2Coord + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound integer(kind=SINGLE), intent(in) :: mpidir, field character(len=BUFSIZE), intent(in) :: outputTypeExtension @@ -25,16 +40,9 @@ subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Co integer(kind=SINGLE) :: i, relevantGeometriesCount - this%xCoord = iCoord - this%yCoord = jCoord - this%zCoord = kCoord - - this%x2Coord = i2Coord - this%y2Coord = j2Coord - this%z2Coord = k2Coord - + this%lowerBound = lowerBound + this%upperBound = upperBound this%fieldComponent = field - this%domain = domain this%path = get_output_path() @@ -75,7 +83,7 @@ subroutine init_volumic_probe_output(this, iCoord, jCoord, kCoord, i2Coord, j2Co function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_probe_bounds_coords_extension(iCoord, jCoord, kCoord, i2Coord, j2Coord, k2Coord, mpidir) + probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, mpidir) prefixFieldExtension = get_prefix_extension(field, mpidir) outputPath = & trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) @@ -93,9 +101,9 @@ function count_relevant_geometries(this, geometryMedia, registeredMedia, sinpml_ integer(kind=SINGLE) :: n n = 0_SINGLE - do i = this%xCoord, this%x2Coord - do j = this%yCoord, this%y2Coord - do k = this%zCoord, this%z2Coord + do i = this%lowerBound%x, this%upperBound%x + do j = this%lowerBound%y, this%upperBound%y + do k = this%lowerBound%z, this%upperBound%z do field = iEx, iEz if (isRelevantCell(field, i, j, k, geometryMedia, registeredMedia, sinpml_fullsize)) then n = n + 1 @@ -123,6 +131,14 @@ subroutine update_volumic_probe_output(this, step, geometryMedia, registeredMedi integer(kind=SINGLE) :: Efield, Hfield, i, j, k, conta integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2 + i1 = this%lowerBound%x + j1 = this%lowerBound%y + k1 = this%lowerBound%z + + i2 = this%upperBound%x + j2 = this%upperBound%y + k2 = this%upperBound%z + if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then conta = 0 this%serializedTimeSize = this%serializedTimeSize + 1 @@ -238,6 +254,10 @@ end subroutine update_current_surfaces end subroutine update_volumic_probe_output + subroutine flush_volumic_probe_output + !!TODO + end subroutine flush_volumic_probe_output + logical function isRelevantCell(Efield, I, J, K, geometryMedia, registeredMedia, sinpml_fullsize) type(media_matrices_t), pointer, intent(in) :: geometryMedia type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index f52f24fb..1be14d3a 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -1,5 +1,6 @@ module mod_wireProbeOutput use FDETYPES + use Report use outputTypes use mod_outputUtils use wiresHolland_constants @@ -7,16 +8,29 @@ module mod_wireProbeOutput implicit none + private + + !=========================== + ! Public interface summary + !=========================== + public :: init_wire_current_probe_output + public :: init_wire_charge_probe_output + public :: update_wire_current_probe_output + public :: update_wire_charge_probe_output + !=========================== + contains - subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, media, outputTypeExtension, mpidir, wiresflavor) + subroutine init_wire_current_probe_output(this, coordinates, node, field, domain, media, outputTypeExtension, mpidir, wiresflavor) type(wire_current_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node + integer(kind=SINGLE), intent(in) :: node integer(kind=SINGLE), intent(in) :: field, mpidir character(len=BUFSIZE), intent(in) :: outputTypeExtension character(len=*), intent(in) :: wiresflavor type(domain_t), intent(in) :: domain type(MediaData_t), pointer, dimension(:), intent(in) :: media + type(cell_coordinate_t) :: coordinates + type(Thinwires_t), pointer :: Hwireslocal #ifdef CompileWithBerengerWires type(TWires), pointer :: Hwireslocal_Berenger @@ -37,9 +51,7 @@ subroutine init_wire_current_probe_output(this, iCoord, jCoord, kCoord, node, fi call find_segment() - this%xCoord = iCoord - this%yCoord = jCoord - this%zCoord = kCoord + this%coordinates = coordinates this%currentComponent = field @@ -171,24 +183,23 @@ end function get_probe_bounds_extension end subroutine init_wire_current_probe_output - subroutine init_wire_charge_probe_output(this, iCoord, jCoord, kCoord, node, field, domain, outputTypeExtension, mpidir, wiresflavor) + subroutine init_wire_charge_probe_output(this, coordinates, node, field, domain, outputTypeExtension, mpidir, wiresflavor) type(wire_charge_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: iCoord, jCoord, kCoord, node + integer(kind=SINGLE), intent(in) :: node integer(kind=SINGLE), intent(in) :: field, mpidir character(len=*), intent(in) :: outputTypeExtension, wiresflavor type(domain_t), intent(in) :: domain type(Thinwires_t), pointer :: Hwireslocal type(CurrentSegments), pointer :: currentSegment + type(cell_coordinate_t) :: coordinates character(len=BUFSIZE) :: buff integer(kind=SINGLE) :: n if (trim(adjustl(wiresflavor)) == 'holland' .or. trim(adjustl(wiresflavor)) == 'transition') Hwireslocal => GetHwires() call find_segment() - this%xCoord = iCoord - this%yCoord = jCoord - this%zCoord = kCoord + this%coordinates = coordinates this%chargeComponent = field diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index e1d90c2e..a95030e5 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -104,6 +104,7 @@ integer function test_flush_point_probe() bind(c) result(err) use mod_testOutputUtils type(point_probe_output_t) :: probe type(domain_t):: domain + type(cell_coordinate_t) :: coordinates character(len=BUFSIZE) :: file_time, file_freq character(len=27) :: test_extension integer :: n, i @@ -111,7 +112,11 @@ integer function test_flush_point_probe() bind(c) result(err) test_err = 0 test_extension = 'tmp_cases/flush_point_probe' domain = domain_t(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) - call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3, 0.1_RKIND_tiempo) + + coordinates%x = 2 + coordinates%y = 2 + coordinates%z = 2 + call init_point_probe_output(probe, coordinates, iEx, domain, test_extension, 3, 0.1_RKIND_tiempo) call create_point_probe_output_files(probe) n = 10 @@ -161,6 +166,7 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) use mod_testOutputUtils type(point_probe_output_t) :: probe type(domain_t):: domain + type(cell_coordinate_t) :: coordinates character(len=BUFSIZE) :: file_time, file_freq real(kind=RKIND), allocatable :: expectedTime(:, :), expectedFreq(:, :) character(len=36) :: test_extension @@ -170,7 +176,10 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) test_extension = 'tmp_cases/multiple_flush_point_probe' domain = domain_t(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) - call init_point_probe_output(probe, 2, 2, 2, iEx, domain, test_extension, 3, 0.1_RKIND_tiempo) + coordinates%x = 2 + coordinates%y = 2 + coordinates%z = 2 + call init_point_probe_output(probe, coordinates, iEx, domain, test_extension, 3, 0.1_RKIND_tiempo) call create_point_probe_output_files(probe) file_time = trim(adjustl(probe%path))//'_'// & From f2b2f0ab7f97e23f0d629eb643e5ee28285fb825 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 11 Dec 2025 09:22:39 +0100 Subject: [PATCH 28/67] Add movie probe output --- src_output/movieProbeOutput.F90 | 83 +++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 src_output/movieProbeOutput.F90 diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 new file mode 100644 index 00000000..c0af1e99 --- /dev/null +++ b/src_output/movieProbeOutput.F90 @@ -0,0 +1,83 @@ +module mod_movieProbeOutput + use FDETYPES + use outputTypes + use mod_outputUtils + implicit none + private + + !=========================== + ! Public interface summary + !=========================== + public :: init_movie_probe_output + public :: update_movie_probe_output + public :: flush_movie_probe_output + !=========================== + + !=========================== + ! Private interface summary + !=========================== + private :: get_measurements_count + + !=========================== + +contains + + subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir) + type(movie_probe_output_t), intent(inout) :: this + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound + integer(kind=SINGLE), intent(in) :: mpidir, field + character(len=BUFSIZE), intent(in) :: outputTypeExtension + + type(MediaData_t), pointer, dimension(:) :: registeredMedia + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + + type(domain_t), intent(in) :: domain + + this%lowerBound = lowerBound + this%upperBound = upperBound + this%fieldComponent = field !This can refer to field or currentDensity + this%domain = domain + this%path = get_output_path() + + numberOfRequiredMeasures = get_measurements_count() + + contains + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, 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_movie_probe_output + + subroutine update_movie_probe_output() + + end subroutine update_movie_probe_output + + subroutine flush_movie_probe_output() + + end subroutine flush_movie_probe_output + + function get_measurements_count(this) + type(movie_probe_output_t), intent(in) :: this + integer(kind=SINGLE) :: i, j, k, field + integer(kind=SINGLE) :: n + + + + n = 0_SINGLE + do i = this%lowerBound%x, this%upperBound%x + do j = this%lowerBound%y, this%upperBound%y + do k = this%lowerBound%z, this%upperBound%z + if + end do + end do + end do + end function + +end module mod_movieProbeOutput From bb903354ba4c7f384683792886875df996a979b3 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 12 Dec 2025 14:44:19 +0100 Subject: [PATCH 29/67] Create time movie prove module --- .gitmodules | 6 +- CMakeLists.txt | 2 + external/VTKFortran | 1 + src_output/CMakeLists.txt | 6 +- src_output/movieProbeOutput.F90 | 255 ++++++++++++++++++++++++++++++-- src_output/output.F90 | 1 + src_output/outputTypes.F90 | 4 + 7 files changed, 259 insertions(+), 16 deletions(-) create mode 160000 external/VTKFortran diff --git a/.gitmodules b/.gitmodules index 19f69895..fa654c57 100755 --- a/.gitmodules +++ b/.gitmodules @@ -20,4 +20,8 @@ [submodule "external/googletest"] path = external/googletest - url = https://github.com/google/googletest.git \ No newline at end of file + url = https://github.com/google/googletest.git + +[submodule "external/VTKFortran"] + path = external/VTKFortran + url = https://github.com/szaghi/VTKFortran.git diff --git a/CMakeLists.txt b/CMakeLists.txt index 8f5a20fb..b19933c5 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -186,6 +186,8 @@ if (SEMBA_FDTD_ENABLE_MTLN) endif() endif() +add_subdirectory(external/VTKFortran) + if (SEMBA_FDTD_ENABLE_TEST) add_subdirectory(external/googletest/) add_subdirectory(test) diff --git a/external/VTKFortran b/external/VTKFortran new file mode 160000 index 00000000..1b3585cb --- /dev/null +++ b/external/VTKFortran @@ -0,0 +1 @@ +Subproject commit 1b3585cb4bf623d793ab79b030488abb268d7338 diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index 6eeeb227..d94ba2b6 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -7,5 +7,9 @@ add_library(fdtd-output "wireProbeOutput.F90" "bulkProbeOutput.F90" "volumicProbeOutput.F90" + "movieProbeOutput.F90" ) -target_link_libraries(fdtd-output semba-types ) \ No newline at end of file +target_link_libraries(fdtd-output + semba-types + VTKFortran::VTKFortran +) \ No newline at end of file diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index c0af1e99..26e17e44 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -16,8 +16,12 @@ module mod_movieProbeOutput !=========================== ! Private interface summary !=========================== - private :: get_measurements_count - + private :: get_measurements_coords + private :: save_current_data + private :: write_vtu_timestep + private :: create_pvd + private :: update_pvd + private :: close_pvd !=========================== contains @@ -34,13 +38,22 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, type(domain_t), intent(in) :: domain + if (domain%domainType /= TIME_DOMAIN) call StopOnError(0, 0, "Unexpected domain type for movie probe") + this%lowerBound = lowerBound this%upperBound = upperBound this%fieldComponent = field !This can refer to field or currentDensity this%domain = domain this%path = get_output_path() + call get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) - numberOfRequiredMeasures = get_measurements_count() + allocate (this%timeStep(BuffObse)) + allocate (this%xValueForTime(BuffObse, this%nMeasuredElements)) + allocate (this%yValueForTime(BuffObse, this%nMeasuredElements)) + allocate (this%zValueForTime(BuffObse, this%nMeasuredElements)) + this%xValueForTime = 0.0_RKIND + this%yValueForTime = 0.0_RKIND + this%zValueForTime = 0.0_RKIND contains function get_output_path() result(outputPath) @@ -55,29 +68,243 @@ end function get_output_path end subroutine init_movie_probe_output - subroutine update_movie_probe_output() + subroutine update_movie_probe_output(this, step, geometryMedia, registeredMedia, sinpml_fullsize, fieldsReference) + type(movie_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:) :: registeredMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + type(fields_reference_t), pointer, intent(in) :: fieldsReference + + this%serializedTimeSize = this%serializedTimeSize + 1 + select case (this%fieldComponent) + case (iCur) + call save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) + end select end subroutine update_movie_probe_output - subroutine flush_movie_probe_output() + subroutine flush_movie_probe_output(this) + type(movie_probe_output_t), intent(inout) :: this + integer :: status, i + + do i = 1, this%serializedTimeSize + call update_pvd(this, i, this%PDVUnit) + end do + call clear_memory_data() + + contains + subroutine clear_memory_data() + this%serializedTimeSize = 0 + this%timeStep = 0.0_RKIND + this%xValueForTime = 0.0_RKIND + this%yValueForTime = 0.0_RKIND + this%zValueForTime = 0.0_RKIND + end subroutine clear_memory_data end subroutine flush_movie_probe_output - function get_measurements_count(this) - type(movie_probe_output_t), intent(in) :: this + subroutine get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) + type(movie_probe_output_t), intent(inout) :: this + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:) :: registeredMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + + integer(kind=SINGLE) :: i, j, k, field + integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend + integer(kind=SINGLE) :: count + ! Limites de la región de interés + istart = this%lowerBound%x + jstart = this%lowerBound%y + kstart = this%lowerBound%z + + iend = this%upperBound%x + jend = this%upperBound%y + kend = this%upperBound%z + + ! Primer barrido para contar cuántos puntos válidos + count = 0 + select case (this%fieldComponent) + case (iCur) + do i = istart, iend + do j = jstart, jend + do k = kstart, kend + do field = iEx, iEz + if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then + if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then + count = count + 1 + end if + end if + end do + end do + end do + end do + end select + + this%nMeasuredElements = count + + allocate (this%coords(3, this%nMeasuredElements)) + + count = 0 + select case (this%fieldComponent) + case (iCur) + do i = istart, iend + do j = jstart, jend + do k = kstart, kend + do field = iEx, iEz + if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then + if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then + count = count + 1 + this%coords(:, count) = [i, j, k] + end if + end if + end do + end do + end do + end do + end select + + end subroutine get_measurements_coords + + subroutine save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) + type(movie_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + type(fields_reference_t), pointer, intent(in) :: fieldsReference + + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:) :: registeredMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + integer(kind=SINGLE) :: i, j, k, field + integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend integer(kind=SINGLE) :: n - + istart = this%lowerBound%x + jstart = this%lowerBound%y + kstart = this%lowerBound%z + + iend = this%upperBound%x + jend = this%upperBound%y + kend = this%upperBound%z - n = 0_SINGLE - do i = this%lowerBound%x, this%upperBound%x - do j = this%lowerBound%y, this%upperBound%y - do k = this%lowerBound%z, this%upperBound%z - if + n = 0 + do i = istart, iend + do j = jstart, jend + do k = kstart, kend + do field = iEx, iEz + if (isWithinBounds(field, i, j, k, SINPML_fullsize)) then + if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then + n = n + 1 + call save_current_component() + end if + end if + end do end do end do end do - end function + + if (n < this%nMeasuredElements) call StopOnError(0, 0, "Missing measurment to update at movie probe") + contains + + subroutine save_current_component() + real(kind=RKIND) :: jdir + jdir = computeJ(field, i, j, k, fieldsReference) + + this%timeStep(this%serializedTimeSize) = step + this%xValueForTime(this%serializedTimeSize, n) = merge(jdir, 0.0_RKIND, field == iEx) + this%yValueForTime(this%serializedTimeSize, n) = merge(jdir, 0.0_RKIND, field == iEy) + this%zValueForTime(this%serializedTimeSize, n) = merge(jdir, 0.0_RKIND, field == iEz) + end subroutine save_current_component + end subroutine save_current_data + + subroutine write_vtu_timestep(this, stepIndex, filename) + use vtk_fortran + implicit none + + type(movie_probe_output_t), intent(in) :: this + integer, intent(in) :: stepIndex + character(len=*), intent(in) :: filename + + type(vtk_file) :: vtkOutput + integer :: ierr, npts, i + real(kind=RKIND), allocatable :: x(:), y(:), z(:) + real(kind=RKIND), allocatable :: Jx(:), Jy(:), Jz(:) + + npts = this%nMeasuredElements + + allocate (x(npts), y(npts), z(npts)) + do i = 1, npts + x(i) = this%coords(1, i) + y(i) = this%coords(2, i) + z(i) = this%coords(3, i) + end do + + allocate (Jx(npts), Jy(npts), Jz(npts)) + do i = 1, npts + Jx(i) = this%xValueForTime(stepIndex, i) + Jy(i) = this%yValueForTime(stepIndex, i) + Jz(i) = this%zValueForTime(stepIndex, i) + end do + ierr = vtkOutput%initialize(format='ASCII', filename=trim(filename), mesh_topology='UnstructuredGrid') + ierr = vtkOutput%xml_writer%write_geo(n=npts, x=x, y=y, z=z) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name='float64_scalar', x=Jx) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name='float64_scalar', x=Jy) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name='float64_scalar', x=Jz) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + ierr = vtkOutput%xml_writer%finalize() + + end subroutine write_vtu_timestep + + subroutine create_pvd(this, unitPVD) + implicit none + type(movie_probe_output_t), intent(in) :: this + integer, intent(out) :: unitPVD + integer :: ios + + ! Abrimos el archivo PVD + open (newunit=unitPVD, file=trim(this%path)//".pvd", status='replace', action='write', iostat=ios) + if (ios /= 0) stop "Error al crear archivo PVD" + + ! Escribimos encabezados XML + write (unitPVD, *) '' + write (unitPVD, *) '' + write (unitPVD, *) ' ' + end subroutine create_pvd + + subroutine update_pvd(this, stepIndex, unitPVD) + implicit none + type(movie_probe_output_t), intent(in) :: this + integer, intent(in) :: stepIndex + integer, intent(in) :: unitPVD + character(len=64) :: ts + character(len=256) :: filename + + ! Generamos nombre del archivo VTU para este timestep + write (filename, '(A,I4.4,A)') trim(this%path), stepIndex, '.vtu' + + ! Escribimos el VTU correspondiente + call write_vtu_timestep(this, stepIndex, filename) + + ! Añadimos entrada en el PVD + write (ts, '(ES16.8)') this%timeStep(stepIndex) + write (unitPVD, '(A)') ' ' + end subroutine update_pvd + + subroutine close_pvd(unitPVD) + implicit none + integer, intent(in) :: unitPVD + + ! Cerramos colección y archivo XML + write (unitPVD, *) ' ' + write (unitPVD, *) '' + close (unitPVD) + end subroutine close_pvd end module mod_movieProbeOutput diff --git a/src_output/output.F90 b/src_output/output.F90 index 95cd1874..29772d91 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -7,6 +7,7 @@ module output use mod_wireProbeOutput use mod_bulkProbeOutput use mod_volumicProbeOutput + use mod_movieProbeOutput implicit none diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 09ea2af6..8779e66a 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -162,6 +162,7 @@ module outputTypes !!!!!Pending end type far_field_probe_output_t type movie_probe_output_t + integer(kind=SINGLE) :: PDVUnit integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components type(domain_t) :: domain type(cell_coordinate_t) :: lowerBound @@ -169,11 +170,14 @@ module outputTypes character(len=BUFSIZE) :: path integer(kind=SINGLE) :: fieldComponent + integer(kind=SINGLE), dimension(:,:), allocatable :: coords + !Intent storage order: !(:) == (timeinstance) => timeValue !(:,:) == (timeInstance, componentId) => escalar !Time Domain (requires first allocation) + integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE real(kind=RKIND_tiempo), dimension(:), allocatable :: timeStep real(kind=RKIND), dimension(:, :), allocatable :: xValueForTime From 7bb0ca6f2bcf27f3a5d12f23996b8d4a1a56a182 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 15 Dec 2025 12:14:06 +0100 Subject: [PATCH 30/67] Add movieProbe test structure --- src_output/output.F90 | 6 +- test/observation/observation_testingTools.F90 | 71 ------------------ test/output/output_tests.h | 2 + test/output/test_output.F90 | 74 ++++++++++++++++++- test/output/test_output_utils.F90 | 14 ++++ test/utils/fdetypes_tools.F90 | 18 ++--- 6 files changed, 98 insertions(+), 87 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index 29772d91..ff38a3f2 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -107,11 +107,11 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW allocate (outputs(sgg%NumberRequest)) - allocate (InvEps(1:sgg%NumMedia), InvMu(1:sgg%NumMedia)) + allocate (InvEps(0:sgg%NumMedia), InvMu(0:sgg%NumMedia)) outputCount = 0 - InvEps(1:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(1:sgg%NumMedia)%Epr) - InvMu(1:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(1:sgg%NumMedia)%Mur) + InvEps(0:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia)%Epr) + InvMu(0:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia)%Mur) do ii = 1, sgg%NumberRequest do i = 1, sgg%Observation(ii)%nP diff --git a/test/observation/observation_testingTools.F90 b/test/observation/observation_testingTools.F90 index 6304c049..c03ce913 100644 --- a/test/observation/observation_testingTools.F90 +++ b/test/observation/observation_testingTools.F90 @@ -133,20 +133,6 @@ logical function approx_equal(a, b, tol) result(equal) equal = abs(a - b) <= tol end function approx_equal - function create_time_array(array_size, interval) result(arr) - use FDETYPES - integer, intent(in) :: array_size - integer(kind=4) :: i - real(kind=RKIND_tiempo) :: interval - - real(kind=RKIND_tiempo), pointer, dimension(:) :: arr - allocate (arr(array_size)) - - DO i = 1, array_size - arr(i) = (i - 1)*interval - END DO - end function create_time_array - function create_limit_type() result(r) use FDETYPES type(limit_t) :: r @@ -167,63 +153,6 @@ function create_xyz_limit_array(XI,YI,ZI,XE,YE,ZE) result(arr) end do end function create_xyz_limit_array - - function create_facesNF2FF(tr, fr, iz, de, ab, ar) result(faces) - use FDETYPES - type(nf2ff_t) :: faces - logical :: tr, fr, iz, de, ab, ar - - faces%tr = tr - faces%fr = fr - faces%iz = iz - faces%de = de - faces%ab = ab - faces%ar = ar - end function create_facesNF2FF - - function create_control_flags(layoutnumber, size, mpidir, finaltimestep, & - nEntradaRoot, wiresflavor, & - resume, saveall, NF2FFDecim, simu_devia, singlefilewrite, & - facesNF2FF) result(control) - use FDETYPES - type(sim_control_t) :: control - integer(kind=4), intent(in) :: layoutnumber, size, mpidir, finaltimestep - character(len=*), intent(in) :: nEntradaRoot, wiresflavor - logical, intent(in) :: resume, saveall, NF2FFDecim, simu_devia, singlefilewrite - type(nf2ff_t), intent(in) :: facesNF2FF - - control%layoutnumber = layoutnumber - control%size = size - control%mpidir = mpidir - control%finaltimestep = finaltimestep - control%nEntradaRoot = nEntradaRoot - control%wiresflavor = wiresflavor - control%resume = resume - control%saveall = saveall - control%NF2FFDecim = NF2FFDecim - control%simu_devia = simu_devia - control%singlefilewrite = singlefilewrite - control%facesNF2FF = facesNF2FF - - end function create_control_flags - - function create_base_sgg() result(sgg) - use FDETYPES - type(SGGFDTDINFO) :: sgg - - sgg%NumMedia = 3 - allocate(sgg%Med(0:sgg%NumMedia)) - sgg%Med = create_basic_media() - sgg%NumberRequest = 1 - sgg%dt = 0.1_RKIND_tiempo - sgg%tiempo => create_time_array(100, sgg%dt) - sgg%Sweep = create_xyz_limit_array(0,0,0,6,6,6) - sgg%SINPMLSweep = create_xyz_limit_array(1,1,1,5,5,5) - sgg%NumPlaneWaves = 1 - sgg%alloc = create_xyz_limit_array(0,0,0,6,6,6) - - end function create_base_sgg - function create_basic_media () result(media) use FDETYPES type(MediaData_t) :: media diff --git a/test/output/output_tests.h b/test/output/output_tests.h index e4be4014..b22a9b76 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -5,6 +5,7 @@ extern "C" int test_update_point_probe(); extern "C" int test_flush_point_probe(); extern "C" int test_multiple_flush_point_probe(); extern "C" int test_volumic_probe_count_relevant_surfaces(); +extern "C" int test_init_movie_probe(); TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe()); } @@ -12,3 +13,4 @@ TEST(output, test_update_point_probe_info) {EXPECT_EQ(0, test_update_point_pr TEST(output, test_flush_point_probe_info) {EXPECT_EQ(0, test_flush_point_probe()); } TEST(output, test_flush_multiple_point_probe_info) {EXPECT_EQ(0, test_multiple_flush_point_probe()); } TEST(output, test_volumic_probe_counter_relevant_surfaces) {EXPECT_EQ(0, test_volumic_probe_count_relevant_surfaces()); } +TEST(output, test_init_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_init_movie_probe()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index a95030e5..1fdffb8a 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -112,7 +112,7 @@ integer function test_flush_point_probe() bind(c) result(err) test_err = 0 test_extension = 'tmp_cases/flush_point_probe' domain = domain_t(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) - + coordinates%x = 2 coordinates%y = 2 coordinates%z = 2 @@ -271,12 +271,12 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err sinpml_fullsizePtr => sinpml_fullsize simulationMaterials = create_base_simulation_material_list() - thinWireSimulationMaterial = create_thinWire_simulation_material(size(simulationMaterials) + 1) + thinWireSimulationMaterial = create_thinWire_simulation_material(size(simulationMaterials)) call add_simulation_material(simulationMaterials, thinWireSimulationMaterial) call init_default_media_matrix(media, 0, 8, 0, 8, 0, 8) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 1, 1, 1, simulationMaterials(2)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iHz, 1, 1, 1, simulationMaterials(3)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 1, 1, 1, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iHz, 1, 1, 1, simulationMaterials(2)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEx, 2, 2, 2, thinWireSimulationMaterial%Id) mediaPtr => media @@ -297,3 +297,69 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err err = test_err end function + +integer function test_init_movie_probe() bind(c) result(err) + use output + use mod_testOutputUtils + use FDETYPES_TOOLS + + type(SGGFDTDINFO) :: dummysgg + type(media_matrices_t), target :: media + type(limit_t), dimension(1:6), target :: sinpml_fullsize + type(sim_control_t) :: dummyControl + type(solver_output_t), dimension(:), allocatable :: outputs + logical :: ThereAreWires = .false. + + type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials + type(Obses_t) :: movieObservable + type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + + type(media_matrices_t), pointer :: mediaPtr + type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr + + integer(kind=SINGLE) :: mpidir = 3 + + err = 1 !If test_err is not updated at the end it will be shown + test_err = 0 + + lowerBoundMovieProbe%x = 2 + lowerBoundMovieProbe%y = 2 + lowerBoundMovieProbe%z = 2 + + upperBoundMovieProbe%x = 5 + upperBoundMovieProbe%y = 5 + upperBoundMovieProbe%z = 5 + + simulationMaterials = create_base_simulation_material_list() + + dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) + dummysgg%NumMedia = size(simulationMaterials) + dummysgg%med => simulationMaterials + + movieObservable = create_movie_observable(lowerBoundMovieProbe, upperBoundMovieProbe) + call add_observation_to_sgg(dummysgg, movieObservable) + + call init_default_media_matrix(media, 0, 8, 0, 8, 0, 8) + !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3,3,3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4,3,3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4,4,3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3,4,3, simulationMaterials(0)%Id) + !----- -------------------- -----! + mediaPtr => media + + do iter = 1, 6 + sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + end do + sinpml_fullsizePtr => sinpml_fullsize + + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, 4, 'Unexpected number of columns') + + if (size(outputs(1)%movieProbe%timeStep) /= BuffObse) then + test_err = 1 + end if + + err = test_err +end function diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index 66ab3e62..e842b3fe 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -1,6 +1,7 @@ module mod_testOutputUtils use FDETYPES use FDETYPES_TOOLS + use outputTypes implicit none type :: dummyFields_t @@ -36,6 +37,19 @@ function create_volumic_probe_observable() result(obs) call set_observable(obs, P, 'volumicProbe', domain, 'DummyFileNormalize') end function create_volumic_probe_observable + function create_movie_observable(lower, upper) result(obs) + type(cell_coordinate_t), intent(in) :: lower, upper + type(Obses_t) :: obs + + type(observable_t), dimension(:), allocatable :: P + type(observation_domain_t) :: domain + + call initialize_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) + allocate (P(1)) + P(1) = create_observable(lower%x, lower%y, lower%z, upper%x, upper%y, upper%z, iCur) + call set_observable(obs, P, 'movieProbe', domain, 'DummyFileNormalize') + end function create_movie_observable + subroutine create_dummy_fields(this, lower, upper, delta) class(dummyFields_t), intent(inout) :: this integer, intent(in) :: lower, upper diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index a421c8da..d6e8fd52 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -4,7 +4,7 @@ module FDETYPES_TOOLS implicit none real(kind=rkind) :: UTILEPS0 = 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 - real(kind=rkind) :: UTILMU0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 + real(kind=rkind) :: UTILMU0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 type :: observation_domain_t real(kind=RKIND) :: InitialTime = 0.0_RKIND real(kind=RKIND) :: FinalTime = 0.0_RKIND @@ -158,14 +158,14 @@ function create_base_sgg(dt, time_steps) result(sgg) end function create_base_sgg - function create_base_simulation_material_list() result(simulationMaterials) + function create_base_simulation_material_list() result(simulationMaterials) implicit none - - type(MediaData_t), dimension(3) :: simulationMaterials - + type(MediaData_t), dimension(:), allocatable :: simulationMaterials + if (allocated(simulationMaterials)) deallocate(simulationMaterials) + allocate(simulationMaterials(0:2)) + simulationMaterials(0) = create_pec_simulation_material() simulationMaterials(1) = get_default_mediadata() - simulationMaterials(2) = create_pec_simulation_material() - simulationMaterials(3) = create_pmc_simulation_material() + simulationMaterials(2) = create_pmc_simulation_material() end function create_base_simulation_material_list @@ -358,7 +358,7 @@ subroutine add_simulation_material(simulationMaterials, newSimulationMaterial) integer(kind=SINGLE) :: oldSize, newSize, istat oldSize = size(simulationMaterials) newSize = oldSize + 1 - allocate (tempSimulationMaterials(newSize), stat=istat) + allocate (tempSimulationMaterials(0:newSize), stat=istat) if (istat /= 0) then stop "Allocation failed for temporary media array." end if @@ -594,7 +594,7 @@ end function create_pec_material function create_pmc_material() result(mat) type(Material) :: mat - mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, SIGMA_PMC, 3) + mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, SIGMA_PMC, 0) end function create_pmc_material function create_empty_materials() result(mats) From b4895b833b316c0f3e5e41b64436a068147a037b Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 15 Dec 2025 14:46:27 +0100 Subject: [PATCH 31/67] Disable observation tests --- test/CMakeLists.txt | 4 ++-- test/observation/CMakeLists.txt | 40 ++++++++++++++++----------------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 36bd5c6e..14cd1575 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -26,8 +26,8 @@ if (SEMBA_FDTD_ENABLE_SMBJSON) add_subdirectory(output) set(OUPUT_TESTS_LIBRARY output_tests) if (NOT SEMBA_FDTD_ENABLE_MPI) - add_subdirectory(observation) - set(OBSERVATION_TESTS_LIBRARY observation_tests) + #add_subdirectory(observation) + #set(OBSERVATION_TESTS_LIBRARY observation_tests) endif() endif() diff --git a/test/observation/CMakeLists.txt b/test/observation/CMakeLists.txt index 9f54a0d8..6f157373 100644 --- a/test/observation/CMakeLists.txt +++ b/test/observation/CMakeLists.txt @@ -1,22 +1,22 @@ message(STATUS "Creating build system for test/observation") -add_library( - observation_test_fortran - "observation_testingTools.F90" - "test_observation.F90" - "test_preprocess.F90" - "test_observation_init.F90" - "test_observation_update.F90" -) - -target_link_libraries(observation_test_fortran - semba-outputs - test_utils_fortran -) - -add_library(observation_tests "observation_tests.cpp") - -target_link_libraries(observation_tests - observation_test_fortran - GTest::gtest -) \ No newline at end of file +#add_library( +# observation_test_fortran +# "observation_testingTools.F90" +# "test_observation.F90" +# "test_preprocess.F90" +# "test_observation_init.F90" +# "test_observation_update.F90" +#) +# +#target_link_libraries(observation_test_fortran +# semba-outputs +# test_utils_fortran +#) +# +#add_library(observation_tests "observation_tests.cpp") +# +#target_link_libraries(observation_tests +# observation_test_fortran +# GTest::gtest +#) \ No newline at end of file From 7dac3163419e35675a0e279153bfeb635efbb579 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 15 Dec 2025 16:46:55 +0100 Subject: [PATCH 32/67] Major cleanup for test utils --- src_main_pub/fdetypes.F90 | 4 +- src_output/CMakeLists.txt | 1 + src_output/movieProbeOutput.F90 | 1 + src_output/output.F90 | 20 +- src_output/wireProbeOutput.F90 | 4 +- test/observation/observation_testingTools.F90 | 5 - test/observation/observation_tests.h | 71 +-- test/observation/test_observation_update.F90 | 5 +- test/observation/test_preprocess.F90 | 14 +- test/output/test_output.F90 | 124 ++++-- test/output/test_output_utils.F90 | 178 ++------ test/utils/CMakeLists.txt | 2 + test/utils/assertion_tools.F90 | 120 +++++ test/utils/fdetypes_tools.F90 | 232 +++++----- test/utils/sgg_setters.F90 | 416 ++++++++++++++++++ 15 files changed, 854 insertions(+), 343 deletions(-) create mode 100644 test/utils/assertion_tools.F90 create mode 100644 test/utils/sgg_setters.F90 diff --git a/src_main_pub/fdetypes.F90 b/src_main_pub/fdetypes.F90 index afe3abd6..90495f54 100755 --- a/src_main_pub/fdetypes.F90 +++ b/src_main_pub/fdetypes.F90 @@ -6,7 +6,6 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! module FDETYPES - #ifdef CompileWithOpenMP use omp_lib #endif @@ -620,6 +619,7 @@ module FDETYPES logical :: thereArePMLMagneticMedia CHARACTER (LEN=BUFSIZE) :: nEntradaRoot type (coorsxyzP) :: Punto + end type type media_matrices_t @@ -846,6 +846,8 @@ logical function direction_eq(a,b) direction_eq = direction_eq .and. (a%orientation == b%orientation) end function + + end module FDETYPES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index d94ba2b6..a474f44f 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -11,5 +11,6 @@ add_library(fdtd-output ) target_link_libraries(fdtd-output semba-types + semba-components VTKFortran::VTKFortran ) \ No newline at end of file diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 26e17e44..b62655ca 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -1,5 +1,6 @@ module mod_movieProbeOutput use FDETYPES + use Report use outputTypes use mod_outputUtils implicit none diff --git a/src_output/output.F90 b/src_output/output.F90 index ff38a3f2..dad1eab6 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -15,7 +15,8 @@ module output WIRE_CURRENT_PROBE_ID = 1, & WIRE_CHARGE_PROBE_ID = 2, & BULK_PROBE_ID = 3, & - VOLUMIC_CURRENT_PROBE_ID = 4 + VOLUMIC_CURRENT_PROBE_ID = 4, & + MOVIE_PROBE_ID = 5 REAL(KIND=RKIND), save :: eps0, mu0 REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu @@ -45,7 +46,8 @@ module output init_wire_current_probe_output, & init_wire_charge_probe_output, & init_bulk_probe_output, & - init_volumic_probe_output + init_volumic_probe_output, & + init_movie_probe_output !init_far_field, & !initime_movie_output, & !init_frequency_slice_output @@ -107,11 +109,11 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW allocate (outputs(sgg%NumberRequest)) - allocate (InvEps(0:sgg%NumMedia), InvMu(0:sgg%NumMedia)) + allocate (InvEps(0:sgg%NumMedia - 1), InvMu(0:sgg%NumMedia - 1)) outputCount = 0 - InvEps(0:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia)%Epr) - InvMu(0:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia)%Mur) + InvEps(0:sgg%NumMedia - 1) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia - 1)%Epr) + InvMu(0:sgg%NumMedia - 1) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia - 1)%Mur) do ii = 1, sgg%NumberRequest do i = 1, sgg%Observation(ii)%nP @@ -159,13 +161,19 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW call init_solver_output(outputs(outputCount)%bulkCurrentProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control%mpidir) !! call adjust_computation_range --- Required due to issues in mpi region edges - case (iCur, iCurX, iCurY, iCurZ) + case (iCurX, iCurY, iCurZ) outputCount = outputCount + 1 outputs(outputCount)%outputID = VOLUMIC_CURRENT_PROBE_ID allocate (outputs(outputCount)%volumicCurrentProbe) call init_solver_output(outputs(outputCount)%volumicCurrentProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir, sgg%dt) + case (iCur) + outputCount = outputCount + 1 + outputs(outputCount)%outputID = MOVIE_PROBE_ID + + allocate (outputs(outputCount)%movieProbe) + call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, SINPML_fullsize, outputTypeExtension, control%mpidir) case default call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') end select diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index 1be14d3a..f5477737 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -20,7 +20,7 @@ module mod_wireProbeOutput !=========================== contains - subroutine init_wire_current_probe_output(this, coordinates, node, field, domain, media, outputTypeExtension, mpidir, wiresflavor) + subroutine init_wire_current_probe_output(this, coordinates, node, field, domain, media, outputTypeExtension, mpidir, wiresflavor) type(wire_current_probe_output_t), intent(out) :: this integer(kind=SINGLE), intent(in) :: node integer(kind=SINGLE), intent(in) :: field, mpidir @@ -183,7 +183,7 @@ end function get_probe_bounds_extension end subroutine init_wire_current_probe_output - subroutine init_wire_charge_probe_output(this, coordinates, node, field, domain, outputTypeExtension, mpidir, wiresflavor) + subroutine init_wire_charge_probe_output(this, coordinates, node, field, domain, outputTypeExtension, mpidir, wiresflavor) type(wire_charge_probe_output_t), intent(out) :: this integer(kind=SINGLE), intent(in) :: node integer(kind=SINGLE), intent(in) :: field, mpidir diff --git a/test/observation/observation_testingTools.F90 b/test/observation/observation_testingTools.F90 index c03ce913..7643477d 100644 --- a/test/observation/observation_testingTools.F90 +++ b/test/observation/observation_testingTools.F90 @@ -133,11 +133,6 @@ logical function approx_equal(a, b, tol) result(equal) equal = abs(a - b) <= tol end function approx_equal - function create_limit_type() result(r) - use FDETYPES - type(limit_t) :: r - end function - function create_xyz_limit_array(XI,YI,ZI,XE,YE,ZE) result(arr) use FDETYPES type(XYZlimit_t), dimension(1:6) :: arr diff --git a/test/observation/observation_tests.h b/test/observation/observation_tests.h index c3a1ebb3..09ec239e 100644 --- a/test/observation/observation_tests.h +++ b/test/observation/observation_tests.h @@ -1,36 +1,37 @@ #include - -extern "C" int test_allocate_serialize_for_time_domain(); -extern "C" int test_allocate_serialize_for_frequency_domain(); -extern "C" int test_allocate_current(); - -extern "C" int test_initial_time_less_than_timestep(); -extern "C" int test_timestep_greater_and_mapvtk(); -extern "C" int test_timestep_greater_not_mapvtk(); -extern "C" int test_freqstep_zero_or_large(); -extern "C" int test_volumic_false_true_and_saveall(); -extern "C" int test_saveall_branch(); -extern "C" int test_final_less_than_initial(); -extern "C" int test_huge_cap(); - -extern "C" int test_init_time_movie_observation(); - -extern "C" int test_update_time_movie_observation(); - -TEST(observation, test_allocate_time ) {EXPECT_EQ(0, test_allocate_serialize_for_time_domain()); } -TEST(observation, test_allocate_frequency ) {EXPECT_EQ(0, test_allocate_serialize_for_frequency_domain()); } -TEST(observation, test_allocate_serialize_current) {EXPECT_EQ(0, test_allocate_current()); } - -TEST(observation, test_preproces_initial_time_less_than_timestep) {EXPECT_EQ(0, test_initial_time_less_than_timestep()); } -TEST(observation, test_preproces_timestep_greater_and_mapvtk ) {EXPECT_EQ(0, test_timestep_greater_and_mapvtk()); } -TEST(observation, test_preproces_timestep_greater_not_mapvtk ) {EXPECT_EQ(0, test_timestep_greater_not_mapvtk()); } -TEST(observation, test_preproces_freqstep_zero_or_large ) {EXPECT_EQ(0, test_freqstep_zero_or_large()); } -TEST(observation, test_preproces_volumic_false_true_and_saveall ) {EXPECT_EQ(0, test_volumic_false_true_and_saveall()); } -TEST(observation, test_preproces_saveall_branch ) {EXPECT_EQ(0, test_saveall_branch()); } -TEST(observation, test_preproces_final_less_than_initial ) {EXPECT_EQ(0, test_final_less_than_initial()); } -TEST(observation, test_preproces_huge_cap ) {EXPECT_EQ(0, test_huge_cap()); } - -TEST(observation, test_init_movie_observation ) {EXPECT_EQ(0, test_init_time_movie_observation()); } - -TEST(observation, test_update_movie_observation ) {EXPECT_EQ(0, test_update_time_movie_observation()); } - +// +//extern "C" int test_allocate_serialize_for_time_domain(); +//extern "C" int test_allocate_serialize_for_frequency_domain(); +//extern "C" int test_allocate_current(); +// +//extern "C" int test_initial_time_less_than_timestep(); +//extern "C" int test_timestep_greater_and_mapvtk(); +//extern "C" int test_timestep_greater_not_mapvtk(); +//extern "C" int test_freqstep_zero_or_large(); +//extern "C" int test_volumic_false_true_and_saveall(); +//extern "C" int test_saveall_branch(); +//extern "C" int test_final_less_than_initial(); +//extern "C" int test_huge_cap(); +// +//extern "C" int test_init_time_movie_observation(); +// +//extern "C" int test_update_time_movie_observation(); +// +//TEST(observation, test_allocate_time ) {EXPECT_EQ(0, test_allocate_serialize_for_time_domain()); } +//TEST(observation, test_allocate_frequency ) {EXPECT_EQ(0, test_allocate_serialize_for_frequency_domain()); } +//TEST(observation, test_allocate_serialize_current) {EXPECT_EQ(0, test_allocate_current()); } +// +//TEST(observation, test_preproces_initial_time_less_than_timestep) {EXPECT_EQ(0, test_initial_time_less_than_timestep()); } +//TEST(observation, test_preproces_timestep_greater_and_mapvtk ) {EXPECT_EQ(0, test_timestep_greater_and_mapvtk()); } +//TEST(observation, test_preproces_timestep_greater_not_mapvtk ) {EXPECT_EQ(0, test_timestep_greater_not_mapvtk()); } +//TEST(observation, test_preproces_freqstep_zero_or_large ) {EXPECT_EQ(0, test_freqstep_zero_or_large()); } +//TEST(observation, test_preproces_volumic_false_true_and_saveall ) {EXPECT_EQ(0, test_volumic_false_true_and_saveall()); } +//TEST(observation, test_preproces_saveall_branch ) {EXPECT_EQ(0, test_saveall_branch()); } +//TEST(observation, test_preproces_final_less_than_initial ) {EXPECT_EQ(0, test_final_less_than_initial()); } +//TEST(observation, test_preproces_huge_cap ) {EXPECT_EQ(0, test_huge_cap()); } +// +//TEST(observation, test_init_movie_observation ) {EXPECT_EQ(0, test_init_time_movie_observation()); } +// +//TEST(observation, test_update_movie_observation ) {EXPECT_EQ(0, test_update_time_movie_observation()); } +// +// \ No newline at end of file diff --git a/test/observation/test_observation_update.F90 b/test/observation/test_observation_update.F90 index c974e63c..fc443f4b 100644 --- a/test/observation/test_observation_update.F90 +++ b/test/observation/test_observation_update.F90 @@ -3,6 +3,7 @@ integer function test_update_time_movie_observation() bind(C) result(err) use FDETYPES_TOOLS use Observa use observation_testingTools + use mod_sggMethods type(SGGFDTDINFO) :: sgg type(media_matrices_t) :: media @@ -21,10 +22,10 @@ integer function test_update_time_movie_observation() bind(C) result(err) type(output_t), pointer, dimension(:) :: output - sgg = create_base_sgg() + call sgg_init(sgg) call set_sgg_data(sgg) - media = create_media(sgg%Alloc) + media = create_geometry_media_from_sggAlloc(sgg%Alloc) tag_numbers = create_tag_list(sgg%Alloc) ThereAreObservation = .false. diff --git a/test/observation/test_preprocess.F90 b/test/observation/test_preprocess.F90 index 261a517f..db4c33cc 100644 --- a/test/observation/test_preprocess.F90 +++ b/test/observation/test_preprocess.F90 @@ -25,7 +25,7 @@ integer function test_initial_time_less_than_timestep() bind(C) result(err) finalTimeIndex = 20 dt = 0.1 - tiempo => create_time_array(100, dt) + call init_time_array(tiempo, 100, dt) saveall = .true. @@ -69,7 +69,7 @@ integer function test_timestep_greater_and_mapvtk() bind(C) result(err) finalTimeIndex = 90 dt = 0.1 - tiempo => create_time_array(100, dt) +call init_time_array(tiempo, 100, dt) saveall = .false. @@ -142,7 +142,7 @@ integer function test_freqstep_zero_or_large() bind(C) result(err) finalTimeIndex = 90 dt = 0.1_RKIND_tiempo - tiempo => create_time_array(100, dt) + call init_time_array(tiempo, 100, dt) saveall = .false. ! Case A: FreqStep = 0 -> should be set to FinalFreq-InitialFreq @@ -195,7 +195,7 @@ integer function test_volumic_false_true_and_saveall() bind(C) result(err) finalTimeIndex = 90 dt = 0.1_RKIND - tiempo => create_time_array(100, dt) + call init_time_array(tiempo, 100, dt) saveall = .false. ! Case Volumic = .false. and global saveall = .false. @@ -246,7 +246,7 @@ integer function test_saveall_branch() bind(C) result(err) finalTimeIndex = 90 dt = 0.1_RKIND - tiempo => create_time_array(100, dt) + call init_time_array(tiempo, 100, dt) saveall = .false. obs%Volumic = .false. @@ -285,7 +285,7 @@ integer function test_final_less_than_initial() bind(C) result(err) finalTimeIndex = 90 dt = 0.1_RKIND_tiempo - tiempo => create_time_array(100, dt) + call init_time_array(tiempo, 100, dt) saveall = .false. obs%Volumic = .false. @@ -323,7 +323,7 @@ integer function test_huge_cap() bind(C) result(err) finalTimeIndex = 90 dt = 0.1_RKIND - tiempo => create_time_array(100, dt) + call init_time_array(tiempo, 100, dt) huge4 = huge(1.0_4) saveall = .false. diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 1fdffb8a..f04539c4 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -3,10 +3,14 @@ integer function test_init_point_probe() bind(c) result(err) use FDETYPES_TOOLS use output use mod_testOutputUtils + use mod_sggMethods + use mod_assertionTools type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl type(media_matrices_t), pointer:: dummymedia => NULL() + type(MediaData_t), dimension(:), allocatable, target :: simulationMedia + type(MediaData_t), dimension(:), pointer :: simulationMediaPtr type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize => NULL() type(solver_output_t), dimension(:), allocatable :: outputs type(MediaData_t) :: defaultMaterial, pecMaterial @@ -14,16 +18,27 @@ integer function test_init_point_probe() bind(c) result(err) type(Obses_t) :: pointProbeObservable + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray + integer(kind=SINGLE) :: test_err = 0 !Cleanup if (allocated(outputs)) deallocate (outputs) !Set requested observables - dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) + call sgg_init(dummysgg) + call init_time_array(timeArray, nTimeSteps, dt) + call sgg_set_tiempo(dummysgg, timeArray) + call sgg_set_dt(dummysgg, dt) + + call init_simulation_material_list(simulationMedia) + simulationMediaPtr => simulationMedia + call sgg_set_Med(dummysgg, simulationMediaPtr) - pointProbeObservable = create_point_probe_observable() - call add_observation_to_sgg(dummysgg, pointProbeObservable) + pointProbeObservable = create_point_probe_observation(4, 4, 4) + call sgg_add_observation(dummysgg, pointProbeObservable) !Set control flags dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') @@ -44,10 +59,14 @@ integer function test_update_point_probe() bind(c) result(err) use FDETYPES_TOOLS use output use mod_testOutputUtils + use mod_sggMethods + use mod_assertionTools type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl type(media_matrices_t), pointer:: dummymedia => NULL() + type(MediaData_t), dimension(:), allocatable, target :: simulationMedia + type(MediaData_t), dimension(:), pointer :: simulationMediaPtr type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize => NULL() type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .false. @@ -56,13 +75,24 @@ integer function test_update_point_probe() bind(c) result(err) type(dummyFields_t), target :: dummyfields type(fields_reference_t) :: fields + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray + integer(kind=SINGLE) :: test_err = 0 - dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) - pointProbeObservable = create_point_probe_observable() - call add_observation_to_sgg(dummysgg, pointProbeObservable) + call sgg_init(dummysgg) + call init_time_array(timeArray, nTimeSteps, dt) + call sgg_set_tiempo(dummysgg, timeArray) + call sgg_set_dt(dummysgg, dt) + pointProbeObservable = create_point_probe_observation(4, 4, 4) + call sgg_add_observation(dummysgg, pointProbeObservable) dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') + call init_simulation_material_list(simulationMedia) + simulationMediaPtr => simulationMedia + call sgg_set_Med(dummysgg, simulationMediaPtr) + call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, outputs, ThereAreWires) call create_dummy_fields(dummyfields, 1, 10, 0.01) @@ -102,6 +132,7 @@ integer function test_flush_point_probe() bind(c) result(err) use output use mod_domain use mod_testOutputUtils + use mod_assertionTools type(point_probe_output_t) :: probe type(domain_t):: domain type(cell_coordinate_t) :: coordinates @@ -164,6 +195,7 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) use output use mod_domain use mod_testOutputUtils + use mod_assertionTools type(point_probe_output_t) :: probe type(domain_t):: domain type(cell_coordinate_t) :: coordinates @@ -246,11 +278,14 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err use output use mod_testOutputUtils use FDETYPES_TOOLS + use mod_sggMethods + use mod_assertionTools integer(kind=RKIND) :: iter type(media_matrices_t), target :: media type(media_matrices_t), pointer :: mediaPtr type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials + type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr type(limit_t), dimension(1:6), target :: sinpml_fullsize type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr type(Obses_t) :: volumicProbeObservable @@ -262,6 +297,21 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err character(len=BUFSIZE) :: test_extension = trim(adjustl('tmp_cases/flush_point_probe')) integer(kind=SINGLE) :: mpidir = 3 logical :: ThereAreWires = .false. + + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray + + integer(kind=SINGLE) :: test_err = 0 + + call sgg_init(dummysgg) + call init_time_array(timeArray, nTimeSteps, dt) + + call sgg_set_tiempo(dummysgg, timeArray) + call sgg_set_dt(dummysgg, dt) + + + err = 1 !If test_err is not updated at the end it will be shown test_err = 0 @@ -270,22 +320,22 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err end do sinpml_fullsizePtr => sinpml_fullsize - simulationMaterials = create_base_simulation_material_list() + call init_simulation_material_list(simulationMaterials) thinWireSimulationMaterial = create_thinWire_simulation_material(size(simulationMaterials)) call add_simulation_material(simulationMaterials, thinWireSimulationMaterial) - call init_default_media_matrix(media, 0, 8, 0, 8, 0, 8) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) call assing_material_id_to_media_matrix_coordinate(media, iEy, 1, 1, 1, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iHz, 1, 1, 1, simulationMaterials(2)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEx, 2, 2, 2, thinWireSimulationMaterial%Id) mediaPtr => media - dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) - dummysgg%NumMedia = size(simulationMaterials) - dummysgg%med => simulationMaterials + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + simulationMaterialsPtr => simulationMaterials + call sgg_set_Med(dummysgg, simulationMaterialsPtr) - volumicProbeObservable = create_volumic_probe_observable() - call add_observation_to_sgg(dummysgg, volumicProbeObservable) + volumicProbeObservable = create_volumic_probe_observation(4,4,4,6,6,6) + call sgg_add_observation(dummysgg, volumicProbeObservable) dummyControl = create_control_flags(mpidir=mpidir, nEntradaRoot='entradaRoot', wiresflavor='holland') @@ -302,6 +352,8 @@ integer function test_init_movie_probe() bind(c) result(err) use output use mod_testOutputUtils use FDETYPES_TOOLS + use mod_sggMethods + use mod_assertionTools type(SGGFDTDINFO) :: dummysgg type(media_matrices_t), target :: media @@ -311,12 +363,17 @@ integer function test_init_movie_probe() bind(c) result(err) logical :: ThereAreWires = .false. type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials + type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr type(Obses_t) :: movieObservable type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray type(media_matrices_t), pointer :: mediaPtr type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr + integer(kind=SINGLE) :: expectedNumMeasurments integer(kind=SINGLE) :: mpidir = 3 err = 1 !If test_err is not updated at the end it will be shown @@ -330,21 +387,33 @@ integer function test_init_movie_probe() bind(c) result(err) upperBoundMovieProbe%y = 5 upperBoundMovieProbe%z = 5 - simulationMaterials = create_base_simulation_material_list() + call sgg_init(dummysgg) + + call init_time_array(timeArray, nTimeSteps, dt) + call sgg_set_tiempo(dummysgg, timeArray) + call sgg_set_dt(dummysgg, dt) + + call init_simulation_material_list(simulationMaterials) + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + simulationMaterialsPtr => simulationMaterials + call sgg_set_Med(dummysgg, simulationMaterialsPtr) - dummysgg = create_base_sgg(dt=0.1_RKIND_tiempo, time_steps=100) - dummysgg%NumMedia = size(simulationMaterials) - dummysgg%med => simulationMaterials + movieObservable = create_movie_observation(2,2,2,5,5,5) + call sgg_add_observation(dummysgg, movieObservable) - movieObservable = create_movie_observable(lowerBoundMovieProbe, upperBoundMovieProbe) - call add_observation_to_sgg(dummysgg, movieObservable) + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) + call sgg_set_NumPlaneWaves(dummysgg, 1) + call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - call init_default_media_matrix(media, 0, 8, 0, 8, 0, 8) + + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) !----- Defining PEC surface -----! - call assing_material_id_to_media_matrix_coordinate(media, iEy, 3,3,3, simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 4,3,3, simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 4,4,3, simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 3,4,3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE !----- -------------------- -----! mediaPtr => media @@ -356,10 +425,11 @@ integer function test_init_movie_probe() bind(c) result(err) call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, 4, 'Unexpected number of columns') - - if (size(outputs(1)%movieProbe%timeStep) /= BuffObse) then + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nMeasuredElements, expectedNumMeasurments, 'Unexpected number of measurments') + test_err = test_err + assert_integer_equal(size(outputs(1)%movieProbe%xValueForTime), expectedNumMeasurments * BuffObse, 'Unexpected allocation size') + if (size(outputs(1)%movieProbe%timeStep) /= BuffObse) then test_err = 1 end if - + err = test_err end function diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index e842b3fe..d708de40 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -2,8 +2,26 @@ module mod_testOutputUtils use FDETYPES use FDETYPES_TOOLS use outputTypes - implicit none + private + + !=========================== + ! Public interface summary + !=========================== + public :: dummyFields_t + public :: create_point_probe_observation + public :: create_volumic_probe_observation + public :: create_movie_observation + public :: create_dummy_fields + !=========================== + + !=========================== + ! Private interface summary + !=========================== + + !=========================== + + type :: dummyFields_t real(kind=RKIND), allocatable, dimension(:, :, :) :: Ex, Ey, Ez, Hx, Hy, Hz real(kind=RKIND), allocatable, dimension(:) :: dxe, dye, dze, dxh, dyh, dzh @@ -11,44 +29,49 @@ module mod_testOutputUtils procedure, public :: createDummyFields => create_dummy_fields end type dummyFields_t contains - function create_point_probe_observable() result(obs) + function create_point_probe_observation(x, y, z) result(obs) + integer, intent(in) :: x, y, z type(Obses_t) :: obs type(observable_t), dimension(:), allocatable :: P type(observation_domain_t) :: domain - call initialize_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) allocate (P(1)) - P(1) = create_observable(4, 4, 4, 6, 6, 6, iEx) - call set_observable(obs, P, 'poinProbe', domain, 'DummyFileNormalize') - + P(1) = create_observable(x, y, z, x, y, z, iEx) + call initialize_observation_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) + + call set_observation(obs, P, 'poinProbe', domain, 'DummyFileNormalize') end function - - function create_volumic_probe_observable() result(obs) + + function create_volumic_probe_observation(xi, yi, zi, xe, ye, ze) result(obs) + integer, intent(in) :: xi, yi, zi, xe, ye, ze type(Obses_t) :: obs type(observable_t), dimension(:), allocatable :: P type(observation_domain_t) :: domain - call initialize_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) - call initialize_frequency_domain(domain, 0.0_RKIND, 1000.0_RKIND, 50.0_RKIND) allocate (P(1)) - P(1) = create_observable(4, 4, 4, 6, 6, 6, iCurX) - call set_observable(obs, P, 'volumicProbe', domain, 'DummyFileNormalize') - end function create_volumic_probe_observable + P(1) = create_observable(xi, yi, zi, xe, ye, ze, iCurX) - function create_movie_observable(lower, upper) result(obs) - type(cell_coordinate_t), intent(in) :: lower, upper - type(Obses_t) :: obs + call initialize_observation_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) + call initialize_observation_frequency_domain(domain, 0.0_RKIND, 1000.0_RKIND, 50.0_RKIND) + + call set_observation(obs, P, 'volumicProbe', domain, 'DummyFileNormalize') + end function create_volumic_probe_observation + + function create_movie_observation(xi, yi, zi, xe, ye, ze) result(observation) + integer, intent(in) :: xi, yi, zi, xe, ye, ze + type(Obses_t) :: observation type(observable_t), dimension(:), allocatable :: P type(observation_domain_t) :: domain - call initialize_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) allocate (P(1)) - P(1) = create_observable(lower%x, lower%y, lower%z, upper%x, upper%y, upper%z, iCur) - call set_observable(obs, P, 'movieProbe', domain, 'DummyFileNormalize') - end function create_movie_observable + P(1) = create_observable(xi, yi, zi, xe, ye, ze, iCur) + call initialize_observation_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) + + call set_observation(observation, P, 'movieProbe', domain, 'DummyFileNormalize') + end function create_movie_observation subroutine create_dummy_fields(this, lower, upper, delta) class(dummyFields_t), intent(inout) :: this @@ -86,119 +109,4 @@ subroutine create_dummy_fields(this, lower, upper, delta) this%dze = delta end subroutine create_dummy_fields - function assert_integer_equal(val, expected, errorMessage) result(err) - - integer, intent(in) :: val - integer, intent(in) :: expected - character(*), intent(in) :: errorMessage - integer :: err - - if (val == expected) then - err = 0 - else - err = 1 - print *, 'ASSERTION FAILED: ', trim(errorMessage) - print *, " Value: ", val, ". Expected: ", expected - end if - end function assert_integer_equal - - function assert_real_equal(val, expected, tolerance, errorMessage) result(err) - - real(kind=rkind), intent(in) :: val - real(kind=rkind), intent(in) :: expected - real(kind=rkind), intent(in) :: tolerance - character(*), intent(in) :: errorMessage - integer :: err - - if (abs(val - expected) <= tolerance) then - err = 0 - else - err = 1 - print *, 'ASSERTION FAILED: ', trim(errorMessage) - print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance - end if - end function assert_real_equal - - function assert_real_time_equal(val, expected, tolerance, errorMessage) result(err) - - real(kind=RKIND_tiempo), intent(in) :: val - real(kind=RKIND_tiempo), intent(in) :: expected - real(kind=RKIND_tiempo), intent(in) :: tolerance - character(*), intent(in) :: errorMessage - integer :: err - - if (abs(val - expected) <= tolerance) then - err = 0 - else - err = 1 - print *, 'ASSERTION FAILED: ', trim(errorMessage) - print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance - end if - end function assert_real_time_equal - - function assert_string_equal(val, expected, errorMessage) result(err) - - character(*), intent(in) :: val - character(*), intent(in) :: expected - character(*), intent(in) :: errorMessage - integer :: err - - if (trim(val) == trim(expected)) then - err = 0 - else - err = 1 - print *, 'ASSERTION FAILED: ', trim(errorMessage) - print *, ' Value: "', trim(val), '". Expected: "', trim(expected), '"' - end if - end function assert_string_equal - - integer function assert_written_output_file(filename) result(code) - implicit none - character(len=*), intent(in) :: filename - logical :: ex - integer :: filesize - - code = 0 - - inquire (file=filename, exist=ex, size=filesize) - - if (.not. ex) then - print *, "ERROR: Output file not created:", trim(filename) - code = 1 - else if (filesize <= 0) then - print *, "ERROR: Output file is empty:", trim(filename) - code = 2 - end if - end function assert_written_output_file - - integer function assert_file_content(unit, expectedValues, nRows, nCols, headers) result(flag) - implicit none - integer(kind=SINGLE), intent(in) :: unit - real(kind=RKIND), intent(in) :: expectedValues(:, :) - integer(kind=SINGLE), intent(in) :: nRows, nCols - character(len=*), intent(in), optional :: headers(:) - integer(kind=SINGLE) :: i, j, ios - real(kind=RKIND), dimension(nCols) :: val - character(len=BUFSIZE) :: line - flag = 0 - - if (present(headers)) then - read (unit, '(F12.6,1X,F12.6)', iostat=ios) line - if (ios /= 0) return - end if - - do i = 1, nRows - read (unit, *, iostat=ios) val - if (ios /= 0) then - flag = flag + 1 - return - end if - do j = 1, nCols - if (abs(val(j) - expectedValues(i, j)) > 1d-6) then - flag = flag + 1 - end if - end do - end do - end function assert_file_content - end module mod_testOutputUtils diff --git a/test/utils/CMakeLists.txt b/test/utils/CMakeLists.txt index ad087a19..35608666 100644 --- a/test/utils/CMakeLists.txt +++ b/test/utils/CMakeLists.txt @@ -3,6 +3,8 @@ message(STATUS "Creating build system for test/observation") add_library( test_utils_fortran "fdetypes_tools.F90" + "assertion_tools.F90" + "sgg_setters.F90" ) target_link_libraries(test_utils_fortran diff --git a/test/utils/assertion_tools.F90 b/test/utils/assertion_tools.F90 new file mode 100644 index 00000000..c920eae6 --- /dev/null +++ b/test/utils/assertion_tools.F90 @@ -0,0 +1,120 @@ +module mod_assertionTools + use FDETYPES + implicit none + +contains + function assert_integer_equal(val, expected, errorMessage) result(err) + + integer, intent(in) :: val + integer, intent(in) :: expected + character(*), intent(in) :: errorMessage + integer :: err + + if (val == expected) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, " Value: ", val, ". Expected: ", expected + end if + end function assert_integer_equal + + function assert_real_equal(val, expected, tolerance, errorMessage) result(err) + + real(kind=rkind), intent(in) :: val + real(kind=rkind), intent(in) :: expected + real(kind=rkind), intent(in) :: tolerance + character(*), intent(in) :: errorMessage + integer :: err + + if (abs(val - expected) <= tolerance) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance + end if + end function assert_real_equal + + function assert_real_time_equal(val, expected, tolerance, errorMessage) result(err) + + real(kind=RKIND_tiempo), intent(in) :: val + real(kind=RKIND_tiempo), intent(in) :: expected + real(kind=RKIND_tiempo), intent(in) :: tolerance + character(*), intent(in) :: errorMessage + integer :: err + + if (abs(val - expected) <= tolerance) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, " Value: ", val, ". Expected: ", expected, ". Tolerance: ", tolerance + end if + end function assert_real_time_equal + + function assert_string_equal(val, expected, errorMessage) result(err) + + character(*), intent(in) :: val + character(*), intent(in) :: expected + character(*), intent(in) :: errorMessage + integer :: err + + if (trim(val) == trim(expected)) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, ' Value: "', trim(val), '". Expected: "', trim(expected), '"' + end if + end function assert_string_equal + + integer function assert_written_output_file(filename) result(code) + implicit none + character(len=*), intent(in) :: filename + logical :: ex + integer :: filesize + + code = 0 + + inquire (file=filename, exist=ex, size=filesize) + + if (.not. ex) then + print *, "ERROR: Output file not created:", trim(filename) + code = 1 + else if (filesize <= 0) then + print *, "ERROR: Output file is empty:", trim(filename) + code = 2 + end if + end function assert_written_output_file + + integer function assert_file_content(unit, expectedValues, nRows, nCols, headers) result(flag) + implicit none + integer(kind=SINGLE), intent(in) :: unit + real(kind=RKIND), intent(in) :: expectedValues(:, :) + integer(kind=SINGLE), intent(in) :: nRows, nCols + character(len=*), intent(in), optional :: headers(:) + integer(kind=SINGLE) :: i, j, ios + real(kind=RKIND), dimension(nCols) :: val + character(len=BUFSIZE) :: line + flag = 0 + + if (present(headers)) then + read (unit, '(F12.6,1X,F12.6)', iostat=ios) line + if (ios /= 0) return + end if + + do i = 1, nRows + read (unit, *, iostat=ios) val + if (ios /= 0) then + flag = flag + 1 + return + end if + do j = 1, nCols + if (abs(val(j) - expectedValues(i, j)) > 1d-6) then + flag = flag + 1 + end if + end do + end do + end function assert_file_content +end module mod_assertionTools \ No newline at end of file diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index d6e8fd52..4abf9627 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -1,8 +1,42 @@ module FDETYPES_TOOLS use FDETYPES use NFDETypes - implicit none + private + + !=========================== + ! Public interface summary + !=========================== + public :: observation_domain_t + public :: initialize_observation_domain_logical_flags + public :: initialize_observation_time_domain + public :: initialize_observation_frequency_domain + public :: initialize_observation_phi_domain + public :: initialize_observation_theta_domain + public :: create_observable + public :: set_observation + public :: init_time_array + public :: create_limit_t + public :: create_xyzlimit_t + public :: create_xyz_limit_array + public :: create_tag_list + public :: create_geometry_media + public :: create_geometry_media_from_sggAlloc + public :: create_thinWire_simulation_material + public :: init_simulation_material_list + public :: create_facesNF2FF + public :: create_control_flags + public :: add_simulation_material + public :: assing_material_id_to_media_matrix_coordinate + !=========================== + + !=========================== + ! Private interface summary + !=========================== + + !=========================== + + real(kind=rkind) :: UTILEPS0 = 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 real(kind=rkind) :: UTILMU0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 type :: observation_domain_t @@ -30,6 +64,18 @@ module FDETYPES_TOOLS end type observation_domain_t contains + + function create_xyzlimit_t(XI, XE, YI, YE, ZI, ZE) result(r) + type(limit_t) :: r + integer(kind=4), intent(in) :: XI, XE, YI, YE, ZI, ZE + r%XI = XI + r%XE = XE + r%YI = YI + r%YE = YE + r%ZI = ZI + r%ZE = ZE + end function create_xyzlimit_t + function create_limit_t(XI, XE, YI, YE, ZI, ZE, NX, NY, NZ) result(r) type(limit_t) :: r integer(kind=4), intent(in) :: XI, XE, YI, YE, ZI, ZE, NX, NY, NZ @@ -63,7 +109,31 @@ function create_tag_list(sggAlloc) result(r) r%face%z(:, :, :) = 0 end function create_tag_list - function create_media(sggAlloc) result(r) + subroutine create_geometry_media(res, xi, xe, yi, ye, zi, ze) + integer(kind=SINGLE) :: xi, yi, zi, xe, ye, ze + type(media_matrices_t), intent(inout) :: res + + allocate (res%sggMtag(xi:xe, yi:ye, zi:ze)) + + allocate (res%sggMiNo(xi:xe, yi:ye, zi:ze)) + allocate (res%sggMiEx(xi:xe, yi:ye, zi:ze)) + allocate (res%sggMiEy(xi:xe, yi:ye, zi:ze)) + allocate (res%sggMiEz(xi:xe, yi:ye, zi:ze)) + allocate (res%sggMiHx(xi:xe, yi:ye, zi:ze)) + allocate (res%sggMiHy(xi:xe, yi:ye, zi:ze)) + allocate (res%sggMiHz(xi:xe, yi:ye, zi:ze)) + + res%sggMtag = 1_SINGLE + res%sggMiNo = 1_SINGLE + res%sggMiEx = 1_SINGLE + res%sggMiEy = 1_SINGLE + res%sggMiEz = 1_SINGLE + res%sggMiHx = 1_SINGLE + res%sggMiHy = 1_SINGLE + res%sggMiHz = 1_SINGLE + end subroutine create_geometry_media + + function create_geometry_media_from_sggAlloc(sggAlloc) result(r) type(XYZlimit_t), dimension(6), intent(in) :: sggAlloc type(media_matrices_t) :: r @@ -78,7 +148,7 @@ function create_media(sggAlloc) result(r) allocate (r%sggMiHy(sggAlloc(iHy)%XI:sggAlloc(iHy)%XE, sggAlloc(iHy)%YI:sggAlloc(iHy)%YE, sggAlloc(iHy)%ZI:sggAlloc(iHy)%ZE)) allocate (r%sggMiHz(sggAlloc(iHz)%XI:sggAlloc(iHz)%XE, sggAlloc(iHz)%YI:sggAlloc(iHz)%YE, sggAlloc(iHz)%ZI:sggAlloc(iHz)%ZE)) - r%sggMtag(:, :, :) = 0 + r%sggMtag(:, :, :) = 1 r%sggMiNo(:, :, :) = 1 r%sggMiEx(:, :, :) = 1 r%sggMiEy(:, :, :) = 1 @@ -86,7 +156,7 @@ function create_media(sggAlloc) result(r) r%sggMiHx(:, :, :) = 1 r%sggMiHy(:, :, :) = 1 r%sggMiHz(:, :, :) = 1 - end function create_media + end function create_geometry_media_from_sggAlloc function create_control_flags(layoutnumber, size, mpidir, finaltimestep, & nEntradaRoot, wiresflavor, wirecrank, & @@ -132,50 +202,24 @@ function create_control_flags(layoutnumber, size, mpidir, finaltimestep, & end function create_control_flags - function create_base_sgg(dt, time_steps) result(sgg) - implicit none - type(SGGFDTDINFO) :: sgg - type(MediaData_t), dimension(:), allocatable, target :: media - integer, optional, intent(in) :: time_steps - real(kind=RKIND_tiempo), optional, intent(in) :: dt - - integer(kind=SINGLE) :: nTimes - - media = create_base_simulation_material_list() - sgg%NumMedia = 3 - sgg%med => media - - sgg%dt = merge(dt, 0.1_RKIND_tiempo, present(dt)) - - nTimes = merge(time_steps, 100, present(time_steps)) - allocate (sgg%tiempo(nTimes)) - sgg%tiempo = create_time_array(nTimes, sgg%dt) - - sgg%Sweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) - sgg%SINPMLSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) - sgg%NumPlaneWaves = 1 - sgg%alloc = create_xyz_limit_array(0, 0, 0, 6, 6, 6) - - end function create_base_sgg - - function create_base_simulation_material_list() result(simulationMaterials) + subroutine init_simulation_material_list(simulationMaterials) implicit none - type(MediaData_t), dimension(:), allocatable :: simulationMaterials - if (allocated(simulationMaterials)) deallocate(simulationMaterials) - allocate(simulationMaterials(0:2)) + type(MediaData_t), dimension(:), allocatable, intent(out) :: simulationMaterials + if (allocated(simulationMaterials)) deallocate (simulationMaterials) + allocate (simulationMaterials(0:2)) simulationMaterials(0) = create_pec_simulation_material() simulationMaterials(1) = get_default_mediadata() simulationMaterials(2) = create_pmc_simulation_material() - end function create_base_simulation_material_list + end subroutine init_simulation_material_list - function create_time_array(array_size, interval) result(arr) + subroutine init_time_array(arr, array_size, interval) integer, intent(in), optional :: array_size real(kind=RKIND_tiempo), intent(in), optional :: interval integer(kind=4) :: i integer :: size_val real(kind=RKIND_tiempo) :: interval_val - real(kind=RKIND_tiempo), pointer, dimension(:) :: arr + real(kind=RKIND_tiempo), pointer, dimension(:), intent(out) :: arr size_val = merge(array_size, 100, present(array_size)) interval_val = merge(interval, 1.0_RKIND_tiempo, present(interval)) @@ -185,11 +229,7 @@ function create_time_array(array_size, interval) result(arr) DO i = 1, size_val arr(i) = (i - 1)*interval_val END DO - end function create_time_array - - function create_limit_type() result(r) - type(limit_t) :: r - end function create_limit_type + end subroutine init_time_array function create_xyz_limit_array(XI, YI, ZI, XE, YE, ZE) result(arr) type(XYZlimit_t), dimension(1:6) :: arr @@ -352,22 +392,21 @@ end function create_observable subroutine add_simulation_material(simulationMaterials, newSimulationMaterial) type(MediaData_t), dimension(:), intent(inout), allocatable :: simulationMaterials - type(MediaData_t), intent(in) :: newSimulationMaterial + type(MediaData_t), intent(in) :: newSimulationMaterial type(MediaData_t), dimension(:), target, allocatable :: tempSimulationMaterials - integer(kind=SINGLE) :: oldSize, newSize, istat + integer(kind=SINGLE) :: oldSize, istat oldSize = size(simulationMaterials) - newSize = oldSize + 1 - allocate (tempSimulationMaterials(0:newSize), stat=istat) + allocate (tempSimulationMaterials(0:oldSize), stat=istat) if (istat /= 0) then stop "Allocation failed for temporary media array." end if - + if (oldSize > 0) then - tempSimulationMaterials(1:oldSize) = simulationMaterials + tempSimulationMaterials(0:oldSize - 1) = simulationMaterials deallocate (simulationMaterials) end if - tempSimulationMaterials(newSize) = newSimulationMaterial + tempSimulationMaterials(oldSize) = newSimulationMaterial simulationMaterials = tempSimulationMaterials end subroutine add_simulation_material @@ -402,42 +441,16 @@ subroutine add_media_data_to_sgg(sgg, mediaData) end subroutine add_media_data_to_sgg - subroutine init_default_media_matrix(res, xi, xe, yi, ye, zi, ze) - integer(kind=SINGLE) :: xi, yi, zi, xe, ye, ze - type(media_matrices_t), intent(inout) :: res - - allocate(res%sggMtag(xi:xe, yi:ye, zi:ze)) - - allocate(res%sggMiNo(xi:xe, yi:ye, zi:ze)) - allocate(res%sggMiEx(xi:xe, yi:ye, zi:ze)) - allocate(res%sggMiEy(xi:xe, yi:ye, zi:ze)) - allocate(res%sggMiEz(xi:xe, yi:ye, zi:ze)) - allocate(res%sggMiHx(xi:xe, yi:ye, zi:ze)) - allocate(res%sggMiHy(xi:xe, yi:ye, zi:ze)) - allocate(res%sggMiHz(xi:xe, yi:ye, zi:ze)) - - - res%sggMtag = 0_SINGLE - - res%sggMiNo = 0.0_RKIND - res%sggMiEx = 0.0_RKIND - res%sggMiEy = 0.0_RKIND - res%sggMiEz = 0.0_RKIND - res%sggMiHx = 0.0_RKIND - res%sggMiHy = 0.0_RKIND - res%sggMiHz = 0.0_RKIND - end subroutine init_default_media_matrix - subroutine assing_material_id_to_media_matrix_coordinate(media, fieldComponent, i, j, k, materialId) type(media_matrices_t), intent(inout) :: media integer(kind=SINGLE), intent(in) :: fieldComponent, i, j, k, materialId - selectcase(fieldComponent) - case(iEx); media%sggMiEx(i,j,k) = materialId - case(iEy); media%sggMiEy(i,j,k) = materialId - case(iEz); media%sggMiEz(i,j,k) = materialId - case(iHx); media%sggMiHx(i,j,k) = materialId - case(iHy); media%sggMiHy(i,j,k) = materialId - case(iHz); media%sggMiHz(i,j,k) = materialId + selectcase (fieldComponent) + case (iEx); media%sggMiEx(i, j, k) = materialId + case (iEy); media%sggMiEy(i, j, k) = materialId + case (iEz); media%sggMiEz(i, j, k) = materialId + case (iHx); media%sggMiHx(i, j, k) = materialId + case (iHy); media%sggMiHy(i, j, k) = materialId + case (iHz); media%sggMiHz(i, j, k) = materialId end select end subroutine assing_material_id_to_media_matrix_coordinate @@ -589,12 +602,12 @@ end function create_vacuum_material function create_pec_material() result(mat) type(Material) :: mat - mat = create_material(EPSILON_VACUUM, MU_VACUUM, SIGMA_PEC, 0.0, 2) + mat = create_material(EPSILON_VACUUM, MU_VACUUM, SIGMA_PEC, 0.0, 0) end function create_pec_material function create_pmc_material() result(mat) type(Material) :: mat - mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, SIGMA_PMC, 0) + mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, SIGMA_PMC, 2) end function create_pmc_material function create_empty_materials() result(mats) @@ -693,34 +706,7 @@ function get_default_wire() result(wire) wire%RightEnd = 0 end function get_default_wire - subroutine add_observation_to_sgg(sgg, new_observation) - implicit none - - type(SGGFDTDINFO), intent(inout) :: sgg - type(Obses_t), intent(in), target :: new_observation - - type(Obses_t), dimension(:), pointer :: temp_obs - integer :: old_size, new_size - - old_size = sgg%NumberRequest - new_size = old_size + 1 - - allocate (temp_obs(1:new_size)) - - if (old_size > 0) then - temp_obs(1:old_size) = sgg%Observation(1:old_size) - deallocate (sgg%Observation) - end if - - temp_obs(new_size) = new_observation - - sgg%Observation => temp_obs - - sgg%NumberRequest = new_size - - end subroutine add_observation_to_sgg - - subroutine set_observable(obs, P_in, outputrequest_in, domain_params, FileNormalize_in) + subroutine set_observation(obs, P_in, outputrequest_in, domain_params, FileNormalize_in) implicit none type(observable_t), dimension(:), intent(in) :: P_in @@ -762,9 +748,9 @@ subroutine set_observable(obs, P_in, outputrequest_in, domain_params, FileNormal obs%TransFer = domain_params%TransFer obs%Volumic = domain_params%Volumic - end subroutine set_observable + end subroutine set_observation - subroutine initialize_time_domain(domain, InitialTime, FinalTime, TimeStep) + subroutine initialize_observation_time_domain(domain, InitialTime, FinalTime, TimeStep) implicit none type(observation_domain_t), intent(inout) :: domain @@ -776,9 +762,9 @@ subroutine initialize_time_domain(domain, InitialTime, FinalTime, TimeStep) domain%TimeDomain = .true. - end subroutine initialize_time_domain + end subroutine initialize_observation_time_domain - subroutine initialize_frequency_domain(domain, InitialFreq, FinalFreq, FreqStep) + subroutine initialize_observation_frequency_domain(domain, InitialFreq, FinalFreq, FreqStep) implicit none type(observation_domain_t), intent(inout) :: domain @@ -790,9 +776,9 @@ subroutine initialize_frequency_domain(domain, InitialFreq, FinalFreq, FreqStep) domain%FreqDomain = .true. - end subroutine initialize_frequency_domain + end subroutine initialize_observation_frequency_domain - subroutine initialize_theta_domain(domain, thetaStart, thetaStop, thetaStep) + subroutine initialize_observation_theta_domain(domain, thetaStart, thetaStop, thetaStep) implicit none type(observation_domain_t), intent(inout) :: domain @@ -802,9 +788,9 @@ subroutine initialize_theta_domain(domain, thetaStart, thetaStop, thetaStep) domain%thetaStop = thetaStop domain%thetaStep = thetaStep - end subroutine initialize_theta_domain + end subroutine initialize_observation_theta_domain - subroutine initialize_phi_domain(domain, phiStart, phiStop, phiStep) + subroutine initialize_observation_phi_domain(domain, phiStart, phiStop, phiStep) implicit none type(observation_domain_t), intent(inout) :: domain @@ -814,9 +800,9 @@ subroutine initialize_phi_domain(domain, phiStart, phiStop, phiStep) domain%phiStop = phiStop domain%phiStep = phiStep - end subroutine initialize_phi_domain + end subroutine initialize_observation_phi_domain - subroutine initialize_domain_logical_flags(domain, Saveall_flag, TransFer_flag, Volumic_flag) + subroutine initialize_observation_domain_logical_flags(domain, Saveall_flag, TransFer_flag, Volumic_flag) implicit none type(observation_domain_t), intent(inout) :: domain @@ -826,6 +812,6 @@ subroutine initialize_domain_logical_flags(domain, Saveall_flag, TransFer_flag, domain%TransFer = TransFer_flag domain%Volumic = Volumic_flag - end subroutine initialize_domain_logical_flags + end subroutine initialize_observation_domain_logical_flags end module FDETYPES_TOOLS diff --git a/test/utils/sgg_setters.F90 b/test/utils/sgg_setters.F90 new file mode 100644 index 00000000..8e424884 --- /dev/null +++ b/test/utils/sgg_setters.F90 @@ -0,0 +1,416 @@ +module mod_sggMethods + use FDETYPES + implicit none + private + + + public :: sgg_init + + public :: sgg_set_tiempo + public :: sgg_set_dt + public :: sgg_set_extraswitches + + public :: sgg_set_NumMedia + public :: sgg_set_AllocMed + public :: sgg_set_IniPMLMedia + public :: sgg_set_EndPMLMedia + + public :: sgg_set_NumPlaneWaves + public :: sgg_set_TimeSteps + public :: sgg_set_InitialTimeStep + + public :: sgg_set_NumNodalSources + public :: sgg_set_NumberRequest + + public :: sgg_set_LineX + public :: sgg_set_LineY + public :: sgg_set_LineZ + public :: sgg_set_DX + public :: sgg_set_DY + public :: sgg_set_DZ + + public :: sgg_set_AllocDxI + public :: sgg_set_AllocDyI + public :: sgg_set_AllocDzI + public :: sgg_set_AllocDxE + public :: sgg_set_AllocDyE + public :: sgg_set_AllocDzE + + public :: sgg_set_PlaneWave + public :: sgg_set_Border + public :: sgg_set_PML + public :: sgg_set_Eshared + public :: sgg_set_Hshared + + public :: sgg_set_Alloc + public :: sgg_set_Sweep + public :: sgg_set_SINPMLSweep + + public :: sgg_set_Med + public :: sgg_set_NodalSource + public :: sgg_set_Observation + + public :: sgg_set_thereAreMagneticMedia + public :: sgg_set_thereArePMLMagneticMedia + + public :: sgg_set_nEntradaRoot + public :: sgg_set_Punto + + public :: sgg_add_observation +contains + subroutine sgg_init(obj, & + tiempo, dt, extraswitches, & + NumMedia, AllocMed, & + IniPMLMedia, EndPMLMedia, & + NumPlaneWaves, TimeSteps, InitialTimeStep, & + NumNodalSources, NumberRequest, & + thereAreMagneticMedia, thereArePMLMagneticMedia, & + nEntradaRoot) + + implicit none + + type(SGGFDTDINFO), intent(inout) :: obj + + ! ===== Optional arguments ===== + real(kind=RKIND_tiempo), pointer, optional :: tiempo(:) + real(kind=RKIND_tiempo), optional :: dt + character(len=*), optional :: extraswitches + + integer(kind=SINGLE), optional :: NumMedia, AllocMed + integer(kind=SINGLE), optional :: IniPMLMedia, EndPMLMedia + integer(kind=SINGLE), optional :: NumPlaneWaves, TimeSteps, InitialTimeStep + integer(kind=SINGLE), optional :: NumNodalSources, NumberRequest + + logical, optional :: thereAreMagneticMedia + logical, optional :: thereArePMLMagneticMedia + + character(len=*), optional :: nEntradaRoot + + ! ===== Defaults ===== + + nullify (obj%tiempo) + obj%dt = 0.0_RKIND_tiempo + obj%extraswitches = "" + + obj%NumMedia = 0_SINGLE + obj%AllocMed = 0_SINGLE + obj%IniPMLMedia = 0_SINGLE + obj%EndPMLMedia = 0_SINGLE + obj%NumPlaneWaves = 0_SINGLE + obj%TimeSteps = 0_SINGLE + obj%InitialTimeStep = 0_SINGLE + obj%NumNodalSources = 0_SINGLE + obj%NumberRequest = 0_SINGLE + + nullify (obj%LineX, obj%LineY, obj%LineZ) + nullify (obj%DX, obj%DY, obj%DZ) + + obj%AllocDxI = 0_SINGLE + obj%AllocDyI = 0_SINGLE + obj%AllocDzI = 0_SINGLE + obj%AllocDxE = 0_SINGLE + obj%AllocDyE = 0_SINGLE + obj%AllocDzE = 0_SINGLE + + nullify (obj%PlaneWave) + nullify (obj%Med) + nullify (obj%NodalSource) + nullify (obj%Observation) + + obj%thereAreMagneticMedia = .false. + obj%thereArePMLMagneticMedia = .false. + + obj%nEntradaRoot = "" + + ! NOTE: + ! Derived-type components (Border, PML, Shared_t, XYZlimit_t, Punto) + ! are automatically default-initialized if they define their own defaults. + + ! ===== Overrides from arguments ===== + + if (present(tiempo)) obj%tiempo => tiempo + if (present(dt)) obj%dt = dt + if (present(extraswitches)) obj%extraswitches = extraswitches + + if (present(NumMedia)) obj%NumMedia = NumMedia + if (present(AllocMed)) obj%AllocMed = AllocMed + if (present(IniPMLMedia)) obj%IniPMLMedia = IniPMLMedia + if (present(EndPMLMedia)) obj%EndPMLMedia = EndPMLMedia + if (present(NumPlaneWaves)) obj%NumPlaneWaves = NumPlaneWaves + if (present(TimeSteps)) obj%TimeSteps = TimeSteps + if (present(InitialTimeStep)) obj%InitialTimeStep = InitialTimeStep + if (present(NumNodalSources)) obj%NumNodalSources = NumNodalSources + if (present(NumberRequest)) obj%NumberRequest = NumberRequest + + if (present(thereAreMagneticMedia)) & + obj%thereAreMagneticMedia = thereAreMagneticMedia + + if (present(thereArePMLMagneticMedia)) & + obj%thereArePMLMagneticMedia = thereArePMLMagneticMedia + + if (present(nEntradaRoot)) obj%nEntradaRoot = nEntradaRoot + + end subroutine sgg_init + + subroutine sgg_set_tiempo(sgg, tiempo) + type(SGGFDTDINFO), intent(inout) :: sgg + real(kind=RKIND_tiempo), pointer :: tiempo(:) + sgg%tiempo => tiempo + end subroutine + + subroutine sgg_set_dt(sgg, dt) + type(SGGFDTDINFO), intent(inout) :: sgg + real(kind=RKIND_tiempo), intent(in) :: dt + sgg%dt = dt + end subroutine + + subroutine sgg_set_extraswitches(sgg, extraswitches) + type(SGGFDTDINFO), intent(inout) :: sgg + character(len=*), intent(in) :: extraswitches + sgg%extraswitches = extraswitches + end subroutine + + subroutine sgg_set_NumMedia(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%NumMedia = newValue + end subroutine + + subroutine sgg_set_AllocMed(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%AllocMed = newValue + end subroutine + + subroutine sgg_set_IniPMLMedia(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%IniPMLMedia = newValue + end subroutine + + subroutine sgg_set_EndPMLMedia(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%EndPMLMedia = newValue + end subroutine + + subroutine sgg_set_NumPlaneWaves(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%NumPlaneWaves = newValue + end subroutine + + subroutine sgg_set_TimeSteps(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%TimeSteps = newValue + end subroutine + + subroutine sgg_set_InitialTimeStep(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%InitialTimeStep = newValue + end subroutine + + subroutine sgg_set_NumNodalSources(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%NumNodalSources = newValue + end subroutine + + subroutine sgg_set_NumberRequest(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%NumberRequest = newValue + end subroutine + + subroutine sgg_set_LineX(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + real(kind=RKIND), pointer :: newValue(:) + sgg%LineX => newValue + end subroutine + + subroutine sgg_set_LineY(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + real(kind=RKIND), pointer :: newValue(:) + sgg%LineY => newValue + end subroutine + + subroutine sgg_set_LineZ(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + real(kind=RKIND), pointer :: newValue(:) + sgg%LineZ => newValue + end subroutine + + subroutine sgg_set_DX(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + real(kind=RKIND), pointer :: newValue(:) + sgg%DX => newValue + end subroutine + + subroutine sgg_set_DY(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + real(kind=RKIND), pointer :: newValue(:) + sgg%DY => newValue + end subroutine + + subroutine sgg_set_DZ(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + real(kind=RKIND), pointer :: newValue(:) + sgg%DZ => newValue + end subroutine + + subroutine sgg_set_AllocDxI(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%AllocDxI = newValue + end subroutine + + subroutine sgg_set_AllocDyI(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%AllocDyI = newValue + end subroutine + + subroutine sgg_set_AllocDzI(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%AllocDzI = newValue + end subroutine + + subroutine sgg_set_AllocDxE(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%AllocDxE = newValue + end subroutine + + subroutine sgg_set_AllocDyE(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%AllocDyE = newValue + end subroutine + + subroutine sgg_set_AllocDzE(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + integer(kind=SINGLE), intent(in) :: newValue + sgg%AllocDzE = newValue + end subroutine + + subroutine sgg_set_PlaneWave(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(planeonde_t), pointer :: newValue(:) + sgg%PlaneWave => newValue + end subroutine + + subroutine sgg_set_Med(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(MediaData_t), pointer :: newValue(:) + sgg%Med => newValue + end subroutine + + subroutine sgg_set_NodalSource(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(NodalSource_t), pointer :: newValue(:) + sgg%NodalSource => newValue + end subroutine + + subroutine sgg_set_Observation(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(obses_t), pointer :: newValue(:) + sgg%Observation => newValue + end subroutine + + subroutine sgg_set_Border(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(Border_t), intent(in) :: newValue + sgg%Border = newValue + end subroutine + + subroutine sgg_set_PML(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(PML_t), intent(in) :: newValue + sgg%PML = newValue + end subroutine + + subroutine sgg_set_Eshared(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(Shared_t), intent(in) :: newValue + sgg%Eshared = newValue + end subroutine + + subroutine sgg_set_Hshared(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(Shared_t), intent(in) :: newValue + sgg%Hshared = newValue + end subroutine + + subroutine sgg_set_Alloc(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(XYZlimit_t), intent(in) :: newValue(1:6) + sgg%Alloc = newValue + end subroutine + + subroutine sgg_set_Sweep(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(XYZlimit_t), intent(in) :: newValue(1:6) + sgg%Sweep = newValue + end subroutine + + subroutine sgg_set_SINPMLSweep(sgg, newValue) + type(SGGFDTDINFO), intent(inout) :: sgg + type(XYZlimit_t), intent(in) :: newValue(1:6) + sgg%SINPMLSweep = newValue + end subroutine + + subroutine sgg_set_thereAreMagneticMedia(sgg, value) + type(SGGFDTDINFO), intent(inout) :: sgg + logical, intent(in) :: value + sgg%thereAreMagneticMedia = value + end subroutine + + subroutine sgg_set_thereArePMLMagneticMedia(sgg, value) + type(SGGFDTDINFO), intent(inout) :: sgg + logical, intent(in) :: value + sgg%thereArePMLMagneticMedia = value + end subroutine + + subroutine sgg_set_nEntradaRoot(sgg, value) + type(SGGFDTDINFO), intent(inout) :: sgg + character(len=*), intent(in) :: value + sgg%nEntradaRoot = value + end subroutine + + subroutine sgg_set_Punto(sgg, value) + type(SGGFDTDINFO), intent(inout) :: sgg + type(coorsxyzP), intent(in) :: value + sgg%Punto = value + end subroutine + + subroutine sgg_add_observation(sgg, new_observation) + implicit none + + type(SGGFDTDINFO), intent(inout) :: sgg + type(Obses_t), intent(in), target :: new_observation + + type(Obses_t), dimension(:), pointer :: temp_obs + integer :: old_size, new_size + + old_size = sgg%NumberRequest + new_size = old_size + 1 + + allocate (temp_obs(1:new_size)) + + if (old_size > 0) then + temp_obs(1:old_size) = sgg%Observation(1:old_size) + deallocate (sgg%Observation) + end if + + temp_obs(new_size) = new_observation + + sgg%Observation => temp_obs + + sgg%NumberRequest = new_size + + end subroutine sgg_add_observation + +end module mod_sggMethods From 387e307a9b0c0a4e1a42ac250d9be805489dcc2e Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 16 Dec 2025 13:13:40 +0100 Subject: [PATCH 33/67] Added test for flushing movie probes --- src_output/movieProbeOutput.F90 | 38 +--- src_output/output.F90 | 93 +++++++++- test/output/output_tests.h | 5 + test/output/test_output.F90 | 297 ++++++++++++++++++++++++++++++-- test/utils/assertion_tools.F90 | 9 + 5 files changed, 386 insertions(+), 56 deletions(-) diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index b62655ca..623a938e 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -20,9 +20,7 @@ module mod_movieProbeOutput private :: get_measurements_coords private :: save_current_data private :: write_vtu_timestep - private :: create_pvd private :: update_pvd - private :: close_pvd !=========================== contains @@ -74,7 +72,7 @@ subroutine update_movie_probe_output(this, step, geometryMedia, registeredMedia, real(kind=RKIND_tiempo), intent(in) :: step type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:) :: registeredMedia + type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize type(fields_reference_t), pointer, intent(in) :: fieldsReference @@ -250,34 +248,18 @@ subroutine write_vtu_timestep(this, stepIndex, filename) ierr = vtkOutput%initialize(format='ASCII', filename=trim(filename), mesh_topology='UnstructuredGrid') ierr = vtkOutput%xml_writer%write_geo(n=npts, x=x, y=y, z=z) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='float64_scalar', x=Jx) + ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentX', x=Jx) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='float64_scalar', x=Jy) + ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentY', x=Jy) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='float64_scalar', x=Jz) + ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentZ', x=Jz) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') ierr = vtkOutput%xml_writer%finalize() end subroutine write_vtu_timestep - subroutine create_pvd(this, unitPVD) - implicit none - type(movie_probe_output_t), intent(in) :: this - integer, intent(out) :: unitPVD - integer :: ios - - ! Abrimos el archivo PVD - open (newunit=unitPVD, file=trim(this%path)//".pvd", status='replace', action='write', iostat=ios) - if (ios /= 0) stop "Error al crear archivo PVD" - - ! Escribimos encabezados XML - write (unitPVD, *) '' - write (unitPVD, *) '' - write (unitPVD, *) ' ' - end subroutine create_pvd - subroutine update_pvd(this, stepIndex, unitPVD) implicit none type(movie_probe_output_t), intent(in) :: this @@ -287,7 +269,7 @@ subroutine update_pvd(this, stepIndex, unitPVD) character(len=256) :: filename ! Generamos nombre del archivo VTU para este timestep - write (filename, '(A,I4.4,A)') trim(this%path), stepIndex, '.vtu' + write (filename, '(A,A,I4.4,A)') trim(this%path), '_ts', stepIndex, '.vtu' ! Escribimos el VTU correspondiente call write_vtu_timestep(this, stepIndex, filename) @@ -298,14 +280,4 @@ subroutine update_pvd(this, stepIndex, unitPVD) '" group="" part="0" file="'//trim(filename)//'"/>' end subroutine update_pvd - subroutine close_pvd(unitPVD) - implicit none - integer, intent(in) :: unitPVD - - ! Cerramos colección y archivo XML - write (unitPVD, *) ' ' - write (unitPVD, *) '' - close (unitPVD) - end subroutine close_pvd - end module mod_movieProbeOutput diff --git a/src_output/output.F90 b/src_output/output.F90 index dad1eab6..53ca331e 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -16,7 +16,8 @@ module output WIRE_CHARGE_PROBE_ID = 2, & BULK_PROBE_ID = 3, & VOLUMIC_CURRENT_PROBE_ID = 4, & - MOVIE_PROBE_ID = 5 + MOVIE_PROBE_ID = 5, & + FREQUENCY_SLICE_PROBE_ID = 6 REAL(KIND=RKIND), save :: eps0, mu0 REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu @@ -47,8 +48,9 @@ module output init_wire_charge_probe_output, & init_bulk_probe_output, & init_volumic_probe_output, & - init_movie_probe_output - !init_far_field, & + init_movie_probe_output, & + init_frequency_slice_output + !init_far_field, & !initime_movie_output, & !init_frequency_slice_output end interface @@ -64,7 +66,9 @@ module output update_wire_current_probe_output, & update_wire_charge_probe_output, & update_bulk_probe_output, & - update_volumic_probe_output + update_volumic_probe_output, & + update_movie_probe_output, & + update_frequency_slice_output !update_bulk_current_probe_output, & !update_far_field, & !updateime_movie_output, & @@ -73,7 +77,10 @@ module output interface flush_solver_output module procedure & - flush_point_probe_output + flush_point_probe_output, & + flush_movie_probe_output, & + flush_frequency_slice_output + !flush_wire_probe_output, & !flush_bulk_current_probe_output, & !flush_far_field, & @@ -174,6 +181,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW allocate (outputs(outputCount)%movieProbe) call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, SINPML_fullsize, outputTypeExtension, control%mpidir) + call create_pvd(outputs(outputCount)%movieProbe%path, outputs(outputCount)%movieProbe%PDVUnit) case default call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') end select @@ -240,14 +248,20 @@ subroutine create_output_files(outputs) end do end subroutine create_output_files - subroutine update_outputs(outputs, control, step, fields) + subroutine update_outputs(outputs, geometryMedia, materialList, SINPML_fullsize , control, step, fields) type(solver_output_t), dimension(:), intent(inout) :: outputs real(kind=RKIND_tiempo) :: step integer(kind=SINGLE) :: i, id + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t),dimension(:), pointer :: materialList + type(limit_t), pointer, dimension(:), intent(in) :: SINPML_fullsize type(sim_control_t), intent(in) :: control real(kind=RKIND), pointer, dimension(:, :, :) :: fieldComponent type(field_data_t), pointer :: fieldReference - type(fields_reference_t) :: fields + type(fields_reference_t), target :: fields + type(fields_reference_t), pointer :: fieldsPtr + + fieldsPtr => fields do i = 1, size(outputs) select case (outputs(i)%outputID) @@ -261,6 +275,9 @@ subroutine update_outputs(outputs, control, step, fields) case (BULK_PROBE_ID) fieldReference => get_field_reference(outputs(i)%bulkCurrentProbe%fieldComponent, fields) call update_solver_output(outputs(i)%bulkCurrentProbe, step, fieldReference) + case (MOVIE_PROBE_ID) + call update_solver_output(outputs(i)%movieProbe, step, geometryMedia, materialList, SINPML_fullsize, fieldsPtr) + case(FREQUENCY_SLICE_PROBE_ID) case default call stoponerror(0, 0, 'Output update not implemented') end select @@ -307,4 +324,66 @@ end function get_field_reference end subroutine update_outputs + subroutine flush_outputs(outputs) + type(solver_output_t), dimension(:), intent(inout) :: outputs + integer :: i + do i = 1, size(outputs) + select case(outputs(i)%outputID) + case(POINT_PROBE_ID) + call flush_point_probe_output(outputs(i)%pointProbe) + case(WIRE_CURRENT_PROBE_ID) + case(WIRE_CHARGE_PROBE_ID) + case(BULK_PROBE_ID) + case(VOLUMIC_CURRENT_PROBE_ID) + case(MOVIE_PROBE_ID) + call flush_solver_output(outputs(i)%movieProbe) + case(FREQUENCY_SLICE_PROBE_ID) + end select + end do + end subroutine flush_outputs + + subroutine close_outputs(outputs) + type(solver_output_t), dimension(:), intent(inout) :: outputs + integer :: i + do i = 1, size(outputs) + select case(outputs(i)%outputID) + case(POINT_PROBE_ID) + case(WIRE_CURRENT_PROBE_ID) + case(WIRE_CHARGE_PROBE_ID) + case(BULK_PROBE_ID) + case(VOLUMIC_CURRENT_PROBE_ID) + case(MOVIE_PROBE_ID) + call close_pvd(outputs(i)%movieProbe%PDVUnit) + case(FREQUENCY_SLICE_PROBE_ID) + end select + end do + end subroutine + + + subroutine create_pvd(pdvPath, unitPVD) + implicit none + character(len=*), intent(in) :: pdvPath + integer, intent(out) :: unitPVD + integer :: ios + + ! Abrimos el archivo PVD + open(newunit=unitPVD, file=trim(pdvPath)//".pvd", status="replace", action="write", iostat=ios) + if (ios /= 0) stop "Error al crear archivo PVD" + + ! Escribimos encabezados XML + write (unitPVD, *) '' + write (unitPVD, *) '' + write (unitPVD, *) ' ' + end subroutine create_pvd + + subroutine close_pvd(unitPVD) + implicit none + integer, intent(in) :: unitPVD + + ! Cerramos colección y archivo XML + write (unitPVD, *) ' ' + write (unitPVD, *) '' + close (unitPVD) + end subroutine close_pvd + end module output diff --git a/test/output/output_tests.h b/test/output/output_tests.h index b22a9b76..eaf70127 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -6,6 +6,8 @@ extern "C" int test_flush_point_probe(); extern "C" int test_multiple_flush_point_probe(); extern "C" int test_volumic_probe_count_relevant_surfaces(); extern "C" int test_init_movie_probe(); +extern "C" int test_update_movie_probe(); +extern "C" int test_flush_movie_probe(); TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe()); } @@ -14,3 +16,6 @@ TEST(output, test_flush_point_probe_info) {EXPECT_EQ(0, test_flush_point_prob TEST(output, test_flush_multiple_point_probe_info) {EXPECT_EQ(0, test_multiple_flush_point_probe()); } TEST(output, test_volumic_probe_counter_relevant_surfaces) {EXPECT_EQ(0, test_volumic_probe_count_relevant_surfaces()); } TEST(output, test_init_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_init_movie_probe()); } +TEST(output, test_update_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_update_movie_probe()); } +TEST(output, test_flush_movie_probe_data) {EXPECT_EQ(0, test_flush_movie_probe()); } + diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index f04539c4..9f863d5d 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -49,6 +49,8 @@ integer function test_init_point_probe() bind(c) result(err) test_err = test_err + assert_integer_equal(outputs(1)%pointProbe%columnas, 2, 'Unexpected number of columns') test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') + call close_outputs(outputs) + deallocate (dummysgg%Observation) deallocate (outputs) err = test_err @@ -111,17 +113,19 @@ integer function test_update_point_probe() bind(c) result(err) fields%H%deltaZ => dummyfields%dzh dummyfields%Ex(4, 4, 4) = 5.0_RKIND - call update_outputs(outputs, dummyControl, 0.5_RKIND_tiempo, fields) + call update_outputs(outputs, dummyMedia, simulationMediaPtr, dummysinpml_fullsize, dummyControl, 0.5_RKIND_tiempo, fields) test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(1), 0.5_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 1') test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(1), 5.0_RKIND, 0.00001_RKIND, 'Unexpected field 1') dummyfields%Ex(4, 4, 4) = -4.0_RKIND - call update_outputs(outputs, dummyControl, 0.8_RKIND_tiempo, fields) + call update_outputs(outputs, dummyMedia, simulationMediaPtr, dummysinpml_fullsize, dummyControl, 0.8_RKIND_tiempo, fields) test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(2), 0.8_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 2') test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(2), -4.0_RKIND, 0.00001_RKIND, 'Unexpected field 2') + call close_outputs(outputs) + if (associated(dummymedia)) deallocate (dummymedia) if (associated(dummysinpml_fullsize)) deallocate (dummysinpml_fullsize) @@ -310,8 +314,6 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err call sgg_set_tiempo(dummysgg, timeArray) call sgg_set_dt(dummysgg, dt) - - err = 1 !If test_err is not updated at the end it will be shown test_err = 0 @@ -330,11 +332,11 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err call assing_material_id_to_media_matrix_coordinate(media, iEx, 2, 2, 2, thinWireSimulationMaterial%Id) mediaPtr => media - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) simulationMaterialsPtr => simulationMaterials call sgg_set_Med(dummysgg, simulationMaterialsPtr) - volumicProbeObservable = create_volumic_probe_observation(4,4,4,6,6,6) + volumicProbeObservable = create_volumic_probe_observation(4, 4, 4, 6, 6, 6) call sgg_add_observation(dummysgg, volumicProbeObservable) dummyControl = create_control_flags(mpidir=mpidir, nEntradaRoot='entradaRoot', wiresflavor='holland') @@ -345,6 +347,8 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err test_err = test_err + assert_integer_equal(outputs(1)%volumicCurrentProbe%columnas, 4, 'Unexpected number of columns') test_err = test_err + assert_string_equal(outputs(1)%volumicCurrentProbe%path, 'entradaRoot_volumicProbe_BCX_4_4_4__6_6_6', 'Unexpected path') + call close_outputs(outputs) + err = test_err end function @@ -355,26 +359,29 @@ integer function test_init_movie_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools + ! Init inputs type(SGGFDTDINFO) :: dummysgg - type(media_matrices_t), target :: media - type(limit_t), dimension(1:6), target :: sinpml_fullsize + type(media_matrices_t), pointer :: mediaPtr + type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr + type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr type(sim_control_t) :: dummyControl type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .false. + !Auxiliar variables + type(media_matrices_t), target :: media type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials - type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr + type(limit_t), dimension(1:6), target :: sinpml_fullsize type(Obses_t) :: movieObservable type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - type(media_matrices_t), pointer :: mediaPtr - type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr integer(kind=SINGLE) :: expectedNumMeasurments integer(kind=SINGLE) :: mpidir = 3 + character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) err = 1 !If test_err is not updated at the end it will be shown test_err = 0 @@ -387,6 +394,7 @@ integer function test_init_movie_probe() bind(c) result(err) upperBoundMovieProbe%y = 5 upperBoundMovieProbe%z = 5 + ! Setup sgg call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) @@ -398,15 +406,15 @@ integer function test_init_movie_probe() bind(c) result(err) simulationMaterialsPtr => simulationMaterials call sgg_set_Med(dummysgg, simulationMaterialsPtr) - movieObservable = create_movie_observation(2,2,2,5,5,5) - call sgg_add_observation(dummysgg, movieObservable) - call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - + ! Define movie observation on sgg + movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) + call sgg_add_observation(dummysgg, movieObservable) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) !----- Defining PEC surface -----! call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) @@ -422,7 +430,10 @@ integer function test_init_movie_probe() bind(c) result(err) end do sinpml_fullsizePtr => sinpml_fullsize + dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, 4, 'Unexpected number of columns') test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nMeasuredElements, expectedNumMeasurments, 'Unexpected number of measurments') @@ -431,5 +442,259 @@ integer function test_init_movie_probe() bind(c) result(err) test_err = 1 end if + call close_outputs(outputs) + + err = test_err +end function + +integer function test_update_movie_probe() bind(c) result(err) + use output + use mod_testOutputUtils + use FDETYPES_TOOLS + use mod_sggMethods + use mod_assertionTools + + ! Init inputs + type(SGGFDTDINFO) :: dummysgg + type(media_matrices_t), pointer :: mediaPtr + type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr + type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr + type(sim_control_t) :: dummyControl + type(solver_output_t), dimension(:), allocatable :: outputs + logical :: ThereAreWires = .false. + + !Auxiliar variables + type(media_matrices_t), target :: media + type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials + type(limit_t), dimension(1:6), target :: sinpml_fullsize + type(Obses_t) :: movieObservable + type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: mpidir = 3 + character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) + + !DummyField required variables + type(dummyFields_t), target :: dummyfields + type(fields_reference_t) :: fields + + err = 1 !If test_err is not updated at the end it will be shown + test_err = 0 + + lowerBoundMovieProbe%x = 2 + lowerBoundMovieProbe%y = 2 + lowerBoundMovieProbe%z = 2 + + upperBoundMovieProbe%x = 5 + upperBoundMovieProbe%y = 5 + upperBoundMovieProbe%z = 5 + + ! Setup sgg + call sgg_init(dummysgg) + call init_time_array(timeArray, nTimeSteps, dt) + call sgg_set_tiempo(dummysgg, timeArray) + call sgg_set_dt(dummysgg, dt) + call init_simulation_material_list(simulationMaterials) + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + simulationMaterialsPtr => simulationMaterials + call sgg_set_Med(dummysgg, simulationMaterialsPtr) + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) + call sgg_set_NumPlaneWaves(dummysgg, 1) + call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + ! Define movie observation on sgg + movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) + call sgg_add_observation(dummysgg, movieObservable) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) + !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE + !----- -------------------- -----! + mediaPtr => media + do iter = 1, 6 + sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + end do + sinpml_fullsizePtr => sinpml_fullsize + + dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + + + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + + ! Set dummy field status + + call create_dummy_fields(dummyfields, 1, 5, 0.1_RKIND) + fields%E%x => dummyfields%Ex + fields%E%y => dummyfields%Ey + fields%E%z => dummyfields%Ez + fields%E%deltax => dummyfields%dxe + fields%E%deltaY => dummyfields%dye + fields%E%deltaZ => dummyfields%dze + fields%H%x => dummyfields%Hx + fields%H%y => dummyfields%Hy + fields%H%z => dummyfields%Hz + fields%H%deltax => dummyfields%dxh + fields%H%deltaY => dummyfields%dyh + fields%H%deltaZ => dummyfields%dzh + + dummyfields%Hx(3, 3, 3) = 2.0_RKIND + dummyfields%Hy(3, 3, 3) = 5.0_RKIND + dummyfields%Hz(3, 3, 3) = 4.0_RKIND + + call update_outputs(outputs, mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, dummyControl, 0.5_RKIND_tiempo, fields) + + test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, 4, 'Unexpected number of columns') + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nMeasuredElements, expectedNumMeasurments, 'Unexpected number of measurments') + test_err = test_err + assert_integer_equal(size(outputs(1)%movieProbe%xValueForTime), expectedNumMeasurments * BuffObse, 'Unexpected allocation size') + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 1), 0.2_RKIND, 0.00001_RKIND, 'Value error') + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 2), 0.0_RKIND, 0.00001_RKIND, 'Value error') + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 3), 0.2_RKIND, 0.00001_RKIND, 'Value error') + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 4), 0.0_RKIND, 0.00001_RKIND, 'Value error') + if (size(outputs(1)%movieProbe%timeStep) /= BuffObse) then + test_err = 1 + end if + + call close_outputs(outputs) + + err = test_err +end function + +integer function test_flush_movie_probe() bind(c) result(err) + use output + use mod_testOutputUtils + use FDETYPES_TOOLS + use mod_sggMethods + use mod_assertionTools + + ! Init inputs + type(SGGFDTDINFO) :: dummysgg + type(media_matrices_t), pointer :: mediaPtr + type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr + type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr + type(sim_control_t) :: dummyControl + type(solver_output_t), dimension(:), allocatable :: outputs + logical :: ThereAreWires = .false. + + !Auxiliar variables + type(media_matrices_t), target :: media + type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials + type(limit_t), dimension(1:6), target :: sinpml_fullsize + type(Obses_t) :: movieObservable + type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: mpidir = 3 + character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) + character(len=BUFSIZE) :: expectedPath + + err = 1 !If test_err is not updated at the end it will be shown + test_err = 0 + + lowerBoundMovieProbe%x = 2 + lowerBoundMovieProbe%y = 2 + lowerBoundMovieProbe%z = 2 + + upperBoundMovieProbe%x = 5 + upperBoundMovieProbe%y = 5 + upperBoundMovieProbe%z = 5 + + ! Setup sgg + call sgg_init(dummysgg) + call init_time_array(timeArray, nTimeSteps, dt) + call sgg_set_tiempo(dummysgg, timeArray) + call sgg_set_dt(dummysgg, dt) + call init_simulation_material_list(simulationMaterials) + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + simulationMaterialsPtr => simulationMaterials + call sgg_set_Med(dummysgg, simulationMaterialsPtr) + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) + call sgg_set_NumPlaneWaves(dummysgg, 1) + call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + ! Define movie observation on sgg + movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) + call sgg_add_observation(dummysgg, movieObservable) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) + !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE + !----- -------------------- -----! + mediaPtr => media + do iter = 1, 6 + sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + end do + sinpml_fullsizePtr => sinpml_fullsize + + dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + + + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + + !Dummy first update + outputs(1)%movieProbe%serializedTimeSize = 1 + outputs(1)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo + + outputs(1)%movieProbe%xValueForTime(1,1) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(1,2) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(1,3) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(1,4) = 0.0_RKIND + + outputs(1)%movieProbe%yValueForTime(1,1) = 0.1_RKIND + outputs(1)%movieProbe%yValueForTime(1,2) = 0.2_RKIND + outputs(1)%movieProbe%yValueForTime(1,3) = 0.3_RKIND + outputs(1)%movieProbe%yValueForTime(1,4) = 0.4_RKIND + + outputs(1)%movieProbe%zValueForTime(1,1) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(1,2) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(1,3) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(1,4) = 0.0_RKIND + + !Dummy second update + outputs(1)%movieProbe%serializedTimeSize = 2 + outputs(1)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo + + outputs(1)%movieProbe%xValueForTime(2,1) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2,2) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2,3) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2,4) = 0.0_RKIND + + outputs(1)%movieProbe%yValueForTime(2,1) = 0.11_RKIND + outputs(1)%movieProbe%yValueForTime(2,2) = 0.22_RKIND + outputs(1)%movieProbe%yValueForTime(2,3) = 0.33_RKIND + outputs(1)%movieProbe%yValueForTime(2,4) = 0.44_RKIND + + outputs(1)%movieProbe%zValueForTime(2,1) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(2,2) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(2,3) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(2,4) = 0.0_RKIND + + call flush_outputs(outputs) + + expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0001'//'.vtu' + test_err = test_err + assert_file_exists(expectedPath) + + expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0002'//'.vtu' + test_err = test_err + assert_file_exists(expectedPath) + + call close_outputs(outputs) + + expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'.pvd' + test_err = test_err + assert_file_exists(expectedPath) + err = test_err end function diff --git a/test/utils/assertion_tools.F90 b/test/utils/assertion_tools.F90 index c920eae6..3a33aaba 100644 --- a/test/utils/assertion_tools.F90 +++ b/test/utils/assertion_tools.F90 @@ -117,4 +117,13 @@ integer function assert_file_content(unit, expectedValues, nRows, nCols, headers end do end do end function assert_file_content + + integer function assert_file_exists(fileName) result(err) + character(len=*), intent(in) :: filename + integer :: unit, ios + err = 0 + open(newunit=unit, file=filename, status='old', iostat=ios) + close(unit) + if (ios/=0) err = 1 + end function end module mod_assertionTools \ No newline at end of file From ad0e9a637ec370e5de3b8af7d833f71846d179dc Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 16 Dec 2025 13:49:57 +0100 Subject: [PATCH 34/67] Add frequency slice probe output --- src_output/CMakeLists.txt | 1 + src_output/frequencySliceProbeOutput.F90 | 296 +++++++++++++++++++++++ src_output/output.F90 | 7 +- src_output/outputTypes.F90 | 26 +- 4 files changed, 325 insertions(+), 5 deletions(-) create mode 100644 src_output/frequencySliceProbeOutput.F90 diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index a474f44f..e047e620 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -8,6 +8,7 @@ add_library(fdtd-output "bulkProbeOutput.F90" "volumicProbeOutput.F90" "movieProbeOutput.F90" + "frequencySliceProbeOutput.F90" ) target_link_libraries(fdtd-output semba-types diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 new file mode 100644 index 00000000..ea216d9f --- /dev/null +++ b/src_output/frequencySliceProbeOutput.F90 @@ -0,0 +1,296 @@ +module mod_frequencySliceProbeOutput + use FDETYPES + use Report + use outputTypes + use mod_outputUtils + implicit none + private + + !=========================== + ! Public interface summary + !=========================== + public :: init_frequency_slice_probe_output + public :: update_frequency_slice_probe_output + public :: flush_frequency_slice_probe_output + !=========================== + + !=========================== + ! Private interface summary + !=========================== + private :: get_measurements_coords + private :: save_current_data + private :: write_vtu_frequency_slice + private :: update_pvd + !=========================== + +contains + + subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir, timeInterval) + type(frequency_slice_probe_output_t), intent(inout) :: this + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound + integer(kind=SINGLE), intent(in) :: mpidir, field + character(len=BUFSIZE), intent(in) :: outputTypeExtension + + type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + + type(domain_t), intent(in) :: domain + real(kind=RKIND_tiempo), intent(in) :: timeInterval + integer :: i + + if (domain%domainType /= FREQUENCY_DOMAIN) call StopOnError(0, 0, "Unexpected domain type for frequency_slice probe") + + this%lowerBound = lowerBound + this%upperBound = upperBound + this%fieldComponent = field !This can refer to field or currentDensity + this%domain = domain + this%path = get_output_path() + call get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) + + allocate (this%frequencySlice(this%nFreq)) + allocate (this%xValueForFreq(this%nFreq, this%nMeasuredElements)) + allocate (this%yValueForFreq(this%nFreq, this%nMeasuredElements)) + allocate (this%zValueForFreq(this%nFreq, this%nMeasuredElements)) + do i = 1, this%nFreq + call init_frequency_slice(this%frequencySlice, this%domain) + end do + this%xValueForFreq = (0.0_RKIND, 0.0_RKIND) + this%yValueForFreq = (0.0_RKIND, 0.0_RKIND) + this%zValueForFreq = (0.0_RKIND, 0.0_RKIND) + + allocate (this%auxExp_E(this%nFreq)) + allocate (this%auxExp_H(this%nFreq)) + do i = 1, this%nFreq + this%auxExp_E(i) = timeInterval*(1.0E0_RKIND, 0.0E0_RKIND)*Exp(mcpi2*this%frequencySlice(i)) !el dt deberia ser algun tipo de promedio + this%auxExp_H(i) = this%auxExp_E(i)*Exp(mcpi2*this%frequencySlice(i)*timeInterval*0.5_RKIND) + end do + + contains + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, 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_frequency_slice_probe_output + + subroutine update_frequency_slice_probe_output(this, step, geometryMedia, registeredMedia, sinpml_fullsize, fieldsReference) + type(frequency_slice_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + type(fields_reference_t), pointer, intent(in) :: fieldsReference + + select case (this%fieldComponent) + case (iCur) + call save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) + end select + end subroutine update_frequency_slice_probe_output + + subroutine flush_frequency_slice_probe_output(this) + type(frequency_slice_probe_output_t), intent(inout) :: this + integer :: status, i + + do i = 1, this%nFreq + call update_pvd(this, i, this%PDVUnit) + end do + + end subroutine flush_frequency_slice_probe_output + + subroutine get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) + type(frequency_slice_probe_output_t), intent(inout) :: this + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:) :: registeredMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + + integer(kind=SINGLE) :: i, j, k, field + integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend + integer(kind=SINGLE) :: count + ! Limites de la región de interés + istart = this%lowerBound%x + jstart = this%lowerBound%y + kstart = this%lowerBound%z + + iend = this%upperBound%x + jend = this%upperBound%y + kend = this%upperBound%z + + ! Primer barrido para contar cuántos puntos válidos + count = 0 + select case (this%fieldComponent) + case (iCur) + do i = istart, iend + do j = jstart, jend + do k = kstart, kend + do field = iEx, iEz + if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then + if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then + count = count + 1 + end if + end if + end do + end do + end do + end do + end select + + this%nMeasuredElements = count + + allocate (this%coords(3, this%nMeasuredElements)) + + count = 0 + select case (this%fieldComponent) + case (iCur) + do i = istart, iend + do j = jstart, jend + do k = kstart, kend + do field = iEx, iEz + if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then + if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then + count = count + 1 + this%coords(:, count) = [i, j, k] + end if + end if + end do + end do + end do + end do + end select + + end subroutine get_measurements_coords + + subroutine save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) + type(frequency_slice_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + type(fields_reference_t), pointer, intent(in) :: fieldsReference + + type(media_matrices_t), pointer, intent(in) :: geometryMedia + type(MediaData_t), pointer, dimension(:) :: registeredMedia + type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + + integer(kind=SINGLE) :: i, j, k, field + integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend + integer(kind=SINGLE) :: n + + istart = this%lowerBound%x + jstart = this%lowerBound%y + kstart = this%lowerBound%z + + iend = this%upperBound%x + jend = this%upperBound%y + kend = this%upperBound%z + + n = 0 + do i = istart, iend + do j = jstart, jend + do k = kstart, kend + do field = iEx, iEz + if (isWithinBounds(field, i, j, k, SINPML_fullsize)) then + if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then + n = n + 1 + call save_current_component() + end if + end if + end do + end do + end do + end do + + if (n < this%nMeasuredElements) call StopOnError(0, 0, "Missing measurment to update at frequency_slice probe") + contains + + subroutine save_current_component() + real(kind=RKIND) :: jdir + integer :: freqIdx + jdir = computeJ(field, i, j, k, fieldsReference) + + do freqIdx = 1, this%nFreq + call updateComplexComponent(iEx, field, this%xValueForFreq(freqIdx, n), jdir, this%auxExp_E(freqIdx)**step) + call updateComplexComponent(iEy, field, this%yValueForFreq(freqIdx, n), jdir, this%auxExp_E(freqIdx)**step) + call updateComplexComponent(iEz, field, this%zValueForFreq(freqIdx, n), jdir, this%auxExp_E(freqIdx)**step) + end do + end subroutine save_current_component + + subroutine updateComplexComponent(direction, fieldIndex, valorComplex, jdir, auxExp) + integer, intent(in) :: direction, fieldIndex + complex(kind=CKIND), intent(inout) :: valorComplex + complex(kind=CKIND), intent(in) :: auxExp + real(kind=RKIND), intent(in) :: jdir + + complex(kind=CKIND) :: z_cplx = (0.0_RKIND, 0.0_RKIND) + + valorComplex = merge(valorComplex + auxExp*jdir, z_cplx, fieldIndex == direction) + end subroutine updateComplexComponent + end subroutine save_current_data + + subroutine write_vtu_frequency_slice(this, freq, filename) + use vtk_fortran + implicit none + + type(frequency_slice_probe_output_t), intent(in) :: this + integer, intent(in) :: freq + character(len=*), intent(in) :: filename + + type(vtk_file) :: vtkOutput + integer :: ierr, npts, i + real(kind=RKIND), allocatable :: x(:), y(:), z(:) + real(kind=RKIND), allocatable :: Jx(:), Jy(:), Jz(:) + + npts = this%nMeasuredElements + + allocate (x(npts), y(npts), z(npts)) + do i = 1, npts + x(i) = this%coords(1, i) + y(i) = this%coords(2, i) + z(i) = this%coords(3, i) + end do + + allocate (Jx(npts), Jy(npts), Jz(npts)) + do i = 1, npts + Jx(i) = this%xValueForFreq(freq, i) + Jy(i) = this%yValueForFreq(freq, i) + Jz(i) = this%zValueForFreq(freq, i) + end do + ierr = vtkOutput%initialize(format='ASCII', filename=trim(filename), mesh_topology='UnstructuredGrid') + ierr = vtkOutput%xml_writer%write_geo(n=npts, x=x, y=y, z=z) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentX', x=Jx) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentY', x=Jy) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentZ', x=Jz) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + ierr = vtkOutput%xml_writer%finalize() + + end subroutine write_vtu_frequency_slice + + subroutine update_pvd(this, freq, unitPVD) + implicit none + type(frequency_slice_probe_output_t), intent(in) :: this + integer, intent(in) :: freq + integer, intent(in) :: unitPVD + character(len=64) :: ts + character(len=256) :: filename + + ! Generamos nombre del archivo VTU para este timestep + write (filename, '(A,A,I4.4,A)') trim(this%path), '_fq', freq, '.vtu' + + ! Escribimos el VTU correspondiente + call write_vtu_frequency_slice(this, freq, filename) + + ! Añadimos entrada en el PVD + write (ts, '(ES16.8)') this%frequencySlice(freq) + write (unitPVD, '(A)') ' ' + end subroutine update_pvd + +end module mod_frequencySliceProbeOutput diff --git a/src_output/output.F90 b/src_output/output.F90 index 53ca331e..a11dbde8 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -8,6 +8,7 @@ module output use mod_bulkProbeOutput use mod_volumicProbeOutput use mod_movieProbeOutput + use mod_frequencySliceProbeOutput implicit none @@ -49,7 +50,7 @@ module output init_bulk_probe_output, & init_volumic_probe_output, & init_movie_probe_output, & - init_frequency_slice_output + init_frequency_slice_probe_output !init_far_field, & !initime_movie_output, & !init_frequency_slice_output @@ -68,7 +69,7 @@ module output update_bulk_probe_output, & update_volumic_probe_output, & update_movie_probe_output, & - update_frequency_slice_output + update_frequency_slice_probe_output !update_bulk_current_probe_output, & !update_far_field, & !updateime_movie_output, & @@ -79,7 +80,7 @@ module output module procedure & flush_point_probe_output, & flush_movie_probe_output, & - flush_frequency_slice_output + flush_frequency_slice_probe_output !flush_wire_probe_output, & !flush_bulk_current_probe_output, & diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 8779e66a..aeb8b8a7 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -170,6 +170,7 @@ module outputTypes character(len=BUFSIZE) :: path integer(kind=SINGLE) :: fieldComponent + integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE integer(kind=SINGLE), dimension(:,:), allocatable :: coords !Intent storage order: @@ -177,7 +178,6 @@ module outputTypes !(:,:) == (timeInstance, componentId) => escalar !Time Domain (requires first allocation) - integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE real(kind=RKIND_tiempo), dimension(:), allocatable :: timeStep real(kind=RKIND), dimension(:, :), allocatable :: xValueForTime @@ -185,7 +185,29 @@ module outputTypes real(kind=RKIND), dimension(:, :), allocatable :: zValueForTime end type movie_probe_output_t type frequency_slice_probe_output_t - !!!!!Pending + integer(kind=SINGLE) :: PDVUnit + integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components + type(domain_t) :: domain + type(cell_coordinate_t) :: lowerBound + type(cell_coordinate_t) :: upperBound + character(len=BUFSIZE) :: path + integer(kind=SINGLE) :: fieldComponent + + integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE + integer(kind=SINGLE), dimension(:,:), allocatable :: coords + + !Intent storage order: + !(:) == (frquencyinstance) => timeValue + !(:,:) == (frquencyinstance, componentId) => escalar + + !Frequency Domain (requires first allocation) + integer(kind=SINGLE) :: nFreq = 0_SINGLE + real(kind=RKIND), dimension(:), allocatable :: frequencySlice + complex(kind=CKIND), dimension(:, :), allocatable :: xValueForFreq + complex(kind=CKIND), dimension(:, :), allocatable :: yValueForFreq + complex(kind=CKIND), dimension(:, :), allocatable :: zValueForFreq + complex(kind=CKIND), dimension(:), allocatable :: auxExp_E + complex(kind=CKIND), dimension(:), allocatable :: auxExp_H end type frequency_slice_probe_output_t contains From 58cec2e4dd4660700059b2595344e898621062aa Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 16 Dec 2025 13:57:46 +0100 Subject: [PATCH 35/67] Added hook to new frequency slice probe --- src_output/output.F90 | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index a11dbde8..c56d45a9 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -177,12 +177,23 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW call init_solver_output(outputs(outputCount)%volumicCurrentProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir, sgg%dt) case (iCur) - outputCount = outputCount + 1 - outputs(outputCount)%outputID = MOVIE_PROBE_ID + if (domain%domainType == TIME_DOMAIN) then + + outputCount = outputCount + 1 + outputs(outputCount)%outputID = MOVIE_PROBE_ID + allocate (outputs(outputCount)%movieProbe) + call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, SINPML_fullsize, outputTypeExtension, control%mpidir) + call create_pvd(outputs(outputCount)%movieProbe%path, outputs(outputCount)%movieProbe%PDVUnit) + + else if ( domain%domainType == FREQUENCY_DOMAIN ) then - allocate (outputs(outputCount)%movieProbe) - call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, SINPML_fullsize, outputTypeExtension, control%mpidir) - call create_pvd(outputs(outputCount)%movieProbe%path, outputs(outputCount)%movieProbe%PDVUnit) + outputCount = outputCount + 1 + outputs(outputCount)%outputID = FREQUENCY_SLICE_PROBE_ID + allocate (outputs(outputCount)%frequencySliceProbe) + call init_solver_output(outputs(outputCount)%frequencySliceProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, SINPML_fullsize, outputTypeExtension, control%mpidir, sgg%dt) + call create_pvd(outputs(outputCount)%frequencySliceProbe%path, outputs(outputCount)%frequencySliceProbe%PDVUnit) + + end if case default call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') end select @@ -279,6 +290,7 @@ subroutine update_outputs(outputs, geometryMedia, materialList, SINPML_fullsize case (MOVIE_PROBE_ID) call update_solver_output(outputs(i)%movieProbe, step, geometryMedia, materialList, SINPML_fullsize, fieldsPtr) case(FREQUENCY_SLICE_PROBE_ID) + call update_solver_output(outputs(i)%frequencySliceProbe, step, geometryMedia, materialList, SINPML_fullsize, fieldsPtr) case default call stoponerror(0, 0, 'Output update not implemented') end select @@ -339,6 +351,7 @@ subroutine flush_outputs(outputs) case(MOVIE_PROBE_ID) call flush_solver_output(outputs(i)%movieProbe) case(FREQUENCY_SLICE_PROBE_ID) + call flush_solver_output(outputs(i)%frequencySliceProbe) end select end do end subroutine flush_outputs From b4c90effdf4481d8213c9619149ac91649c6cc55 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 17 Dec 2025 11:22:05 +0100 Subject: [PATCH 36/67] Added frequency slice output tests --- src_output/frequencySliceProbeOutput.F90 | 1 + test/output/output_tests.h | 4 + test/output/test_output.F90 | 387 +++++++++++++++++++++-- test/output/test_output_utils.F90 | 18 +- test/utils/assertion_tools.F90 | 18 ++ test/utils/fdetypes_tools.F90 | 2 +- 6 files changed, 396 insertions(+), 34 deletions(-) diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index ea216d9f..85137943 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -48,6 +48,7 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, field this%path = get_output_path() call get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) + this%nFreq = domain%fnum allocate (this%frequencySlice(this%nFreq)) allocate (this%xValueForFreq(this%nFreq, this%nMeasuredElements)) allocate (this%yValueForFreq(this%nFreq, this%nMeasuredElements)) diff --git a/test/output/output_tests.h b/test/output/output_tests.h index eaf70127..db209cc1 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -8,6 +8,8 @@ extern "C" int test_volumic_probe_count_relevant_surfaces(); extern "C" int test_init_movie_probe(); extern "C" int test_update_movie_probe(); extern "C" int test_flush_movie_probe(); +extern "C" int test_init_frequency_slice_probe(); +extern "C" int test_update_frequency_slice_probe(); TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe()); } @@ -18,4 +20,6 @@ TEST(output, test_volumic_probe_counter_relevant_surfaces) {EXPECT_EQ(0, test TEST(output, test_init_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_init_movie_probe()); } TEST(output, test_update_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_update_movie_probe()); } TEST(output, test_flush_movie_probe_data) {EXPECT_EQ(0, test_flush_movie_probe()); } +TEST(output, test_init_frequency_slice) {EXPECT_EQ(0, test_init_frequency_slice_probe()); } +TEST(output, test_update_frequency_slice) {EXPECT_EQ(0, test_update_frequency_slice_probe()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 9f863d5d..15440113 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -525,7 +525,6 @@ integer function test_update_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) ! Set dummy field status @@ -642,46 +641,372 @@ integer function test_flush_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + + !Dummy first update + outputs(1)%movieProbe%serializedTimeSize = 1 + outputs(1)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo + + outputs(1)%movieProbe%xValueForTime(1, 1) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(1, 2) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(1, 3) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(1, 4) = 0.0_RKIND + + outputs(1)%movieProbe%yValueForTime(1, 1) = 0.1_RKIND + outputs(1)%movieProbe%yValueForTime(1, 2) = 0.2_RKIND + outputs(1)%movieProbe%yValueForTime(1, 3) = 0.3_RKIND + outputs(1)%movieProbe%yValueForTime(1, 4) = 0.4_RKIND + + outputs(1)%movieProbe%zValueForTime(1, 1) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(1, 2) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(1, 3) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(1, 4) = 0.0_RKIND + + !Dummy second update + outputs(1)%movieProbe%serializedTimeSize = 2 + outputs(1)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo + + outputs(1)%movieProbe%xValueForTime(2, 1) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2, 2) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2, 3) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2, 4) = 0.0_RKIND + + outputs(1)%movieProbe%yValueForTime(2, 1) = 0.11_RKIND + outputs(1)%movieProbe%yValueForTime(2, 2) = 0.22_RKIND + outputs(1)%movieProbe%yValueForTime(2, 3) = 0.33_RKIND + outputs(1)%movieProbe%yValueForTime(2, 4) = 0.44_RKIND + + outputs(1)%movieProbe%zValueForTime(2, 1) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(2, 2) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(2, 3) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(2, 4) = 0.0_RKIND + + call flush_outputs(outputs) + + expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0001'//'.vtu' + test_err = test_err + assert_file_exists(expectedPath) + + expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0002'//'.vtu' + test_err = test_err + assert_file_exists(expectedPath) + + call close_outputs(outputs) + + expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'.pvd' + test_err = test_err + assert_file_exists(expectedPath) + + err = test_err +end function + +integer function test_init_frequency_slice_probe() bind(c) result(err) + use output + use mod_testOutputUtils + use FDETYPES_TOOLS + use mod_sggMethods + use mod_assertionTools + + ! Init inputs + type(SGGFDTDINFO) :: dummysgg + type(media_matrices_t), pointer :: mediaPtr + type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr + type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr + type(sim_control_t) :: dummyControl + type(solver_output_t), dimension(:), allocatable :: outputs + logical :: ThereAreWires = .false. + + !Auxiliar variables + type(media_matrices_t), target :: media + type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials + type(limit_t), dimension(1:6), target :: sinpml_fullsize + type(Obses_t) :: frequencySliceObservation + + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: expectedTotalFrequnecies + integer(kind=SINGLE) :: mpidir = 3 + character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) + + err = 1 !If test_err is not updated at the end it will be shown + test_err = 0 + + ! Setup sgg + call sgg_init(dummysgg) + + call init_time_array(timeArray, nTimeSteps, dt) + call sgg_set_tiempo(dummysgg, timeArray) + call sgg_set_dt(dummysgg, dt) + + call init_simulation_material_list(simulationMaterials) + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + simulationMaterialsPtr => simulationMaterials + call sgg_set_Med(dummysgg, simulationMaterialsPtr) + + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) + call sgg_set_NumPlaneWaves(dummysgg, 1) + call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + + ! Define movie observation on sgg + frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5) + call sgg_add_observation(dummysgg, frequencySliceObservation) + expectedTotalFrequnecies = 6_SINGLE + + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) + !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE + !----- -------------------- -----! + mediaPtr => media + + do iter = 1, 6 + sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + end do + sinpml_fullsizePtr => sinpml_fullsize + + dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + + test_err = test_err + assert_integer_equal(outputs(1)%outputID, FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, 4, 'Unexpected number of columns') + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nMeasuredElements, expectedNumMeasurments, 'Unexpected number of measurments') + test_err = test_err + assert_integer_equal(size(outputs(1)%frequencySliceProbe%xValueForFreq), expectedNumMeasurments * expectedTotalFrequnecies, 'Unexpected allocation size') + if (size(outputs(1)%frequencySliceProbe%frequencySlice) /= expectedTotalFrequnecies) then + test_err = 1 + end if + + call close_outputs(outputs) + + err = test_err +end function + +integer function test_update_frequency_slice_probe() bind(c) result(err) + use output + use mod_testOutputUtils + use FDETYPES_TOOLS + use mod_sggMethods + use mod_assertionTools + + ! Init inputs + type(SGGFDTDINFO) :: dummysgg + type(media_matrices_t), pointer :: mediaPtr + type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr + type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr + type(sim_control_t) :: dummyControl + type(solver_output_t), dimension(:), allocatable :: outputs + logical :: ThereAreWires = .false. + + !Auxiliar variables + type(media_matrices_t), target :: media + type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials + type(limit_t), dimension(1:6), target :: sinpml_fullsize + type(Obses_t) :: frequencySliceObservation + + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: mpidir = 3 + character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) + + !DummyField required variables + type(dummyFields_t), target :: dummyfields + type(fields_reference_t) :: fields + + err = 1 !If test_err is not updated at the end it will be shown + test_err = 0 + + ! Setup sgg + call sgg_init(dummysgg) + call init_time_array(timeArray, nTimeSteps, dt) + call sgg_set_tiempo(dummysgg, timeArray) + call sgg_set_dt(dummysgg, dt) + call init_simulation_material_list(simulationMaterials) + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + simulationMaterialsPtr => simulationMaterials + call sgg_set_Med(dummysgg, simulationMaterialsPtr) + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) + call sgg_set_NumPlaneWaves(dummysgg, 1) + call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + ! Define movie observation on sgg + frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5) + call sgg_add_observation(dummysgg, frequencySliceObservation) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) + !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE + !----- -------------------- -----! + mediaPtr => media + do iter = 1, 6 + sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + end do + sinpml_fullsizePtr => sinpml_fullsize + + dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + + ! Set dummy field status + + call create_dummy_fields(dummyfields, 1, 5, 0.1_RKIND) + fields%E%x => dummyfields%Ex + fields%E%y => dummyfields%Ey + fields%E%z => dummyfields%Ez + fields%E%deltax => dummyfields%dxe + fields%E%deltaY => dummyfields%dye + fields%E%deltaZ => dummyfields%dze + fields%H%x => dummyfields%Hx + fields%H%y => dummyfields%Hy + fields%H%z => dummyfields%Hz + fields%H%deltax => dummyfields%dxh + fields%H%deltaY => dummyfields%dyh + fields%H%deltaZ => dummyfields%dzh + + dummyfields%Hx(3, 3, 3) = 2.0_RKIND + dummyfields%Hy(3, 3, 3) = 5.0_RKIND + dummyfields%Hz(3, 3, 3) = 4.0_RKIND + + call update_outputs(outputs, mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, dummyControl, 0.5_RKIND_tiempo, fields) + + test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, 4, 'Unexpected number of columns') + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nMeasuredElements, expectedNumMeasurments, 'Unexpected number of measurments') + test_err = test_err + assert_integer_equal(size(outputs(1)%frequencySliceProbe%frequencySlice), expectedNumMeasurments * BuffObse, 'Unexpected allocation size') + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 1), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 2), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 3), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 4), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 5), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') + + call close_outputs(outputs) + + err = test_err +end function + +integer function test_flush_frequency_slice_probe() bind(c) result(err) + use output + use mod_testOutputUtils + use FDETYPES_TOOLS + use mod_sggMethods + use mod_assertionTools + + ! Init inputs + type(SGGFDTDINFO) :: dummysgg + type(media_matrices_t), pointer :: mediaPtr + type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr + type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr + type(sim_control_t) :: dummyControl + type(solver_output_t), dimension(:), allocatable :: outputs + logical :: ThereAreWires = .false. + + !Auxiliar variables + type(media_matrices_t), target :: media + type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials + type(limit_t), dimension(1:6), target :: sinpml_fullsize + type(Obses_t) :: movieObservable + type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + + real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: mpidir = 3 + character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) + character(len=BUFSIZE) :: expectedPath + + err = 1 !If test_err is not updated at the end it will be shown + test_err = 0 + + lowerBoundMovieProbe%x = 2 + lowerBoundMovieProbe%y = 2 + lowerBoundMovieProbe%z = 2 + + upperBoundMovieProbe%x = 5 + upperBoundMovieProbe%y = 5 + upperBoundMovieProbe%z = 5 + + ! Setup sgg + call sgg_init(dummysgg) + call init_time_array(timeArray, nTimeSteps, dt) + call sgg_set_tiempo(dummysgg, timeArray) + call sgg_set_dt(dummysgg, dt) + call init_simulation_material_list(simulationMaterials) + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + simulationMaterialsPtr => simulationMaterials + call sgg_set_Med(dummysgg, simulationMaterialsPtr) + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) + call sgg_set_NumPlaneWaves(dummysgg, 1) + call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + ! Define movie observation on sgg + movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) + call sgg_add_observation(dummysgg, movieObservable) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) + !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE + !----- -------------------- -----! + mediaPtr => media + do iter = 1, 6 + sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + end do + sinpml_fullsizePtr => sinpml_fullsize + + dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) !Dummy first update outputs(1)%movieProbe%serializedTimeSize = 1 outputs(1)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo - - outputs(1)%movieProbe%xValueForTime(1,1) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1,2) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1,3) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1,4) = 0.0_RKIND - - outputs(1)%movieProbe%yValueForTime(1,1) = 0.1_RKIND - outputs(1)%movieProbe%yValueForTime(1,2) = 0.2_RKIND - outputs(1)%movieProbe%yValueForTime(1,3) = 0.3_RKIND - outputs(1)%movieProbe%yValueForTime(1,4) = 0.4_RKIND - - outputs(1)%movieProbe%zValueForTime(1,1) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(1,2) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(1,3) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(1,4) = 0.0_RKIND + + outputs(1)%movieProbe%xValueForTime(1, 1) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(1, 2) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(1, 3) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(1, 4) = 0.0_RKIND + + outputs(1)%movieProbe%yValueForTime(1, 1) = 0.1_RKIND + outputs(1)%movieProbe%yValueForTime(1, 2) = 0.2_RKIND + outputs(1)%movieProbe%yValueForTime(1, 3) = 0.3_RKIND + outputs(1)%movieProbe%yValueForTime(1, 4) = 0.4_RKIND + + outputs(1)%movieProbe%zValueForTime(1, 1) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(1, 2) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(1, 3) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(1, 4) = 0.0_RKIND !Dummy second update outputs(1)%movieProbe%serializedTimeSize = 2 outputs(1)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo - - outputs(1)%movieProbe%xValueForTime(2,1) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(2,2) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(2,3) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(2,4) = 0.0_RKIND - - outputs(1)%movieProbe%yValueForTime(2,1) = 0.11_RKIND - outputs(1)%movieProbe%yValueForTime(2,2) = 0.22_RKIND - outputs(1)%movieProbe%yValueForTime(2,3) = 0.33_RKIND - outputs(1)%movieProbe%yValueForTime(2,4) = 0.44_RKIND - - outputs(1)%movieProbe%zValueForTime(2,1) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(2,2) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(2,3) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(2,4) = 0.0_RKIND + + outputs(1)%movieProbe%xValueForTime(2, 1) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2, 2) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2, 3) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2, 4) = 0.0_RKIND + + outputs(1)%movieProbe%yValueForTime(2, 1) = 0.11_RKIND + outputs(1)%movieProbe%yValueForTime(2, 2) = 0.22_RKIND + outputs(1)%movieProbe%yValueForTime(2, 3) = 0.33_RKIND + outputs(1)%movieProbe%yValueForTime(2, 4) = 0.44_RKIND + + outputs(1)%movieProbe%zValueForTime(2, 1) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(2, 2) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(2, 3) = 0.0_RKIND + outputs(1)%movieProbe%zValueForTime(2, 4) = 0.0_RKIND call flush_outputs(outputs) diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index d708de40..f138dfc0 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -12,6 +12,7 @@ module mod_testOutputUtils public :: create_point_probe_observation public :: create_volumic_probe_observation public :: create_movie_observation + public :: create_frequency_slice_observation public :: create_dummy_fields !=========================== @@ -21,7 +22,6 @@ module mod_testOutputUtils !=========================== - type :: dummyFields_t real(kind=RKIND), allocatable, dimension(:, :, :) :: Ex, Ey, Ez, Hx, Hy, Hz real(kind=RKIND), allocatable, dimension(:) :: dxe, dye, dze, dxh, dyh, dzh @@ -39,7 +39,7 @@ function create_point_probe_observation(x, y, z) result(obs) allocate (P(1)) P(1) = create_observable(x, y, z, x, y, z, iEx) call initialize_observation_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) - + call set_observation(obs, P, 'poinProbe', domain, 'DummyFileNormalize') end function @@ -73,6 +73,20 @@ function create_movie_observation(xi, yi, zi, xe, ye, ze) result(observation) call set_observation(observation, P, 'movieProbe', domain, 'DummyFileNormalize') end function create_movie_observation + function create_frequency_slice_observation(xi, yi, zi, xe, ye, ze) result(observation) + integer, intent(in) :: xi, yi, zi, xe, ye, ze + type(Obses_t) :: observation + + type(observable_t), dimension(:), allocatable :: P + type(observation_domain_t) :: domain + + allocate (P(1)) + P(1) = create_observable(xi, yi, zi, xe, ye, ze, iCur) + call initialize_observation_frequency_domain(domain, 0.0_RKIND, 100.0_RKIND, 20.0_RKIND) + + call set_observation(observation, P, 'frequency_sliceProbe', domain, 'DummyFileNormalize') + end function create_frequency_slice_observation + subroutine create_dummy_fields(this, lower, upper, delta) class(dummyFields_t), intent(inout) :: this integer, intent(in) :: lower, upper diff --git a/test/utils/assertion_tools.F90 b/test/utils/assertion_tools.F90 index 3a33aaba..5b2b81f0 100644 --- a/test/utils/assertion_tools.F90 +++ b/test/utils/assertion_tools.F90 @@ -53,6 +53,24 @@ function assert_real_time_equal(val, expected, tolerance, errorMessage) result(e end if end function assert_real_time_equal +function assert_complex_equal(val, expected, tolerance, errorMessage) result(err) + complex(kind=CKIND), intent(in) :: val, expected + real (kind=RKIND), intent(in) :: tolerance + character(len=*), intent(in) :: errorMessage + integer :: err + + if (abs(val - expected) <= tolerance) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, ' Value: ', val + print *, ' Expected: ', expected + print *, ' Delta: ', abs(val - expected) + print *, ' Tolerance:', tolerance + end if +end function assert_complex_equal + function assert_string_equal(val, expected, errorMessage) result(err) character(*), intent(in) :: val diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index 4abf9627..4f4d311e 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -57,7 +57,7 @@ module FDETYPES_TOOLS real(kind=RKIND) :: phiStep = 0.0_RKIND logical :: FreqDomain = .FALSE. - logical :: TimeDomain = .TRUE. + logical :: TimeDomain = .FALSE. logical :: Saveall = .FALSE. logical :: TransFer = .FALSE. logical :: Volumic = .FALSE. From 6951c754fec6ac6428e6b8f5c7f51295ef50a965 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 17 Dec 2025 11:22:21 +0100 Subject: [PATCH 37/67] Added wire and bulk probes flusher methods --- src_output/bulkProbeOutput.F90 | 39 +++++++++++++++ src_output/output.F90 | 20 +++++--- src_output/outputTypes.F90 | 5 +- src_output/pointProbeOutput.F90 | 6 +-- src_output/wireProbeOutput.F90 | 86 +++++++++++++++++++++++++++++++++ 5 files changed, 145 insertions(+), 11 deletions(-) diff --git a/src_output/bulkProbeOutput.F90 b/src_output/bulkProbeOutput.F90 index e1fdc6a3..9b0facce 100644 --- a/src_output/bulkProbeOutput.F90 +++ b/src_output/bulkProbeOutput.F90 @@ -37,6 +37,18 @@ end function get_output_path end subroutine init_bulk_probe_output + subroutine create_bulk_probe_output(this) + type(bulk_current_probe_output_t), intent(inout) :: this + character(len=BUFSIZE) :: file_time + integer(kind=SINGLE) :: err + err = 0 + + file_time = trim(adjustl(this%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & + trim(adjustl(datFileExtension)) + call create_or_clear_file(file_time, this%fileUnitTime, err) + end subroutine create_bulk_probe_output + subroutine update_bulk_probe_output(this, step, field) type(bulk_current_probe_output_t), intent(out) :: this real(kind=RKIND_tiempo), intent(in) :: step @@ -150,4 +162,31 @@ subroutine update_bulk_probe_output(this, step, field) end subroutine update_bulk_probe_output + subroutine flush_bulk_probe_output(this) + type(bulk_current_probe_output_t), intent(inout) :: this + character(len=BUFSIZE) :: filename + integer :: i + if (this%serializedTimeSize <= 0) then + print *, "No data to write." + return + end if + + filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) + open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") + + do i = 1, this%serializedTimeSize + write (this%fileUnitTime, fmt) this%timeStep(i), this%valueForTime(i) + end do + + close (this%fileUnitTime) + call clear_time_data() + contains + subroutine clear_time_data() + this%timeStep = 0.0_RKIND_tiempo + this%valueForTime = 0.0_RKIND + + this%serializedTimeSize = 0 + end subroutine clear_time_data + end subroutine flush_bulk_probe_output + end module mod_bulkProbeOutput diff --git a/src_output/output.F90 b/src_output/output.F90 index c56d45a9..7ba4aa7e 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -58,7 +58,10 @@ module output interface create_empty_files module procedure & - create_point_probe_output_files + create_point_probe_output_files, & + create_wire_current_probe_output, & + create_wire_charge_probe_output, & + create_bulk_probe_output end interface interface update_solver_output @@ -79,6 +82,9 @@ module output interface flush_solver_output module procedure & flush_point_probe_output, & + flush_wire_current_probe_output, & + flush_wire_charge_probe_output, & + flush_bulk_probe_output, & flush_movie_probe_output, & flush_frequency_slice_probe_output @@ -145,7 +151,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW allocate (outputs(outputCount)%pointProbe) call init_solver_output(outputs(outputCount)%pointProbe, lowerBound, outputRequestType, domain, outputTypeExtension, control%mpidir, sgg%dt) - + call create_empty_files(outputs(outputCount)%pointProbe) case (iJx, iJy, iJz) if (ThereAreWires) then outputCount = outputCount + 1 @@ -153,6 +159,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW allocate (outputs(outputCount)%wireCurrentProbe) call init_solver_output(outputs(outputCount)%wireCurrentProbe, lowerBound, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) + call create_empty_files(outputs(outputCount)%wireCurrentProbe) end if case (iQx, iQy, iQz) @@ -161,12 +168,15 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW allocate (outputs(outputCount)%wireChargeProbe) call init_solver_output(outputs(outputCount)%wireChargeProbe, lowerBound, NODE, outputRequestType, domain, outputTypeExtension, control%mpidir, control%wiresflavor) + call create_empty_files(outputs(outputCount)%wireChargeProbe) + case (iBloqueJx, iBloqueJy, iBloqueJz, iBloqueMx, iBloqueMy, iBloqueMz) outputCount = outputCount + 1 outputs(outputCount)%outputID = BULK_PROBE_ID allocate (outputs(outputCount)%bulkCurrentProbe) call init_solver_output(outputs(outputCount)%bulkCurrentProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control%mpidir) + call create_empty_files(outputs(outputCount)%bulkCurrentProbe) !! call adjust_computation_range --- Required due to issues in mpi region edges case (iCurX, iCurY, iCurZ) @@ -175,7 +185,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW allocate (outputs(outputCount)%volumicCurrentProbe) call init_solver_output(outputs(outputCount)%volumicCurrentProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir, sgg%dt) - + case (iCur) if (domain%domainType == TIME_DOMAIN) then @@ -231,7 +241,7 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep elseif (observation%FreqDomain) then !Just linear progression for now. Need to bring logartihmic info to here - nFreq = int((observation%FinalFreq - observation%InitialFreq)/observation%FreqStep, kind=SINGLE) + nFreq = int((observation%FinalFreq - observation%InitialFreq)/observation%FreqStep, kind=SINGLE) + 1_SINGLE newdomain = domain_t(observation%InitialFreq, observation%FinalFreq, nFreq, logarithmicspacing=.false.) newDomain%fstep = min(newDomain%fstep, 2.0_RKIND/simulationTimeStep) @@ -380,7 +390,6 @@ subroutine create_pvd(pdvPath, unitPVD) integer, intent(out) :: unitPVD integer :: ios - ! Abrimos el archivo PVD open(newunit=unitPVD, file=trim(pdvPath)//".pvd", status="replace", action="write", iostat=ios) if (ios /= 0) stop "Error al crear archivo PVD" @@ -394,7 +403,6 @@ subroutine close_pvd(unitPVD) implicit none integer, intent(in) :: unitPVD - ! Cerramos colección y archivo XML write (unitPVD, *) ' ' write (unitPVD, *) '' close (unitPVD) diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index aeb8b8a7..fb73c92a 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -65,7 +65,8 @@ module outputTypes end type point_probe_output_t type wire_charge_probe_output_t - integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus + integer(kind=SINGLE) :: columnas = 2_SINGLE + integer(kind=SINGLE) :: fileUnitTime type(domain_t) :: domain type(cell_coordinate_t) :: coordinates character(len=BUFSIZE) :: path @@ -86,6 +87,7 @@ module outputTypes type wire_current_probe_output_t integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus + integer(kind=SINGLE) :: fileUnitTime type(domain_t) :: domain type(cell_coordinate_t) :: coordinates character(len=BUFSIZE) :: path @@ -107,6 +109,7 @@ module outputTypes type bulk_current_probe_output_t integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field + integer(kind=SINGLE) :: fileUnitTime type(domain_t) :: domain type(cell_coordinate_t) :: lowerBound type(cell_coordinate_t) :: upperBound diff --git a/src_output/pointProbeOutput.F90 b/src_output/pointProbeOutput.F90 index 4ca0886b..06069f14 100644 --- a/src_output/pointProbeOutput.F90 +++ b/src_output/pointProbeOutput.F90 @@ -109,7 +109,7 @@ subroutine flush_point_probe_output(this) type(point_probe_output_t), intent(inout) :: this if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then call flush_time_domain(this) - call clear_time_data(this) + call clear_time_data() end if if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then call flush_frequency_domain(this) @@ -160,9 +160,7 @@ subroutine flush_frequency_domain(this) close (this%fileUnitFreq) end subroutine flush_frequency_domain - subroutine clear_time_data(this) - type(point_probe_output_t), intent(inout) :: this - !Only required for time domain, frequency overwrites itself on every update + subroutine clear_time_data() this%timeStep = 0.0_RKIND_tiempo this%valueForTime = 0.0_RKIND diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index f5477737..a29660a1 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -15,8 +15,12 @@ module mod_wireProbeOutput !=========================== public :: init_wire_current_probe_output public :: init_wire_charge_probe_output + public :: create_wire_current_probe_output + public :: create_wire_charge_probe_output public :: update_wire_current_probe_output public :: update_wire_charge_probe_output + public :: flush_wire_current_probe_output + public :: flush_wire_charge_probe_output !=========================== contains @@ -265,8 +269,33 @@ function get_probe_bounds_extension() result(ext) return end function get_probe_bounds_extension + end subroutine init_wire_charge_probe_output + subroutine create_wire_current_probe_output(this) + type(wire_current_probe_output_t), intent(inout) :: this + character(len=BUFSIZE) :: file_time + integer(kind=SINGLE) :: err + err = 0 + + file_time = trim(adjustl(this%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & + trim(adjustl(datFileExtension)) + call create_or_clear_file(file_time, this%fileUnitTime, err) + end subroutine create_wire_current_probe_output + + subroutine create_wire_charge_probe_output(this) + character(len=BUFSIZE) :: file_time + type(wire_charge_probe_output_t), intent(inout) :: this + integer(kind=SINGLE) :: err + err = 0 + + file_time = trim(adjustl(this%path))//'_'// & + trim(adjustl(timeExtension))//'_'// & + trim(adjustl(datFileExtension)) + call create_or_clear_file(file_time, this%fileUnitTime, err) + end subroutine create_wire_charge_probe_output + subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank, InvEps, InvMu) type(wire_current_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step @@ -356,4 +385,61 @@ subroutine update_wire_charge_probe_output(this, step) SegmDumm => this%segment this%chargeValue(this%serializedTimeSize) = SegmDumm%ChargeMinus%ChargePresent end subroutine update_wire_charge_probe_output + + subroutine flush_wire_current_probe_output(this) + type(wire_current_probe_output_t), intent(inout) :: this + character(len=BUFSIZE) :: filename + integer :: i + + filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) + open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") + + do i = 1, this%serializedTimeSize + write (this%fileUnitTime, fmt) this%timeStep(i), & + this%currentValues%current, & + this%currentValues%deltaVoltage, & + this%currentValues%plusVoltage, & + this%currentValues%minusVoltage, & + this%currentValues%voltageDiference + end do + close (this%fileUnitTime) + + call clear_time_data() + contains + subroutine clear_time_data() + this%timeStep = 0.0_RKIND_tiempo + + this%currentValues%current = 0.0_RKIND + this%currentValues%deltaVoltage = 0.0_RKIND + this%currentValues%plusVoltage = 0.0_RKIND + this%currentValues%minusVoltage = 0.0_RKIND + this%currentValues%voltageDiference = 0.0_RKIND + + this%serializedTimeSize = 0 + end subroutine clear_time_data + end subroutine flush_wire_current_probe_output + + subroutine flush_wire_charge_probe_output(this) + type(wire_charge_probe_output_t), intent(inout) :: this + character(len=BUFSIZE) :: filename + integer :: i + + filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) + open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") + + do i = 1, this%serializedTimeSize + write (this%fileUnitTime, fmt) this%timeStep(i), & + this%chargeValue + end do + close (this%fileUnitTime) + call clear_time_data() + contains + subroutine clear_time_data() + this%timeStep = 0.0_RKIND_tiempo + + this%chargeValue = 0.0_RKIND + + this%serializedTimeSize = 0 + end subroutine clear_time_data + end subroutine flush_wire_charge_probe_output end module mod_wireProbeOutput From e966e2b217d610d7767987aebb9b858143ccabca Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 18 Dec 2025 15:30:46 +0100 Subject: [PATCH 38/67] Added ff to outputs --- src_output/CMakeLists.txt | 1 + src_output/farFieldProbeOutput.F90 | 97 +++++++++++++++++++++++++++ src_output/output.F90 | 101 ++++++++++++++++++----------- src_output/outputTypes.F90 | 20 +++++- 4 files changed, 180 insertions(+), 39 deletions(-) create mode 100644 src_output/farFieldProbeOutput.F90 diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index e047e620..74f9847c 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -9,6 +9,7 @@ add_library(fdtd-output "volumicProbeOutput.F90" "movieProbeOutput.F90" "frequencySliceProbeOutput.F90" + "farFieldProbeOutput.F90" ) target_link_libraries(fdtd-output semba-types diff --git a/src_output/farFieldProbeOutput.F90 b/src_output/farFieldProbeOutput.F90 new file mode 100644 index 00000000..7eed9bf2 --- /dev/null +++ b/src_output/farFieldProbeOutput.F90 @@ -0,0 +1,97 @@ +module mod_farFieldOutput + use outputTypes + use Report + use mod_outputUtils + 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, control, outputTypeExtension, fileNormalize, eps0, mu0, geometricMedia, SINPML_fullsize, bounds) + type(far_field_probe_output_t), intent(out) :: this + type(domain_t), intent(in) :: domain + type(SGGFDTDINFO), 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 + type(media_matrices_t), intent(in) :: geometricMedia + type(limit_t), dimension(:), intent(in) :: SINPML_fullsize + character(len=*), intent(in) :: fileNormalize, outputTypeExtension + real(kind=RKIND), intent(in) :: mu0, eps0 + type(bounds_t), intent(in) :: bounds + + if (domain%domainType /= TIME_DOMAIN) call StopOnError(0, 0, "Unexpected domain type for farField probe") + + this%domain = domain + this%sphericRange = sphericRange + this%fieldComponent = field + this%path = get_output_path() + this%fileUnitFreq = 2025 !Dummy unit for now + + call InitFarField(sgg, & + geometricMedia%sggMiEx,geometricMedia%sggMiEy,geometricMedia%sggMiEz,geometricMedia%sggMiHx,geometricMedia%sggMiHy,geometricMedia%sggMiHz, & + control%layoutnumber, control%size, bounds, control%resume, & + this%fileUnitFreq, 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, SINPML_fullsize, & + control%facesNF2FF, control%NF2FFDecim, & +#ifdef CompileWithMPI + output(ii)%item(i)%MPISubComm, output(ii)%item(i)%MPIRoot, & +#endif + eps0, mu0) + + contains + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, 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%size, 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 mod_farFieldOutput diff --git a/src_output/output.F90 b/src_output/output.F90 index 7ba4aa7e..c7b99bd3 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -9,8 +9,32 @@ module output use mod_volumicProbeOutput use mod_movieProbeOutput use mod_frequencySliceProbeOutput + use mod_farFieldOutput implicit none + private + + !=========================== + ! Public interface summary + !=========================== + public :: solver_output_t + public :: GetOutputs + public :: init_outputs + public :: update_outputs + public :: flush_outputs + public :: close_outputs + + public :: POINT_PROBE_ID, WIRE_CURRENT_PROBE_ID, WIRE_CHARGE_PROBE_ID, BULK_PROBE_ID, VOLUMIC_CURRENT_PROBE_ID, & + MOVIE_PROBE_ID, FREQUENCY_SLICE_PROBE_ID, FAR_FIELD_PROBE_ID + !=========================== + + !=========================== + ! Private interface summary + !=========================== + private :: get_required_output_count + !=========================== + + integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0, & WIRE_CURRENT_PROBE_ID = 1, & @@ -18,10 +42,8 @@ module output BULK_PROBE_ID = 3, & VOLUMIC_CURRENT_PROBE_ID = 4, & MOVIE_PROBE_ID = 5, & - FREQUENCY_SLICE_PROBE_ID = 6 - - REAL(KIND=RKIND), save :: eps0, mu0 - REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu + FREQUENCY_SLICE_PROBE_ID = 6, & + FAR_FIELD_PROBE_ID = 7 type solver_output_t integer(kind=SINGLE) :: outputID @@ -32,14 +54,9 @@ module output type(volumic_current_probe_t), allocatable :: volumicCurrentProbe !icurX, icurY, icurZ type(volumic_field_probe_output_t), allocatable :: volumicFieldProbe type(line_integral_probe_output_t), allocatable :: lineIntegralProbe - type(far_field_probe_output_t), allocatable :: farFieldProbe - type(movie_probe_output_t), allocatable :: movieProbe - type(frequency_slice_probe_output_t), allocatable :: frequencySliceProbe - !type(volumic_field_probe_t), allocatable :: volumicFieldProbe - !type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe - !type(far_field_t), allocatable :: farField - !type(time_movie_output_t), allocatable :: timeMovie - !type(frequency_slice_output_t), allocatable :: frequencySlice + type(movie_probe_output_t), allocatable :: movieProbe !iCur if timeDomain + type(frequency_slice_probe_output_t), allocatable :: frequencySliceProbe !iCur if freqDomain + type(far_field_probe_output_t), allocatable :: farFieldOutput !farfield end type solver_output_t interface init_solver_output @@ -50,10 +67,8 @@ module output init_bulk_probe_output, & init_volumic_probe_output, & init_movie_probe_output, & - init_frequency_slice_probe_output - !init_far_field, & - !initime_movie_output, & - !init_frequency_slice_output + init_frequency_slice_probe_output, & + init_farField_probe_output end interface interface create_empty_files @@ -72,11 +87,8 @@ module output update_bulk_probe_output, & update_volumic_probe_output, & update_movie_probe_output, & - update_frequency_slice_probe_output - !update_bulk_current_probe_output, & - !update_far_field, & - !updateime_movie_output, & - !update_frequency_slice_output + update_frequency_slice_probe_output, & + update_farField_probe_output end interface interface flush_solver_output @@ -86,24 +98,10 @@ module output flush_wire_charge_probe_output, & flush_bulk_probe_output, & flush_movie_probe_output, & - flush_frequency_slice_probe_output + flush_frequency_slice_probe_output, & + flush_farField_probe_output - !flush_wire_probe_output, & - !flush_bulk_current_probe_output, & - !flush_far_field, & - !flushime_movie_output, & - !flush_frequency_slice_output end interface - - !interface delete_solver_output - ! module procedure & - ! delete_point_probe_output - ! !delete_wire_probe_output, & - ! !delete_bulk_current_probe_output, & - ! !delete_far_field, & - ! !deleteime_movie_output, & - ! !delete_frequency_slice_output - !end interface contains subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreWires) @@ -115,13 +113,19 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW logical :: ThereAreWires type(domain_t) :: domain + type(spheric_domain_t) :: sphericRange type(cell_coordinate_t) :: lowerBound, upperBound integer(kind=SINGLE) :: i, ii, outputRequestType integer(kind=SINGLE) :: NODE integer(kind=SINGLE) :: outputCount + integer(kind=SINGLE) :: requestedOutputs character(len=BUFSIZE) :: outputTypeExtension - allocate (outputs(sgg%NumberRequest)) + OutputRequested = .false. + requestedOutputs = get_required_output_count(sgg) + + outputs => NULL() + allocate (outputs(requestedOutputs)) allocate (InvEps(0:sgg%NumMedia - 1), InvMu(0:sgg%NumMedia - 1)) outputCount = 0 @@ -204,11 +208,20 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW call create_pvd(outputs(outputCount)%frequencySliceProbe%path, outputs(outputCount)%frequencySliceProbe%PDVUnit) end if + case (farfield) + sphericRange = preprocess_polar_range(sgg%Observation(ii)) + + outputCount = outputCount + 1 + outputs(outputCount)%outputID = FAR_FIELD_PROBE_ID + allocate (outputs(outputCount)%farFieldOutput) + call init_solver_output(outputs(outputCount)%farFieldOutput, sgg, lowerBound, upperBound,outputRequestType, domain, sphericRange, control, outputTypeExtension, sgg%Observation(ii)%FileNormalize, eps0, mu0, media, SINPML_fullsize, bounds) case default call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') end select end do end do + + if (outputCount /= 0) OutputRequested = .true. return contains function preprocess_domain(observation, timeArray, simulationTimeStep, finalStepIndex) result(newDomain) @@ -258,6 +271,18 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep return end function preprocess_domain + function preprocess_polar_range(observation) result(sphericDomain) + type(spheric_domain_t) :: sphericDomain + type(Obses_t), intent(in) :: observation + + sphericDomain%phiStart = observation%phiStart + sphericDomain%phiStop = observation%phiStop + sphericDomain%phiStep = observation%phiStep + sphericDomain%thetaStart = observation%thetaStart + sphericDomain%thetaStop = observation%thetaStop + sphericDomain%thetaStep = observation%thetaStep + end function preprocess_polar_range + end subroutine init_outputs subroutine create_output_files(outputs) diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index fb73c92a..8bf62f6b 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -29,6 +29,11 @@ module outputTypes logical :: logarithmicSpacing = .false. end type domain_t + type spheric_domain_t + real(kind=RKIND) :: phiStart = 0.0_RKIND, phiStop = 0.0_RKIND, phiStep = 0.0_RKIND + real(kind=RKIND) :: thetaStart = 0.0_RKIND, thetaStop = 0.0_RKIND, thetastep = 0.0_RKIND + end type + type cell_coordinate_t integer(kind=SINGLE) :: x,y,z end type cell_coordinate_t @@ -162,7 +167,20 @@ module outputTypes !!!!!Pending end type line_integral_probe_output_t type far_field_probe_output_t - !!!!!Pending + integer(kind=SINGLE) :: fileUnitFreq + integer(kind=SINGLE) :: fieldComponent + integer(kind=SINGLE) :: columnas = 6_SINGLE !reference and current components + type(domain_t) :: domain + type(spheric_domain_t) :: sphericRange + type(cell_coordinate_t) :: lowerBound + type(cell_coordinate_t) :: upperBound + character(len=BUFSIZE) :: path + + integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE + integer(kind=SINGLE), dimension(:,:), allocatable :: coords + integer(kind=SINGLE) :: nFreq = 0_SINGLE + real(kind=RKIND), dimension(:), allocatable :: frequencySlice + complex(kind=CKIND), dimension(:, :), allocatable :: valueForFreq end type far_field_probe_output_t type movie_probe_output_t integer(kind=SINGLE) :: PDVUnit From fcbe79c0d73b65f5312dd587e3e217cae65b9487 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 18 Dec 2025 15:32:20 +0100 Subject: [PATCH 39/67] Link output to main workflow. Fixed pointer assigment error --- CMakeLists.txt | 8 +- src_main_pub/timestepping.F90 | 44 ++++++- src_output/bulkProbeOutput.F90 | 2 +- src_output/frequencySliceProbeOutput.F90 | 30 ++--- src_output/movieProbeOutput.F90 | 30 ++--- src_output/output.F90 | 151 +++++++++++++---------- src_output/outputUtils.F90 | 32 ++--- src_output/volumicProbeOutput.F90 | 10 +- src_output/wireProbeOutput.F90 | 2 +- test/output/test_output.F90 | 132 ++++++++++++++------ 10 files changed, 282 insertions(+), 159 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b19933c5..bda25379 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -28,7 +28,12 @@ option(SEMBA_FDTD_MAIN_LIB "Compiles main library" ON) option(SEMBA_FDTD_COMPONENTS_LIB "Compiles components library" ON) option(SEMBA_FDTD_OUTPUTS_LIB "Compiles outputs library" ON) +option(SEMBA_FDTD_ENABLE_OUTPUT_MODULE "Use new output module" OFF) + # Compilation defines. +if(SEMBA_FDTD_ENABLE_OUTPUT_MODULE) + add_definitions(-DCompileWithNewOutputModule) +endif() if(SEMBA_FDTD_ENABLE_SMBJSON) add_definitions(-DCompileWithSMBJSON) endif() @@ -257,7 +262,8 @@ if(SEMBA_FDTD_MAIN_LIB) "src_main_pub/timestepping.F90" ) target_link_libraries(semba-main - semba-outputs + semba-outputs + fdtd-output ${SMBJSON_LIBRARIES} ${MTLN_LIBRARIES}) endif() diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 873e3e9a..50f95c99 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -20,6 +20,10 @@ module Solver_mod use report use PostProcessing use Ilumina +#ifdef CompileWithNewOutputModule + use output + use outputTypes +#endif use Observa use BORDERS_other use Borders_CPML @@ -1500,10 +1504,13 @@ subroutine initializeObservation() call MPI_Barrier(SUBCOMM_MPI,ierr) #endif write(dubuf,*) 'Init Observation...'; call print11(this%control%layoutnumber,dubuf) +#ifdef CompileWithNewOutputModule + call init_outputs(this%sgg, this%media, this%sinPML_fullsize, this%control, this%thereAre%wires, this%bounds, this%thereAre%Observation) +#else call InitObservation (this%sgg,this%media,this%tag_numbers, & this%thereAre%Observation,this%thereAre%wires,this%thereAre%FarFields,this%initialtimestep,this%lastexecutedtime, & this%sinPML_fullsize,this%eps0,this%mu0,this%bounds, this%control) - +#endif l_auxinput=this%thereAre%Observation.or.this%thereAre%FarFields l_auxoutput=l_auxinput @@ -1769,6 +1776,10 @@ subroutine solver_run(this) real(kind=rkind), pointer, dimension (:,:,:) :: Ex, Ey, Ez, Hx, Hy, Hz real(kind=rkind), pointer, dimension (:) :: Idxe, Idye, Idze, Idxh, Idyh, Idzh, dxe, dye, dze, dxh, dyh, dzh +#ifdef CompileWithNewOutputModule + type(fields_reference_t) :: fieldReference +#endif + logical :: call_timing, l_aux, flushFF, somethingdone, newsomethingdone integer :: i real (kind=rkind) :: pscale_alpha @@ -1794,6 +1805,23 @@ subroutine solver_run(this) Idxe => this%Idxe; Idye => this%Idye; Idze => this%Idze; Idxh => this%Idxh; Idyh => this%Idyh; Idzh => this%Idzh; dxe => this%dxe; dye => this%dye; dze => this%dze; dxh => this%dxh; dyh => this%dyh; dzh => this%dzh +#ifdef CompileWithNewOutputModule + fieldReference%E%x => this%Ex + fieldReference%E%y => this%Ey + fieldReference%E%z => this%Ez + + fieldReference%E%deltax => this%dxe + fieldReference%E%deltay => this%dye + fieldReference%E%deltaz => this%dze + + fieldReference%H%x => this%Hx + fieldReference%H%y => this%Hy + fieldReference%H%z => this%Hz + + fieldReference%H%deltax => this%dxh + fieldReference%H%deltay => this%dyh + fieldReference%H%deltaz => this%dzh +#endif ciclo_temporal : DO while (this%n <= this%control%finaltimestep) @@ -1869,9 +1897,11 @@ subroutine solver_run(this) call print11(this%control%layoutnumber,SEPARADOR//separador//separador) call print11(this%control%layoutnumber,dubuf) call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - !! +#ifdef CompileWithNewOutputModule + if (this%thereAre%Observation) call flush_outputs(this%sgg%tiempo, this%n, this%control, fieldReference, this%bounds, flushFF) +#else if (this%thereAre%Observation) call FlushObservationFiles(this%sgg,this%ini_save, this%n,this%control%layoutnumber, this%control%size, dxe, dye, dze, dxh, dyh, dzh,this%bounds,this%control%singlefilewrite,this%control%facesNF2FF,flushFF) - !! +#endif #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) #endif @@ -2020,11 +2050,19 @@ subroutine solver_run(this) subroutine updateAndFlush() integer(kind=4) :: mindum IF (this%thereAre%Observation) then +#ifdef CompileWithNewOutputModule + call update_outputs(this%media, this%sgg%Med, this%sinPML_fullsize,this%control, this%sgg%tiempo, this%n + 1, fieldReference, this%bounds) + if (this%n>=this%ini_save+BuffObse) then + mindum=min(this%control%finaltimestep,this%ini_save+BuffObse) + call FlushObservationFiles(this%sgg,this%ini_save,mindum,this%control%layoutnumber,this%control%size, dxe, dye, dze, dxh, dyh, dzh,this%bounds,this%control%singlefilewrite,this%control%facesNF2FF,.FALSE.) !no se flushean los farfields ahora + endif +#else call UpdateObservation(this%sgg,this%media,this%tag_numbers, this%n,this%ini_save, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh,this%control%wiresflavor,this%sinPML_fullsize,this%control%wirecrank, this%control%noconformalmapvtk,this%bounds) if (this%n>=this%ini_save+BuffObse) then mindum=min(this%control%finaltimestep,this%ini_save+BuffObse) call FlushObservationFiles(this%sgg,this%ini_save,mindum,this%control%layoutnumber,this%control%size, dxe, dye, dze, dxh, dyh, dzh,this%bounds,this%control%singlefilewrite,this%control%facesNF2FF,.FALSE.) !no se flushean los farfields ahora endif +#endif endif end subroutine diff --git a/src_output/bulkProbeOutput.F90 b/src_output/bulkProbeOutput.F90 index 9b0facce..d0269edd 100644 --- a/src_output/bulkProbeOutput.F90 +++ b/src_output/bulkProbeOutput.F90 @@ -50,7 +50,7 @@ subroutine create_bulk_probe_output(this) end subroutine create_bulk_probe_output subroutine update_bulk_probe_output(this, step, field) - type(bulk_current_probe_output_t), intent(out) :: this + type(bulk_current_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step type(field_data_t), intent(in) :: field diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index 85137943..4f9beeec 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -26,14 +26,14 @@ module mod_frequencySliceProbeOutput contains subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir, timeInterval) - type(frequency_slice_probe_output_t), intent(inout) :: this + type(frequency_slice_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(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + type(MediaData_t), dimension(:), intent(in) :: registeredMedia + type(media_matrices_t), intent(in) :: geometryMedia + type(limit_t), dimension(:), intent(in) :: sinpml_fullsize type(domain_t), intent(in) :: domain real(kind=RKIND_tiempo), intent(in) :: timeInterval @@ -84,10 +84,10 @@ subroutine update_frequency_slice_probe_output(this, step, geometryMedia, regist type(frequency_slice_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize - type(fields_reference_t), pointer, intent(in) :: fieldsReference + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:), intent(in) :: registeredMedia + type(limit_t), dimension(:), intent(in) :: sinpml_fullsize + type(fields_reference_t), intent(in) :: fieldsReference select case (this%fieldComponent) case (iCur) @@ -107,9 +107,9 @@ end subroutine flush_frequency_slice_probe_output subroutine get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) type(frequency_slice_probe_output_t), intent(inout) :: this - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:) :: registeredMedia + type(limit_t), dimension(:), intent(in) :: sinpml_fullsize integer(kind=SINGLE) :: i, j, k, field integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend @@ -170,11 +170,11 @@ end subroutine get_measurements_coords subroutine save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) type(frequency_slice_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step - type(fields_reference_t), pointer, intent(in) :: fieldsReference + type(fields_reference_t), intent(in) :: fieldsReference - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:) :: registeredMedia + type(limit_t), dimension(:), intent(in) :: sinpml_fullsize integer(kind=SINGLE) :: i, j, k, field integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 623a938e..b1fbb50f 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -26,14 +26,14 @@ module mod_movieProbeOutput contains subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir) - type(movie_probe_output_t), intent(inout) :: this + type(movie_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(MediaData_t), pointer, dimension(:) :: registeredMedia - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + type(MediaData_t), dimension(:) :: registeredMedia + type(media_matrices_t), intent(in) :: geometryMedia + type(limit_t), dimension(:), intent(in) :: sinpml_fullsize type(domain_t), intent(in) :: domain @@ -71,10 +71,10 @@ subroutine update_movie_probe_output(this, step, geometryMedia, registeredMedia, type(movie_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize - type(fields_reference_t), pointer, intent(in) :: fieldsReference + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:), intent(in) :: registeredMedia + type(limit_t), dimension(:), intent(in) :: sinpml_fullsize + type(fields_reference_t), intent(in) :: fieldsReference this%serializedTimeSize = this%serializedTimeSize + 1 @@ -106,9 +106,9 @@ end subroutine flush_movie_probe_output subroutine get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) type(movie_probe_output_t), intent(inout) :: this - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:), intent(in) :: registeredMedia + type(limit_t), dimension(:), intent(in) :: sinpml_fullsize integer(kind=SINGLE) :: i, j, k, field integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend @@ -169,11 +169,11 @@ end subroutine get_measurements_coords subroutine save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) type(movie_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step - type(fields_reference_t), pointer, intent(in) :: fieldsReference + type(fields_reference_t), intent(in) :: fieldsReference - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:) :: registeredMedia + type(limit_t), dimension(:), intent(in) :: sinpml_fullsize integer(kind=SINGLE) :: i, j, k, field integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend diff --git a/src_output/output.F90 b/src_output/output.F90 index c7b99bd3..baffaf37 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -10,7 +10,7 @@ module output use mod_movieProbeOutput use mod_frequencySliceProbeOutput use mod_farFieldOutput - + implicit none private @@ -59,6 +59,10 @@ module output type(far_field_probe_output_t), allocatable :: farFieldOutput !farfield end type solver_output_t + REAL(KIND=RKIND), save :: eps0, mu0 + REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu + type(solver_output_t), pointer, dimension(:), save :: outputs + interface init_solver_output module procedure & init_point_probe_output, & @@ -100,17 +104,24 @@ module output flush_movie_probe_output, & flush_frequency_slice_probe_output, & flush_farField_probe_output - + end interface contains - subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreWires) + function GetOutputs() result(r) + type(solver_output_t), pointer, dimension(:) :: r + r => outputs + return + end function + + subroutine init_outputs(sgg, media, sinpml_fullsize, control, ThereAreWires, bounds, OutputRequested) type(SGGFDTDINFO), intent(in) :: sgg - type(media_matrices_t), pointer, intent(in) :: media - type(limit_t), pointer, dimension(:), intent(in) :: SINPML_fullsize + type(media_matrices_t), intent(in) :: media + type(limit_t), dimension(:), intent(in) :: SINPML_fullsize + type(bounds_t) :: bounds type(sim_control_t), intent(inout) :: control - type(solver_output_t), dimension(:), allocatable, intent(out) :: outputs - logical :: ThereAreWires + logical, intent(inout) :: ThereAreWires + logical, intent(out) :: OutputRequested type(domain_t) :: domain type(spheric_domain_t) :: sphericRange @@ -183,13 +194,6 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, outputs, ThereAreW call create_empty_files(outputs(outputCount)%bulkCurrentProbe) !! call adjust_computation_range --- Required due to issues in mpi region edges - case (iCurX, iCurY, iCurZ) - outputCount = outputCount + 1 - outputs(outputCount)%outputID = VOLUMIC_CURRENT_PROBE_ID - - allocate (outputs(outputCount)%volumicCurrentProbe) - call init_solver_output(outputs(outputCount)%volumicCurrentProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, sinpml_fullsize, outputTypeExtension, control%mpidir, sgg%dt) - case (iCur) if (domain%domainType == TIME_DOMAIN) then @@ -285,8 +289,7 @@ end function preprocess_polar_range end subroutine init_outputs - subroutine create_output_files(outputs) - type(solver_output_t), dimension(:), intent(inout) :: outputs + subroutine create_output_files() integer(kind=SINGLE) :: i do i = 1, size(outputs) select case (outputs(i)%outputID) @@ -295,46 +298,48 @@ subroutine create_output_files(outputs) end do end subroutine create_output_files - subroutine update_outputs(outputs, geometryMedia, materialList, SINPML_fullsize , control, step, fields) - type(solver_output_t), dimension(:), intent(inout) :: outputs - real(kind=RKIND_tiempo) :: step + subroutine update_outputs(geometryMedia, materialList, SINPML_fullsize, control, discreteTimeArray, timeIndx, fieldsReference, bounds) + integer(kind=SINGLE), intent(in) :: timeIndx + real(kind=RKIND_tiempo), dimension(:), intent(in) :: discreteTimeArray integer(kind=SINGLE) :: i, id - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t),dimension(:), pointer :: materialList - type(limit_t), pointer, dimension(:), intent(in) :: SINPML_fullsize + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:) :: materialList + type(limit_t), dimension(:), intent(in) :: SINPML_fullsize type(sim_control_t), intent(in) :: control + type(bounds_t), intent(in) :: bounds real(kind=RKIND), pointer, dimension(:, :, :) :: fieldComponent - type(field_data_t), pointer :: fieldReference - type(fields_reference_t), target :: fields - type(fields_reference_t), pointer :: fieldsPtr + type(field_data_t) :: fieldReference + type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND_tiempo) :: discreteTime - fieldsPtr => fields + discreteTime = discreteTimeArray(timeIndx) do i = 1, size(outputs) select case (outputs(i)%outputID) case (POINT_PROBE_ID) - fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent, fields) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos - call update_solver_output(outputs(i)%pointProbe, step, fieldComponent) + fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos + call update_solver_output(outputs(i)%pointProbe, discreteTime, fieldComponent) case (WIRE_CURRENT_PROBE_ID) - call update_solver_output(outputs(i)%wireCurrentProbe, step, control%wiresflavor, control%wirecrank, InvEps, InvMu) + call update_solver_output(outputs(i)%wireCurrentProbe, discreteTime, control%wiresflavor, control%wirecrank, InvEps, InvMu) case (WIRE_CHARGE_PROBE_ID) - call update_solver_output(outputs(i)%wireChargeProbe, step) + call update_solver_output(outputs(i)%wireChargeProbe, discreteTime) case (BULK_PROBE_ID) - fieldReference => get_field_reference(outputs(i)%bulkCurrentProbe%fieldComponent, fields) - call update_solver_output(outputs(i)%bulkCurrentProbe, step, fieldReference) + fieldReference = get_field_reference(outputs(i)%bulkCurrentProbe%fieldComponent) + call update_solver_output(outputs(i)%bulkCurrentProbe, discreteTime, fieldReference) case (MOVIE_PROBE_ID) - call update_solver_output(outputs(i)%movieProbe, step, geometryMedia, materialList, SINPML_fullsize, fieldsPtr) - case(FREQUENCY_SLICE_PROBE_ID) - call update_solver_output(outputs(i)%frequencySliceProbe, step, geometryMedia, materialList, SINPML_fullsize, fieldsPtr) + call update_solver_output(outputs(i)%movieProbe, discreteTime, geometryMedia, materialList, SINPML_fullsize, fieldsReference) + case (FREQUENCY_SLICE_PROBE_ID) + call update_solver_output(outputs(i)%frequencySliceProbe, discreteTime, geometryMedia, materialList, SINPML_fullsize, fieldsReference) + case (FAR_FIELD_PROBE_ID) + call update_solver_output(outputs(i)%farFieldOutput, timeIndx, bounds, fieldsReference) case default call stoponerror(0, 0, 'Output update not implemented') end select end do contains - function get_field_component(fieldId, fieldsReference) result(field) + function get_field_component(fieldId) result(field) integer(kind=SINGLE), intent(in) :: fieldId - type(fields_reference_t), intent(in) :: fieldsReference real(kind=RKIND), pointer, dimension(:, :, :) :: field select case (fieldId) case (iEx); field => fieldsReference%E%x @@ -346,10 +351,9 @@ function get_field_component(fieldId, fieldsReference) result(field) end select end function get_field_component - function get_field_reference(fieldId, fieldsReference) result(field) + function get_field_reference(fieldId) result(field) integer(kind=SINGLE), intent(in) :: fieldId - type(fields_reference_t), intent(in) :: fieldsReference - type(field_data_t), pointer :: field + type(field_data_t) :: field select case (fieldId) case (iBloqueJx, iBloqueJy, iBloqueJz) field%x => fieldsReference%E%x @@ -372,50 +376,62 @@ end function get_field_reference end subroutine update_outputs - subroutine flush_outputs(outputs) - type(solver_output_t), dimension(:), intent(inout) :: outputs + subroutine flush_outputs(simulationTimeArray, simulationTimeIndex, control, fields, bounds, farFieldFlushRequested) + type(fields_reference_t), target :: fields + type(fields_reference_t), pointer :: fieldsPtr + type(sim_control_t), intent(in) :: control + type(bounds_t), intent(in) :: bounds + logical, intent(in) :: farFieldFlushRequested + real(KIND=RKIND_tiempo), pointer, dimension(:), intent(in) :: simulationTimeArray + integer, intent(in) :: simulationTimeIndex integer :: i + + fieldsPtr => fields + do i = 1, size(outputs) - select case(outputs(i)%outputID) - case(POINT_PROBE_ID) - call flush_point_probe_output(outputs(i)%pointProbe) - case(WIRE_CURRENT_PROBE_ID) - case(WIRE_CHARGE_PROBE_ID) - case(BULK_PROBE_ID) - case(VOLUMIC_CURRENT_PROBE_ID) - case(MOVIE_PROBE_ID) + select case (outputs(i)%outputID) + case (POINT_PROBE_ID) + call flush_solver_output(outputs(i)%pointProbe) + case (WIRE_CURRENT_PROBE_ID) + call flush_solver_output(outputs(i)%wireCurrentProbe) + case (WIRE_CHARGE_PROBE_ID) + call flush_solver_output(outputs(i)%wireChargeProbe) + case (BULK_PROBE_ID) + call flush_solver_output(outputs(i)%bulkCurrentProbe) + case (MOVIE_PROBE_ID) call flush_solver_output(outputs(i)%movieProbe) - case(FREQUENCY_SLICE_PROBE_ID) + case (FREQUENCY_SLICE_PROBE_ID) call flush_solver_output(outputs(i)%frequencySliceProbe) + case (FAR_FIELD_PROBE_ID) + if (farFieldFlushRequested) call flush_solver_output(outputs(i)%farFieldOutput, simulationTimeArray, simulationTimeIndex, control, fieldsPtr, bounds) + case default end select end do end subroutine flush_outputs - subroutine close_outputs(outputs) - type(solver_output_t), dimension(:), intent(inout) :: outputs + subroutine close_outputs() integer :: i do i = 1, size(outputs) - select case(outputs(i)%outputID) - case(POINT_PROBE_ID) - case(WIRE_CURRENT_PROBE_ID) - case(WIRE_CHARGE_PROBE_ID) - case(BULK_PROBE_ID) - case(VOLUMIC_CURRENT_PROBE_ID) - case(MOVIE_PROBE_ID) + select case (outputs(i)%outputID) + case (POINT_PROBE_ID) + case (WIRE_CURRENT_PROBE_ID) + case (WIRE_CHARGE_PROBE_ID) + case (BULK_PROBE_ID) + case (VOLUMIC_CURRENT_PROBE_ID) + case (MOVIE_PROBE_ID) call close_pvd(outputs(i)%movieProbe%PDVUnit) - case(FREQUENCY_SLICE_PROBE_ID) + case (FREQUENCY_SLICE_PROBE_ID) end select end do end subroutine - subroutine create_pvd(pdvPath, unitPVD) implicit none character(len=*), intent(in) :: pdvPath integer, intent(out) :: unitPVD integer :: ios - open(newunit=unitPVD, file=trim(pdvPath)//".pvd", status="replace", action="write", iostat=ios) + open (newunit=unitPVD, file=trim(pdvPath)//".pvd", status="replace", action="write", iostat=ios) if (ios /= 0) stop "Error al crear archivo PVD" ! Escribimos encabezados XML @@ -433,4 +449,13 @@ subroutine close_pvd(unitPVD) close (unitPVD) end subroutine close_pvd + function get_required_output_count(sgg) result(count) + type(SGGFDTDINFO), intent(in) :: sgg + integer(kind=SINGLE) ::i, count + count = 0 + do i = 1, sgg%NumberRequest + count = count + sgg%Observation(i)%nP + end do + return + end function end module output diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index fb783e67..4651bdff 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -296,8 +296,8 @@ integer function getBlockCurrentDirection(field) logical function isThinWire(field, i, j, k, geometryMedia, registeredMedia) integer(kind=4), intent(in) :: field, i, j, k - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:), intent(in) :: registeredMedia integer(kind=SINGLE) :: mediaIndex @@ -308,8 +308,8 @@ logical function isThinWire(field, i, j, k, geometryMedia, registeredMedia) logical function isPEC(field, i, j, k, geometryMedia, registeredMedia) integer(kind=4), intent(in) :: field, i, j, k - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:), intent(in) :: registeredMedia integer(kind=SINGLE) :: mediaIndex @@ -319,8 +319,8 @@ logical function isPEC(field, i, j, k, geometryMedia, registeredMedia) logical function isSurface(field, i, j, k, geometryMedia, registeredMedia) integer(kind=4), intent(in) :: field, i, j, k - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia + type(media_matrices_t), intent(in) :: geometryMedia + type(MediaData_t), dimension(:), intent(in) :: registeredMedia integer(kind=SINGLE) :: mediaIndex @@ -329,7 +329,7 @@ logical function isSurface(field, i, j, k, geometryMedia, registeredMedia) end function function getMediaIndex(field, i, j, k, media) result(res) - type(media_matrices_t), pointer, intent(in) :: media + type(media_matrices_t), intent(in) :: media integer(kind=4), intent(in) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: res select case (field) @@ -345,7 +345,7 @@ function getMediaIndex(field, i, j, k, media) result(res) logical function isWithinBounds(field, i, j, k, SINPML_fullsize) implicit none - TYPE(limit_t), pointer, DIMENSION(:), INTENT(IN) :: SINPML_fullsize + TYPE(limit_t), DIMENSION(:), INTENT(IN) :: SINPML_fullsize integer(kind=4), intent(in) :: field, i, j, k isWithinBounds = (i <= SINPML_fullsize(field)%XE) .and. & (j <= SINPML_fullsize(field)%YE) .and. & @@ -354,7 +354,7 @@ logical function isWithinBounds(field, i, j, k, SINPML_fullsize) logical function isMediaVacuum(field, i, j, k, media) implicit none - TYPE(media_matrices_t), pointer, INTENT(IN) :: media + TYPE(media_matrices_t), INTENT(IN) :: media integer(kind=4) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex, vacuum = 1 mediaIndex = getMediaIndex(field, i, j, k, media) @@ -363,8 +363,8 @@ logical function isMediaVacuum(field, i, j, k, media) logical function isSplitOrAdvanced(field, i, j, k, media, simulationMedia) implicit none - type(MediaData_t), pointer, dimension(:), intent(in) :: simulationMedia - type(media_matrices_t), pointer, intent(in) :: media + type(MediaData_t), dimension(:), intent(in) :: simulationMedia + type(media_matrices_t), intent(in) :: media integer(kind=4) :: field, i, j, k integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex mediaIndex = getMediaIndex(field, i, j, k, media) @@ -378,7 +378,7 @@ function computej(field, i, j, k, fields_reference) result(res) ! Input Arguments integer(kind=single), intent(in) :: field, i, j, k - type(fields_reference_t), pointer, intent(in) :: fields_reference + type(fields_reference_t), intent(in) :: fields_reference ! Local Variables integer(kind=single) :: i_shift_a, j_shift_a, k_shift_a ! Shift for Term A (Offset for H/M field) @@ -435,7 +435,7 @@ end function computej function computeJ1(f, i, j, k, fields_reference) result(res) implicit none integer(kind=4), intent(in) :: f, i, j, k - type(fields_reference_t), pointer, intent(in) :: fields_reference + type(fields_reference_t), intent(in) :: fields_reference integer(kind=4) :: c ! Complementary H-field index (Hy/Hz) real(kind=rkind) :: res real(kind=rkind) :: curl_h_term_a, curl_h_term_b, field_diff_term @@ -466,7 +466,7 @@ end function computeJ1 function computeJ2(f, i, j, k, fields_reference) result(res) implicit none integer(kind=4), intent(in) :: f, i, j, k - type(fields_reference_t), pointer, intent(in) :: fields_reference + type(fields_reference_t), intent(in) :: fields_reference integer(kind=4) :: c ! Complementary H-field index (Hx/Hy/Hz) real(kind=rkind) :: res real(kind=rkind) :: curl_h_term_a, curl_h_term_b, field_diff_term @@ -506,7 +506,7 @@ function get_field(field, i, j, k, fields_reference) result(res) implicit none real(kind=rkind) :: res integer(kind=4), intent(in) :: field, i, j, k - type(fields_reference_t), pointer, intent(in) :: fields_reference + type(fields_reference_t), intent(in) :: fields_reference ! Retrieves the field value based on the field index (1-3 for E, 4-6 for H) select case (field) @@ -523,7 +523,7 @@ function get_delta(field, i, j, k, fields_reference) result(res) implicit none real(kind=rkind) :: res integer(kind=4), intent(in) :: field, i, j, k - type(fields_reference_t), pointer, intent(in) :: fields_reference + type(fields_reference_t), intent(in) :: fields_reference ! Retrieves the spatial step size (delta) corresponding to the field direction ! Note: i, j, k are used to select the correct array index if the grid is non-uniform. diff --git a/src_output/volumicProbeOutput.F90 b/src_output/volumicProbeOutput.F90 index 225709e9..06e85c4b 100644 --- a/src_output/volumicProbeOutput.F90 +++ b/src_output/volumicProbeOutput.F90 @@ -126,7 +126,7 @@ subroutine update_volumic_probe_output(this, step, geometryMedia, registeredMedi type(media_matrices_t), pointer, intent(in) :: geometryMedia type(MediaData_t), pointer, dimension(:) :: registeredMedia type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize - type(fields_reference_t), pointer, intent(in) :: fieldsReference + type(fields_reference_t), intent(in) :: fieldsReference integer(kind=SINGLE) :: Efield, Hfield, i, j, k, conta integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2 @@ -185,7 +185,7 @@ subroutine update_volumic_probe_output(this, step, geometryMedia, registeredMedi end if contains subroutine save_current(this, Efield, i, j, k, conta, field_reference) - type(fields_reference_t), pointer, intent(in) :: field_reference + type(fields_reference_t), intent(in) :: field_reference type(volumic_current_probe_t), intent(inout) :: this integer(kind=SINGLE), intent(in) :: Efield, i, j, k, conta @@ -199,7 +199,7 @@ end subroutine save_current subroutine save_current_surfaces(this, Hfield, i, j, k, conta, field_reference) implicit none - type(fields_reference_t), pointer, intent(in) :: field_reference + type(fields_reference_t), intent(in) :: field_reference type(volumic_current_probe_t), intent(inout) :: this integer(kind=SINGLE), intent(in) :: Hfield, i, j, k, conta @@ -215,7 +215,7 @@ end subroutine save_current_surfaces subroutine update_current(this, Efield, i, j, k, conta, field_reference, step) integer(kind=SINGLE), intent(in) :: Efield, i, j, k, conta type(volumic_current_probe_t), intent(inout) :: this - type(fields_reference_t), pointer, intent(in) :: field_reference + type(fields_reference_t), intent(in) :: field_reference real(kind=RKIND_tiempo), intent(in) :: step integer(kind=SINGLE) :: freqIdx @@ -232,7 +232,7 @@ end subroutine update_current subroutine update_current_surfaces(this, Hfield, i, j, k, conta, field_reference, step) integer(kind=SINGLE), intent(in) :: Hfield, i, j, k, conta type(volumic_current_probe_t), intent(inout) :: this - type(fields_reference_t), pointer, intent(in) :: field_reference + type(fields_reference_t), intent(in) :: field_reference real(kind=RKIND_tiempo), intent(in) :: step integer(kind=SINGLE) :: freqIdx diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index a29660a1..1a739cb6 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -31,7 +31,7 @@ subroutine init_wire_current_probe_output(this, coordinates, node, field, domain character(len=BUFSIZE), intent(in) :: outputTypeExtension character(len=*), intent(in) :: wiresflavor type(domain_t), intent(in) :: domain - type(MediaData_t), pointer, dimension(:), intent(in) :: media + type(MediaData_t), dimension(:), intent(in) :: media type(cell_coordinate_t) :: coordinates diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 15440113..6cbfd4ad 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -6,15 +6,18 @@ integer function test_init_point_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools + type(solver_output_t), pointer, dimension(:) :: outputs + type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl type(media_matrices_t), pointer:: dummymedia => NULL() type(MediaData_t), dimension(:), allocatable, target :: simulationMedia type(MediaData_t), dimension(:), pointer :: simulationMediaPtr type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize => NULL() - type(solver_output_t), dimension(:), allocatable :: outputs + type(bounds_t) :: dummyBound type(MediaData_t) :: defaultMaterial, pecMaterial logical :: ThereAreWires = .false. + logical :: outputRequested type(Obses_t) :: pointProbeObservable @@ -24,9 +27,6 @@ integer function test_init_point_probe() bind(c) result(err) integer(kind=SINGLE) :: test_err = 0 - !Cleanup - if (allocated(outputs)) deallocate (outputs) - !Set requested observables call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) @@ -43,13 +43,15 @@ integer function test_init_point_probe() bind(c) result(err) !Set control flags dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') - call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, ThereAreWires, dummyBound, outputRequested) + + outputs => GetOutputs() test_err = test_err + assert_integer_equal(outputs(1)%outputID, POINT_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%pointProbe%columnas, 2, 'Unexpected number of columns') test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') - call close_outputs(outputs) + call close_outputs() deallocate (dummysgg%Observation) deallocate (outputs) @@ -60,22 +62,26 @@ integer function test_update_point_probe() bind(c) result(err) use FDETYPES use FDETYPES_TOOLS use output + use outputTypes use mod_testOutputUtils use mod_sggMethods use mod_assertionTools + type(solver_output_t), pointer, dimension(:) :: outputs + type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl type(media_matrices_t), pointer:: dummymedia => NULL() type(MediaData_t), dimension(:), allocatable, target :: simulationMedia type(MediaData_t), dimension(:), pointer :: simulationMediaPtr type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize => NULL() - type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .false. + logical :: outputRequested + type(bounds_t) :: dummyBound type(Obses_t) :: pointProbeObservable type(dummyFields_t), target :: dummyfields - type(fields_reference_t) :: fields + type(fields_reference_t) :: fields real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE @@ -95,7 +101,7 @@ integer function test_update_point_probe() bind(c) result(err) simulationMediaPtr => simulationMedia call sgg_set_Med(dummysgg, simulationMediaPtr) - call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, ThereAreWires, dummyBound, outputRequested) call create_dummy_fields(dummyfields, 1, 10, 0.01) @@ -113,18 +119,20 @@ integer function test_update_point_probe() bind(c) result(err) fields%H%deltaZ => dummyfields%dzh dummyfields%Ex(4, 4, 4) = 5.0_RKIND - call update_outputs(outputs, dummyMedia, simulationMediaPtr, dummysinpml_fullsize, dummyControl, 0.5_RKIND_tiempo, fields) + call update_outputs(dummyMedia, simulationMediaPtr, dummysinpml_fullsize, dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) + + outputs => GetOutputs() - test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(1), 0.5_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 1') + test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(1), 0.0_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 1') test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(1), 5.0_RKIND, 0.00001_RKIND, 'Unexpected field 1') dummyfields%Ex(4, 4, 4) = -4.0_RKIND - call update_outputs(outputs, dummyMedia, simulationMediaPtr, dummysinpml_fullsize, dummyControl, 0.8_RKIND_tiempo, fields) + call update_outputs(dummyMedia, simulationMediaPtr, dummysinpml_fullsize, dummyControl, dummysgg%tiempo, 2_SINGLE, fields, dummyBound) - test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(2), 0.8_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 2') + test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(2), 0.1_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 2') test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(2), -4.0_RKIND, 0.00001_RKIND, 'Unexpected field 2') - call close_outputs(outputs) + call close_outputs() if (associated(dummymedia)) deallocate (dummymedia) if (associated(dummysinpml_fullsize)) deallocate (dummysinpml_fullsize) @@ -134,6 +142,7 @@ end function test_update_point_probe integer function test_flush_point_probe() bind(c) result(err) use output + use mod_pointProbeOutput use mod_domain use mod_testOutputUtils use mod_assertionTools @@ -197,6 +206,7 @@ end function test_flush_point_probe integer function test_multiple_flush_point_probe() bind(c) result(err) use output + use mod_pointProbeOutput use mod_domain use mod_testOutputUtils use mod_assertionTools @@ -285,6 +295,8 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err use mod_sggMethods use mod_assertionTools + type(solver_output_t), pointer, dimension(:) :: outputs + integer(kind=RKIND) :: iter type(media_matrices_t), target :: media type(media_matrices_t), pointer :: mediaPtr @@ -295,12 +307,13 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err type(Obses_t) :: volumicProbeObservable type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl - type(solver_output_t), dimension(:), allocatable :: outputs + type(bounds_t) :: dummyBound type(MediaData_t) :: thinWireSimulationMaterial character(len=BUFSIZE) :: test_extension = trim(adjustl('tmp_cases/flush_point_probe')) integer(kind=SINGLE) :: mpidir = 3 logical :: ThereAreWires = .false. + logical :: outputRequested real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE @@ -341,32 +354,38 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err dummyControl = create_control_flags(mpidir=mpidir, nEntradaRoot='entradaRoot', wiresflavor='holland') - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + + outputs => GetOutputs() test_err = test_err + assert_integer_equal(outputs(1)%outputID, VOLUMIC_CURRENT_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%volumicCurrentProbe%columnas, 4, 'Unexpected number of columns') test_err = test_err + assert_string_equal(outputs(1)%volumicCurrentProbe%path, 'entradaRoot_volumicProbe_BCX_4_4_4__6_6_6', 'Unexpected path') - call close_outputs(outputs) + call close_outputs() err = test_err end function integer function test_init_movie_probe() bind(c) result(err) use output + use outputTypes use mod_testOutputUtils use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + type(solver_output_t), pointer, dimension(:) :: outputs + ! Init inputs type(SGGFDTDINFO) :: dummysgg type(media_matrices_t), pointer :: mediaPtr type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr type(sim_control_t) :: dummyControl - type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .false. + logical :: outputRequested + type(bounds_t) :: dummyBound !Auxiliar variables type(media_matrices_t), target :: media @@ -432,7 +451,9 @@ integer function test_init_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + + outputs => GetOutputs() test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, 4, 'Unexpected number of columns') @@ -442,26 +463,31 @@ integer function test_init_movie_probe() bind(c) result(err) test_err = 1 end if - call close_outputs(outputs) + call close_outputs() err = test_err end function integer function test_update_movie_probe() bind(c) result(err) use output + use outputTypes use mod_testOutputUtils use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + type(solver_output_t), pointer, dimension(:) :: outputs + + ! Init inputs type(SGGFDTDINFO) :: dummysgg type(media_matrices_t), pointer :: mediaPtr type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr type(sim_control_t) :: dummyControl - type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .false. + logical :: outputRequested + type(bounds_t) :: dummyBound !Auxiliar variables type(media_matrices_t), target :: media @@ -481,6 +507,7 @@ integer function test_update_movie_probe() bind(c) result(err) !DummyField required variables type(dummyFields_t), target :: dummyfields type(fields_reference_t) :: fields + err = 1 !If test_err is not updated at the end it will be shown test_err = 0 @@ -525,8 +552,9 @@ integer function test_update_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + outputs => GetOutputs() ! Set dummy field status call create_dummy_fields(dummyfields, 1, 5, 0.1_RKIND) @@ -547,7 +575,7 @@ integer function test_update_movie_probe() bind(c) result(err) dummyfields%Hy(3, 3, 3) = 5.0_RKIND dummyfields%Hz(3, 3, 3) = 4.0_RKIND - call update_outputs(outputs, mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, dummyControl, 0.5_RKIND_tiempo, fields) + call update_outputs(mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, 4, 'Unexpected number of columns') @@ -561,26 +589,30 @@ integer function test_update_movie_probe() bind(c) result(err) test_err = 1 end if - call close_outputs(outputs) + call close_outputs() err = test_err end function integer function test_flush_movie_probe() bind(c) result(err) use output + use outputTypes use mod_testOutputUtils use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + type(solver_output_t), pointer, dimension(:) :: outputs + ! Init inputs type(SGGFDTDINFO) :: dummysgg type(media_matrices_t), pointer :: mediaPtr type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr type(sim_control_t) :: dummyControl - type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .false. + logical :: outputRequested + type(bounds_t) :: dummyBound !Auxiliar variables type(media_matrices_t), target :: media @@ -588,6 +620,7 @@ integer function test_flush_movie_probe() bind(c) result(err) type(limit_t), dimension(1:6), target :: sinpml_fullsize type(Obses_t) :: movieObservable type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + type(fields_reference_t) :: fields real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo @@ -641,7 +674,9 @@ integer function test_flush_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + + outputs => GetOutputs() !Dummy first update outputs(1)%movieProbe%serializedTimeSize = 1 @@ -681,7 +716,7 @@ integer function test_flush_movie_probe() bind(c) result(err) outputs(1)%movieProbe%zValueForTime(2, 3) = 0.0_RKIND outputs(1)%movieProbe%zValueForTime(2, 4) = 0.0_RKIND - call flush_outputs(outputs) + call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0001'//'.vtu' test_err = test_err + assert_file_exists(expectedPath) @@ -689,7 +724,7 @@ integer function test_flush_movie_probe() bind(c) result(err) expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0002'//'.vtu' test_err = test_err + assert_file_exists(expectedPath) - call close_outputs(outputs) + call close_outputs() expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'.pvd' test_err = test_err + assert_file_exists(expectedPath) @@ -699,19 +734,23 @@ integer function test_flush_movie_probe() bind(c) result(err) integer function test_init_frequency_slice_probe() bind(c) result(err) use output + use outputTypes use mod_testOutputUtils use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + type(solver_output_t), pointer, dimension(:) :: outputs + ! Init inputs type(SGGFDTDINFO) :: dummysgg type(media_matrices_t), pointer :: mediaPtr type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr type(sim_control_t) :: dummyControl - type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .false. + logical :: outputRequested + type(bounds_t) :: dummyBound !Auxiliar variables type(media_matrices_t), target :: media @@ -770,7 +809,9 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + + outputs => GetOutputs() test_err = test_err + assert_integer_equal(outputs(1)%outputID, FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, 4, 'Unexpected number of columns') @@ -780,26 +821,30 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) test_err = 1 end if - call close_outputs(outputs) + call close_outputs() err = test_err end function integer function test_update_frequency_slice_probe() bind(c) result(err) use output + use outputTypes use mod_testOutputUtils use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + type(solver_output_t), pointer, dimension(:) :: outputs + ! Init inputs type(SGGFDTDINFO) :: dummysgg type(media_matrices_t), pointer :: mediaPtr type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr type(sim_control_t) :: dummyControl - type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .false. + logical :: outputRequested + type(bounds_t) :: dummyBound !Auxiliar variables type(media_matrices_t), target :: media @@ -854,7 +899,9 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + + outputs => GetOutputs() ! Set dummy field status @@ -876,7 +923,7 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) dummyfields%Hy(3, 3, 3) = 5.0_RKIND dummyfields%Hz(3, 3, 3) = 4.0_RKIND - call update_outputs(outputs, mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, dummyControl, 0.5_RKIND_tiempo, fields) + call update_outputs(mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, 4, 'Unexpected number of columns') @@ -888,26 +935,30 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 4), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 5), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') - call close_outputs(outputs) + call close_outputs() err = test_err end function integer function test_flush_frequency_slice_probe() bind(c) result(err) use output + use outputTypes use mod_testOutputUtils use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + type(solver_output_t), pointer, dimension(:) :: outputs + ! Init inputs type(SGGFDTDINFO) :: dummysgg type(media_matrices_t), pointer :: mediaPtr type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr type(sim_control_t) :: dummyControl - type(solver_output_t), dimension(:), allocatable :: outputs logical :: ThereAreWires = .false. + logical :: outputRequested + type(bounds_t) :: dummyBound !Auxiliar variables type(media_matrices_t), target :: media @@ -915,6 +966,7 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) type(limit_t), dimension(1:6), target :: sinpml_fullsize type(Obses_t) :: movieObservable type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + type(fields_reference_t) :: fields real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo @@ -968,7 +1020,9 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, outputs, ThereAreWires) + call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + + outputs => GetOutputs() !Dummy first update outputs(1)%movieProbe%serializedTimeSize = 1 @@ -1008,7 +1062,7 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) outputs(1)%movieProbe%zValueForTime(2, 3) = 0.0_RKIND outputs(1)%movieProbe%zValueForTime(2, 4) = 0.0_RKIND - call flush_outputs(outputs) + call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0001'//'.vtu' test_err = test_err + assert_file_exists(expectedPath) @@ -1016,7 +1070,7 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0002'//'.vtu' test_err = test_err + assert_file_exists(expectedPath) - call close_outputs(outputs) + call close_outputs() expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'.pvd' test_err = test_err + assert_file_exists(expectedPath) From 0aeb422280b08b94f46984eb86438fc4fb0fc90b Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 19 Dec 2025 12:42:47 +0100 Subject: [PATCH 40/67] Cleanup tests --- test/output/output_tests.h | 2 +- test/output/test_output.F90 | 1146 +++++++++-------- .../movie_and_frequency_slices.fdtd.json | 197 +++ .../probes/time_movie_over_cube.fdtd.json | 2 +- 4 files changed, 781 insertions(+), 566 deletions(-) create mode 100644 testData/input_examples/probes/movie_and_frequency_slices.fdtd.json diff --git a/test/output/output_tests.h b/test/output/output_tests.h index db209cc1..2cb64766 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -16,7 +16,7 @@ TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe TEST(output, test_update_point_probe_info) {EXPECT_EQ(0, test_update_point_probe()); } TEST(output, test_flush_point_probe_info) {EXPECT_EQ(0, test_flush_point_probe()); } TEST(output, test_flush_multiple_point_probe_info) {EXPECT_EQ(0, test_multiple_flush_point_probe()); } -TEST(output, test_volumic_probe_counter_relevant_surfaces) {EXPECT_EQ(0, test_volumic_probe_count_relevant_surfaces()); } +//TEST(output, test_volumic_probe_counter_relevant_surfaces) {EXPECT_EQ(0, test_volumic_probe_count_relevant_surfaces()); } TEST(output, test_init_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_init_movie_probe()); } TEST(output, test_update_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_update_movie_probe()); } TEST(output, test_flush_movie_probe_data) {EXPECT_EQ(0, test_flush_movie_probe()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 6cbfd4ad..2df5bbc6 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -6,57 +6,52 @@ integer function test_init_point_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools - type(solver_output_t), pointer, dimension(:) :: outputs - - type(SGGFDTDINFO) :: dummysgg - type(sim_control_t) :: dummyControl - type(media_matrices_t), pointer:: dummymedia => NULL() - type(MediaData_t), dimension(:), allocatable, target :: simulationMedia - type(MediaData_t), dimension(:), pointer :: simulationMediaPtr - type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize => NULL() - type(bounds_t) :: dummyBound - type(MediaData_t) :: defaultMaterial, pecMaterial - logical :: ThereAreWires = .false. - logical :: outputRequested - - type(Obses_t) :: pointProbeObservable - - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - - integer(kind=SINGLE) :: test_err = 0 - - !Set requested observables - call sgg_init(dummysgg) - call init_time_array(timeArray, nTimeSteps, dt) - call sgg_set_tiempo(dummysgg, timeArray) - call sgg_set_dt(dummysgg, dt) - - call init_simulation_material_list(simulationMedia) - simulationMediaPtr => simulationMedia - call sgg_set_Med(dummysgg, simulationMediaPtr) - - pointProbeObservable = create_point_probe_observation(4, 4, 4) - call sgg_add_observation(dummysgg, pointProbeObservable) - - !Set control flags - dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') - - call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, ThereAreWires, dummyBound, outputRequested) + type(SGGFDTDINFO) :: sgg + type(sim_control_t) :: control + type(bounds_t) :: bounds + type(media_matrices_t) :: media + type(limit_t), allocatable :: sinpml(:) + type(Obses_t) :: probe + type(solver_output_t), pointer :: outputs(:) + type(MediaData_t), allocatable, target :: materials(:) + type(MediaData_t), pointer :: materialsPtr(:) + + real(kind=RKIND_tiempo), pointer :: timeArray(:) + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nSteps = 100_SINGLE + logical :: outputRequested, hasWires = .false. + integer(kind=SINGLE) :: test_err = 0 + + call sgg_init(sgg) + call init_time_array(timeArray, nSteps, dt) + call sgg_set_tiempo(sgg, timeArray) + call sgg_set_dt(sgg, dt) + + call init_simulation_material_list(materials) + materialsPtr => materials + call sgg_set_Med(sgg, materialsPtr) + + probe = create_point_probe_observation(4, 4, 4) + call sgg_add_observation(sgg, probe) + + control = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') + + call init_outputs(sgg, media, sinpml, bounds, control, outputRequested, hasWires) outputs => GetOutputs() test_err = test_err + assert_integer_equal(outputs(1)%outputID, POINT_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%pointProbe%columnas, 2, 'Unexpected number of columns') - test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') + test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, & + 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') call close_outputs() + deallocate(sgg%Observation, outputs) - deallocate (dummysgg%Observation) - deallocate (outputs) err = test_err -end function test_init_point_probe +end function + + integer function test_update_point_probe() bind(c) result(err) use FDETYPES @@ -67,78 +62,74 @@ integer function test_update_point_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools - type(solver_output_t), pointer, dimension(:) :: outputs - - type(SGGFDTDINFO) :: dummysgg - type(sim_control_t) :: dummyControl - type(media_matrices_t), pointer:: dummymedia => NULL() - type(MediaData_t), dimension(:), allocatable, target :: simulationMedia - type(MediaData_t), dimension(:), pointer :: simulationMediaPtr - type(limit_t), pointer, dimension(:) :: dummysinpml_fullsize => NULL() - logical :: ThereAreWires = .false. - logical :: outputRequested - type(bounds_t) :: dummyBound - - type(Obses_t) :: pointProbeObservable - type(dummyFields_t), target :: dummyfields - type(fields_reference_t) :: fields - - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - - integer(kind=SINGLE) :: test_err = 0 - - call sgg_init(dummysgg) - call init_time_array(timeArray, nTimeSteps, dt) - call sgg_set_tiempo(dummysgg, timeArray) - call sgg_set_dt(dummysgg, dt) - pointProbeObservable = create_point_probe_observation(4, 4, 4) - call sgg_add_observation(dummysgg, pointProbeObservable) - dummyControl = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') - - call init_simulation_material_list(simulationMedia) - simulationMediaPtr => simulationMedia - call sgg_set_Med(dummysgg, simulationMediaPtr) - - call init_outputs(dummysgg, dummymedia, dummysinpml_fullsize, dummyControl, ThereAreWires, dummyBound, outputRequested) - - call create_dummy_fields(dummyfields, 1, 10, 0.01) - - fields%E%x => dummyfields%Ex - fields%E%y => dummyfields%Ey - fields%E%z => dummyfields%Ez - fields%E%deltax => dummyfields%dxe - fields%E%deltaY => dummyfields%dye - fields%E%deltaZ => dummyfields%dze - fields%H%x => dummyfields%Hx - fields%H%y => dummyfields%Hy - fields%H%z => dummyfields%Hz - fields%H%deltax => dummyfields%dxh - fields%H%deltaY => dummyfields%dyh - fields%H%deltaZ => dummyfields%dzh - - dummyfields%Ex(4, 4, 4) = 5.0_RKIND - call update_outputs(dummyMedia, simulationMediaPtr, dummysinpml_fullsize, dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) + type(SGGFDTDINFO) :: sgg + type(sim_control_t) :: control + type(bounds_t) :: bounds + type(media_matrices_t) :: media + type(limit_t), allocatable :: sinpml(:) + type(Obses_t) :: probe + type(solver_output_t), pointer :: outputs(:) + type(MediaData_t), allocatable, target :: materials(:) + type(MediaData_t), pointer :: materialsPtr(:) + + type(dummyFields_t), target :: dummyFields + type(fields_reference_t) :: fields + + real(kind=RKIND_tiempo), pointer :: timeArray(:) + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nSteps = 100_SINGLE + logical :: outputRequested, hasWires = .false. + integer(kind=SINGLE) :: test_err = 0 + + call sgg_init(sgg) + call init_time_array(timeArray, nSteps, dt) + call sgg_set_tiempo(sgg, timeArray) + call sgg_set_dt(sgg, dt) + + probe = create_point_probe_observation(4, 4, 4) + call sgg_add_observation(sgg, probe) + + call init_simulation_material_list(materials) + materialsPtr => materials + call sgg_set_Med(sgg, materialsPtr) + + control = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') + + call init_outputs(sgg, media, sinpml, bounds, control, outputRequested, hasWires) + + call create_dummy_fields(dummyFields, 1, 10, 0.01_RKIND) + + fields%E%x => dummyFields%Ex + fields%E%y => dummyFields%Ey + fields%E%z => dummyFields%Ez + fields%E%deltax => dummyFields%dxe + fields%E%deltaY => dummyFields%dye + fields%E%deltaZ => dummyFields%dze + fields%H%x => dummyFields%Hx + fields%H%y => dummyFields%Hy + fields%H%z => dummyFields%Hz + fields%H%deltax => dummyFields%dxh + fields%H%deltaY => dummyFields%dyh + fields%H%deltaZ => dummyFields%dzh + + dummyFields%Ex(4,4,4) = 5.0_RKIND + call update_outputs(media, materialsPtr, sinpml, control, sgg%tiempo, 1_SINGLE, fields, bounds) outputs => GetOutputs() - test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(1), 0.0_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 1') - test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(1), 5.0_RKIND, 0.00001_RKIND, 'Unexpected field 1') + test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(1), 0.0_RKIND_tiempo, 1e-5_RKIND_tiempo, 'Unexpected timestep 1') + test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(1), 5.0_RKIND, 1e-5_RKIND, 'Unexpected field 1') - dummyfields%Ex(4, 4, 4) = -4.0_RKIND - call update_outputs(dummyMedia, simulationMediaPtr, dummysinpml_fullsize, dummyControl, dummysgg%tiempo, 2_SINGLE, fields, dummyBound) + dummyFields%Ex(4,4,4) = -4.0_RKIND + call update_outputs(media, materialsPtr, sinpml, control, sgg%tiempo, 2_SINGLE, fields, bounds) - test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(2), 0.1_RKIND_tiempo, 0.00001_RKIND_tiempo, 'Unexpected timestep 2') - test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(2), -4.0_RKIND, 0.00001_RKIND, 'Unexpected field 2') + test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(2), 0.1_RKIND_tiempo, 1e-5_RKIND_tiempo, 'Unexpected timestep 2') + test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(2), -4.0_RKIND, 1e-5_RKIND, 'Unexpected field 2') call close_outputs() - if (associated(dummymedia)) deallocate (dummymedia) - if (associated(dummysinpml_fullsize)) deallocate (dummysinpml_fullsize) - err = test_err -end function test_update_point_probe +end function integer function test_flush_point_probe() bind(c) result(err) use output @@ -146,39 +137,49 @@ integer function test_flush_point_probe() bind(c) result(err) use mod_domain use mod_testOutputUtils use mod_assertionTools + type(point_probe_output_t) :: probe - type(domain_t):: domain - type(cell_coordinate_t) :: coordinates + type(domain_t) :: domain + type(cell_coordinate_t) :: coordinates + character(len=BUFSIZE) :: file_time, file_freq - character(len=27) :: test_extension + character(len=27) :: test_extension + integer :: n, i - err = 1 !If test_err is not updated at the end it will be shown - test_err = 0 + integer :: test_err = 0 + + err = 1 test_extension = 'tmp_cases/flush_point_probe' - domain = domain_t(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) + + domain = domain_t( & + 0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, & + 10.0_RKIND, 100.0_RKIND, 10, .false.) coordinates%x = 2 coordinates%y = 2 coordinates%z = 2 - call init_point_probe_output(probe, coordinates, iEx, domain, test_extension, 3, 0.1_RKIND_tiempo) + + call init_point_probe_output(probe, coordinates, iEx, domain, & + test_extension, 3, 0.1_RKIND_tiempo) call create_point_probe_output_files(probe) n = 10 do i = 1, n - probe%timeStep(i) = real(i) - probe%valueForTime(i) = 10.0*i - probe%frequencySlice(i) = 0.1*i - probe%valueForFreq(i) = 0.2*i + probe%timeStep(i) = real(i) + probe%valueForTime(i) = 10.0 * i + probe%frequencySlice(i) = 0.1 * i + probe%valueForFreq(i) = 0.2 * i end do + probe%serializedTimeSize = n - probe%nFreq = n + probe%nFreq = n file_time = trim(adjustl(probe%path))//'_'// & trim(adjustl(timeExtension))//'_'// & trim(adjustl(datFileExtension)) file_freq = trim(adjustl(probe%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & ! <-- SAME naming in your code + trim(adjustl(timeExtension))//'_'// & ! intentional: mirrors implementation trim(adjustl(datFileExtension)) call flush_point_probe_output(probe) @@ -186,46 +187,58 @@ integer function test_flush_point_probe() bind(c) result(err) test_err = test_err + assert_written_output_file(file_time) test_err = test_err + assert_written_output_file(file_freq) - test_err = test_err + assert_integer_equal(probe%serializedTimeSize, 0, "ERROR: clear_time_data did not reset serializedTimeSize!") - test_err = test_err + assert_integer_equal(probe%serializedTimeSize, 0, "ERROR: clear_time_data did not reset serializedTimeSize!") + test_err = test_err + assert_integer_equal( & + probe%serializedTimeSize, 0, & + 'ERROR: clear_time_data did not reset serializedTimeSize!') - if (all(probe%timeStep == 0.0) .and. all(probe%valueForTime == 0.0)) then - print *, "Time arrays cleared correctly." - else - print *, "ERROR: time arrays not cleared!" + if (.not. all(probe%timeStep == 0.0) .or. & + .not. all(probe%valueForTime == 0.0)) then + print *, 'ERROR: time arrays not cleared!' test_err = test_err + 1 end if if (probe%nFreq == 0) then - print *, "ERROR: Destroyed frequency reference!" + print *, 'ERROR: Destroyed frequency reference!' test_err = test_err + 1 end if err = test_err end function test_flush_point_probe + integer function test_multiple_flush_point_probe() bind(c) result(err) use output use mod_pointProbeOutput use mod_domain use mod_testOutputUtils use mod_assertionTools + type(point_probe_output_t) :: probe - type(domain_t):: domain - type(cell_coordinate_t) :: coordinates + type(domain_t) :: domain + type(cell_coordinate_t) :: coordinates + character(len=BUFSIZE) :: file_time, file_freq - real(kind=RKIND), allocatable :: expectedTime(:, :), expectedFreq(:, :) - character(len=36) :: test_extension + character(len=36) :: test_extension + + real(kind=RKIND), allocatable :: expectedTime(:, :) + real(kind=RKIND), allocatable :: expectedFreq(:, :) + integer :: n, i - err = 1 !If test_err is not updated at the end it will be shown - test_err = 0 + integer :: test_err = 0 + + err = 1 test_extension = 'tmp_cases/multiple_flush_point_probe' - domain = domain_t(0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, 10.0_RKIND, 100.0_RKIND, 10, .false.) + domain = domain_t( & + 0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, & + 10.0_RKIND, 100.0_RKIND, 10, .false.) + coordinates%x = 2 coordinates%y = 2 coordinates%z = 2 - call init_point_probe_output(probe, coordinates, iEx, domain, test_extension, 3, 0.1_RKIND_tiempo) + + call init_point_probe_output(probe, coordinates, iEx, domain, & + test_extension, 3, 0.1_RKIND_tiempo) call create_point_probe_output_files(probe) file_time = trim(adjustl(probe%path))//'_'// & @@ -237,57 +250,55 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) trim(adjustl(datFileExtension)) n = 10 - allocate (expectedTime(2*n, 2)) allocate (expectedFreq(n, 2)) - !Simulate updates in probe + do i = 1, n - probe%timeStep(i) = real(i) - probe%valueForTime(i) = 10.0*i - probe%frequencySlice(i) = 0.1*i - probe%valueForFreq(i) = 0.2*i + probe%timeStep(i) = real(i) + probe%valueForTime(i) = 10.0 * i + probe%frequencySlice(i) = 0.1 * i + probe%valueForFreq(i) = 0.2 * i expectedTime(i, 1) = real(i) - expectedTime(i, 2) = 10.0*i + expectedTime(i, 2) = 10.0 * i - expectedFreq(i, 1) = 0.1*i - expectedFreq(i, 2) = 0.2*i + expectedFreq(i, 1) = 0.1 * i + expectedFreq(i, 2) = 0.2 * i end do + probe%serializedTimeSize = n - probe%nFreq = n - !!!!!!!!!!!!!!!!!!!!!!!!!!!!! + probe%nFreq = n call flush_point_probe_output(probe) - !Simulate new updates in probe do i = 1, n - probe%timeStep(i) = real(i + 10) - probe%valueForTime(i) = 10.0*(i + 10) - probe%valueForFreq(i) = -0.5*i + probe%timeStep(i) = real(i + 10) + probe%valueForTime(i) = 10.0 * (i + 10) + probe%valueForFreq(i) = -0.5 * i - expectedTime(i + 10, 1) = real(i + 10) - expectedTime(i + 10, 2) = 10.0*(i + 10) + expectedTime(i + n, 1) = real(i + 10) + expectedTime(i + n, 2) = 10.0 * (i + 10) - expectedFreq(i, 1) = 0.1*i ! frequency file overwrites, so expectedFreq(i,1) remains 0.1*i ? - expectedFreq(i, 2) = -0.5*i + expectedFreq(i, 1) = 0.1 * i + expectedFreq(i, 2) = -0.5 * i end do + probe%serializedTimeSize = n - !!!!!!!!!!!!!!!!!!!!!!!!!!!!! call flush_point_probe_output(probe) - open (unit=probe%fileUnitTime, file=file_time, status="old", action="read") + open (unit=probe%fileUnitTime, file=file_time, status='old', action='read') test_err = test_err + assert_file_content(probe%fileUnitTime, expectedTime, 2*n, 2) close (probe%fileUnitTime) - open (unit=probe%fileUnitFreq, file=file_freq, status="old", action="read") + open (unit=probe%fileUnitFreq, file=file_freq, status='old', action='read') test_err = test_err + assert_file_content(probe%fileUnitFreq, expectedFreq, n, 2) close (probe%fileUnitFreq) err = test_err - end function test_multiple_flush_point_probe + integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err) use output use mod_testOutputUtils @@ -295,72 +306,78 @@ integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err use mod_sggMethods use mod_assertionTools - type(solver_output_t), pointer, dimension(:) :: outputs + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(bounds_t) :: dummyBound + type(solver_output_t), pointer :: outputs(:) - integer(kind=RKIND) :: iter type(media_matrices_t), target :: media type(media_matrices_t), pointer :: mediaPtr - type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials - type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr - type(limit_t), dimension(1:6), target :: sinpml_fullsize - type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr - type(Obses_t) :: volumicProbeObservable - type(SGGFDTDINFO) :: dummysgg - type(sim_control_t) :: dummyControl - type(bounds_t) :: dummyBound - - type(MediaData_t) :: thinWireSimulationMaterial - character(len=BUFSIZE) :: test_extension = trim(adjustl('tmp_cases/flush_point_probe')) - integer(kind=SINGLE) :: mpidir = 3 - logical :: ThereAreWires = .false. - logical :: outputRequested - - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - - integer(kind=SINGLE) :: test_err = 0 + + type(MediaData_t), allocatable, target :: simulationMaterials(:) + type(MediaData_t), pointer :: simulationMaterialsPtr(:) + type(MediaData_t) :: thinWireSimulationMaterial + + type(limit_t), target :: sinpml_fullsize(6) + type(limit_t), pointer :: sinpml_fullsizePtr(:) + + type(Obses_t) :: volumicProbeObservable + + real(kind=RKIND_tiempo), pointer :: timeArray(:) + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + + integer(kind=RKIND) :: iter + integer(kind=SINGLE) :: mpidir = 3 + logical :: ThereAreWires = .false. + logical :: outputRequested + integer(kind=SINGLE) :: test_err = 0 + + err = 1 call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) - call sgg_set_tiempo(dummysgg, timeArray) call sgg_set_dt(dummysgg, dt) - err = 1 !If test_err is not updated at the end it will be shown - test_err = 0 - do iter = 1, 6 sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) end do sinpml_fullsizePtr => sinpml_fullsize call init_simulation_material_list(simulationMaterials) + thinWireSimulationMaterial = create_thinWire_simulation_material(size(simulationMaterials)) call add_simulation_material(simulationMaterials, thinWireSimulationMaterial) + simulationMaterialsPtr => simulationMaterials + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + call sgg_set_Med(dummysgg, simulationMaterialsPtr) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) call assing_material_id_to_media_matrix_coordinate(media, iEy, 1, 1, 1, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iHz, 1, 1, 1, simulationMaterials(2)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEx, 2, 2, 2, thinWireSimulationMaterial%Id) mediaPtr => media - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) - simulationMaterialsPtr => simulationMaterials - call sgg_set_Med(dummysgg, simulationMaterialsPtr) - volumicProbeObservable = create_volumic_probe_observation(4, 4, 4, 6, 6, 6) call sgg_add_observation(dummysgg, volumicProbeObservable) dummyControl = create_control_flags(mpidir=mpidir, nEntradaRoot='entradaRoot', wiresflavor='holland') - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + outputRequested, ThereAreWires) outputs => GetOutputs() - test_err = test_err + assert_integer_equal(outputs(1)%outputID, VOLUMIC_CURRENT_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_integer_equal(outputs(1)%volumicCurrentProbe%columnas, 4, 'Unexpected number of columns') - test_err = test_err + assert_string_equal(outputs(1)%volumicCurrentProbe%path, 'entradaRoot_volumicProbe_BCX_4_4_4__6_6_6', 'Unexpected path') + test_err = test_err + assert_integer_equal(outputs(1)%outputID, & + VOLUMIC_CURRENT_PROBE_ID, 'Unexpected probe id') + + test_err = test_err + assert_integer_equal(outputs(1)%volumicCurrentProbe%columnas, & + 4, 'Unexpected number of columns') + + test_err = test_err + assert_string_equal(outputs(1)%volumicCurrentProbe%path, & + 'entradaRoot_volumicProbe_BCX_4_4_4__6_6_6', 'Unexpected path') call close_outputs() @@ -375,54 +392,49 @@ integer function test_init_movie_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools - type(solver_output_t), pointer, dimension(:) :: outputs + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(bounds_t) :: dummyBound + type(solver_output_t), pointer :: outputs(:) - ! Init inputs - type(SGGFDTDINFO) :: dummysgg - type(media_matrices_t), pointer :: mediaPtr - type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr - type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr - type(sim_control_t) :: dummyControl - logical :: ThereAreWires = .false. - logical :: outputRequested - type(bounds_t) :: dummyBound - - !Auxiliar variables type(media_matrices_t), target :: media - type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials - type(limit_t), dimension(1:6), target :: sinpml_fullsize - type(Obses_t) :: movieObservable - type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + type(media_matrices_t), pointer :: mediaPtr - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + type(MediaData_t), allocatable, target :: simulationMaterials(:) + type(MediaData_t), pointer :: simulationMaterialsPtr(:) - integer(kind=SINGLE) :: expectedNumMeasurments - integer(kind=SINGLE) :: mpidir = 3 - character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) + type(limit_t) :: sinpml(6) - err = 1 !If test_err is not updated at the end it will be shown - test_err = 0 + type(Obses_t) :: movieObservable + type(cell_coordinate_t) :: lowerBoundMovieProbe + type(cell_coordinate_t) :: upperBoundMovieProbe - lowerBoundMovieProbe%x = 2 - lowerBoundMovieProbe%y = 2 - lowerBoundMovieProbe%z = 2 + real(kind=RKIND_tiempo), pointer :: timeArray(:) + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - upperBoundMovieProbe%x = 5 - upperBoundMovieProbe%y = 5 - upperBoundMovieProbe%z = 5 + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: mpidir = 3 + logical :: ThereAreWires = .false. + logical :: outputRequested + integer(kind=SINGLE) :: iter + integer(kind=SINGLE) :: test_err = 0 - ! Setup sgg - call sgg_init(dummysgg) + character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + err = 1 + + lowerBoundMovieProbe = cell_coordinate_t(2, 2, 2) + upperBoundMovieProbe = cell_coordinate_t(5, 5, 5) + + call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) call sgg_set_tiempo(dummysgg, timeArray) call sgg_set_dt(dummysgg, dt) call init_simulation_material_list(simulationMaterials) - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) simulationMaterialsPtr => simulationMaterials + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) call sgg_set_Med(dummysgg, simulationMaterialsPtr) call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) @@ -430,44 +442,52 @@ integer function test_init_movie_probe() bind(c) result(err) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - ! Define movie observation on sgg movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) call sgg_add_observation(dummysgg, movieObservable) call create_geometry_media(media, 0, 8, 0, 8, 0, 8) - !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE - !----- -------------------- -----! mediaPtr => media do iter = 1, 6 - sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + sinpml(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) end do - sinpml_fullsizePtr => sinpml_fullsize dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + call init_outputs(dummysgg, media, sinpml, dummyBound, dummyControl, & + outputRequested, ThereAreWires) outputs => GetOutputs() - test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, 4, 'Unexpected number of columns') - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nMeasuredElements, expectedNumMeasurments, 'Unexpected number of measurments') - test_err = test_err + assert_integer_equal(size(outputs(1)%movieProbe%xValueForTime), expectedNumMeasurments * BuffObse, 'Unexpected allocation size') - if (size(outputs(1)%movieProbe%timeStep) /= BuffObse) then - test_err = 1 - end if + test_err = test_err + assert_integer_equal(outputs(1)%outputID, & + MOVIE_PROBE_ID, 'Unexpected probe id') + + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, & + 4, 'Unexpected number of columns') + + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nMeasuredElements, & + expectedNumMeasurments, 'Unexpected number of measurements') + + test_err = test_err + assert_integer_equal( & + size(outputs(1)%movieProbe%xValueForTime), & + expectedNumMeasurments * BuffObse, 'Unexpected allocation size') + + test_err = test_err + assert_integer_equal( & + size(outputs(1)%movieProbe%timeStep), BuffObse, 'Unexpected timestep buffer size') call close_outputs() err = test_err end function + integer function test_update_movie_probe() bind(c) result(err) use output use outputTypes @@ -476,75 +496,68 @@ integer function test_update_movie_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools - type(solver_output_t), pointer, dimension(:) :: outputs + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(bounds_t) :: dummyBound + type(solver_output_t), pointer :: outputs(:) - - ! Init inputs - type(SGGFDTDINFO) :: dummysgg - type(media_matrices_t), pointer :: mediaPtr - type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr - type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr - type(sim_control_t) :: dummyControl - logical :: ThereAreWires = .false. - logical :: outputRequested - type(bounds_t) :: dummyBound - - !Auxiliar variables type(media_matrices_t), target :: media - type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials - type(limit_t), dimension(1:6), target :: sinpml_fullsize - type(Obses_t) :: movieObservable - type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + type(media_matrices_t), pointer :: mediaPtr - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + type(MediaData_t), allocatable, target :: simulationMaterials(:) + type(MediaData_t), pointer :: simulationMaterialsPtr(:) - integer(kind=SINGLE) :: expectedNumMeasurments - integer(kind=SINGLE) :: mpidir = 3 - character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) + type(limit_t), target :: sinpml_fullsize(6) + type(limit_t), pointer :: sinpml_fullsizePtr(:) - !DummyField required variables - type(dummyFields_t), target :: dummyfields - type(fields_reference_t) :: fields - + type(Obses_t) :: movieObservable - err = 1 !If test_err is not updated at the end it will be shown - test_err = 0 + real(kind=RKIND_tiempo), pointer :: timeArray(:) + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - lowerBoundMovieProbe%x = 2 - lowerBoundMovieProbe%y = 2 - lowerBoundMovieProbe%z = 2 + type(dummyFields_t), target :: dummyFields + type(fields_reference_t) :: fields - upperBoundMovieProbe%x = 5 - upperBoundMovieProbe%y = 5 - upperBoundMovieProbe%z = 5 + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: mpidir = 3 + integer(kind=SINGLE) :: iter + integer(kind=SINGLE) :: test_err = 0 + logical :: ThereAreWires = .false. + logical :: outputRequested + + character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + + err = 1 - ! Setup sgg call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) call sgg_set_tiempo(dummysgg, timeArray) call sgg_set_dt(dummysgg, dt) + call init_simulation_material_list(simulationMaterials) - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) simulationMaterialsPtr => simulationMaterials + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) call sgg_set_Med(dummysgg, simulationMaterialsPtr) + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - ! Define movie observation on sgg + movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) call sgg_add_observation(dummysgg, movieObservable) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) - !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE - !----- -------------------- -----! mediaPtr => media + do iter = 1, 6 sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) end do @@ -552,48 +565,67 @@ integer function test_update_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + outputRequested, ThereAreWires) outputs => GetOutputs() - ! Set dummy field status - - call create_dummy_fields(dummyfields, 1, 5, 0.1_RKIND) - fields%E%x => dummyfields%Ex - fields%E%y => dummyfields%Ey - fields%E%z => dummyfields%Ez - fields%E%deltax => dummyfields%dxe - fields%E%deltaY => dummyfields%dye - fields%E%deltaZ => dummyfields%dze - fields%H%x => dummyfields%Hx - fields%H%y => dummyfields%Hy - fields%H%z => dummyfields%Hz - fields%H%deltax => dummyfields%dxh - fields%H%deltaY => dummyfields%dyh - fields%H%deltaZ => dummyfields%dzh - - dummyfields%Hx(3, 3, 3) = 2.0_RKIND - dummyfields%Hy(3, 3, 3) = 5.0_RKIND - dummyfields%Hz(3, 3, 3) = 4.0_RKIND - - call update_outputs(mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) - - test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, 4, 'Unexpected number of columns') - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nMeasuredElements, expectedNumMeasurments, 'Unexpected number of measurments') - test_err = test_err + assert_integer_equal(size(outputs(1)%movieProbe%xValueForTime), expectedNumMeasurments * BuffObse, 'Unexpected allocation size') - test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 1), 0.2_RKIND, 0.00001_RKIND, 'Value error') - test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 2), 0.0_RKIND, 0.00001_RKIND, 'Value error') - test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 3), 0.2_RKIND, 0.00001_RKIND, 'Value error') - test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 4), 0.0_RKIND, 0.00001_RKIND, 'Value error') - if (size(outputs(1)%movieProbe%timeStep) /= BuffObse) then - test_err = 1 - end if + + call create_dummy_fields(dummyFields, 1, 5, 0.1_RKIND) + + fields%E%x => dummyFields%Ex + fields%E%y => dummyFields%Ey + fields%E%z => dummyFields%Ez + fields%E%deltax => dummyFields%dxe + fields%E%deltaY => dummyFields%dye + fields%E%deltaZ => dummyFields%dze + fields%H%x => dummyFields%Hx + fields%H%y => dummyFields%Hy + fields%H%z => dummyFields%Hz + fields%H%deltax => dummyFields%dxh + fields%H%deltaY => dummyFields%dyh + fields%H%deltaZ => dummyFields%dzh + + dummyFields%Hx(3, 3, 3) = 2.0_RKIND + dummyFields%Hy(3, 3, 3) = 5.0_RKIND + dummyFields%Hz(3, 3, 3) = 4.0_RKIND + + call update_outputs(mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, & + dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) + + test_err = test_err + assert_integer_equal(outputs(1)%outputID, & + MOVIE_PROBE_ID, 'Unexpected probe id') + + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, & + 4, 'Unexpected number of columns') + + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nMeasuredElements, & + expectedNumMeasurments, 'Unexpected number of measurements') + + test_err = test_err + assert_integer_equal( & + size(outputs(1)%movieProbe%xValueForTime), & + expectedNumMeasurments * BuffObse, 'Unexpected allocation size') + + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1,1), & + 0.2_RKIND, 1e-5_RKIND, 'Value error') + + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1,2), & + 0.0_RKIND, 1e-5_RKIND, 'Value error') + + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1,3), & + 0.2_RKIND, 1e-5_RKIND, 'Value error') + + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1,4), & + 0.0_RKIND, 1e-5_RKIND, 'Value error') + + test_err = test_err + assert_integer_equal( & + size(outputs(1)%movieProbe%timeStep), BuffObse, 'Unexpected timestep buffer size') call close_outputs() err = test_err end function + integer function test_flush_movie_probe() bind(c) result(err) use output use outputTypes @@ -602,71 +634,67 @@ integer function test_flush_movie_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools - type(solver_output_t), pointer, dimension(:) :: outputs + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(bounds_t) :: dummyBound + type(solver_output_t), pointer :: outputs(:) - ! Init inputs - type(SGGFDTDINFO) :: dummysgg - type(media_matrices_t), pointer :: mediaPtr - type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr - type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr - type(sim_control_t) :: dummyControl - logical :: ThereAreWires = .false. - logical :: outputRequested - type(bounds_t) :: dummyBound - - !Auxiliar variables type(media_matrices_t), target :: media - type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials - type(limit_t), dimension(1:6), target :: sinpml_fullsize - type(Obses_t) :: movieObservable - type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe - type(fields_reference_t) :: fields - - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - - integer(kind=SINGLE) :: expectedNumMeasurments - integer(kind=SINGLE) :: mpidir = 3 - character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) - character(len=BUFSIZE) :: expectedPath + type(media_matrices_t), pointer :: mediaPtr - err = 1 !If test_err is not updated at the end it will be shown - test_err = 0 + type(MediaData_t), allocatable, target :: simulationMaterials(:) + type(MediaData_t), pointer :: simulationMaterialsPtr(:) - lowerBoundMovieProbe%x = 2 - lowerBoundMovieProbe%y = 2 - lowerBoundMovieProbe%z = 2 + type(limit_t), target :: sinpml_fullsize(6) + type(limit_t), pointer :: sinpml_fullsizePtr(:) - upperBoundMovieProbe%x = 5 - upperBoundMovieProbe%y = 5 - upperBoundMovieProbe%z = 5 + type(Obses_t) :: movieObservable + type(fields_reference_t) :: fields + + real(kind=RKIND_tiempo), pointer :: timeArray(:) + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: mpidir = 3 + integer(kind=SINGLE) :: iter + integer(kind=SINGLE) :: test_err = 0 + logical :: ThereAreWires = .false. + logical :: outputRequested + + character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + character(len=BUFSIZE) :: expectedPath + + err = 1 - ! Setup sgg call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) call sgg_set_tiempo(dummysgg, timeArray) call sgg_set_dt(dummysgg, dt) + call init_simulation_material_list(simulationMaterials) - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) simulationMaterialsPtr => simulationMaterials + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) call sgg_set_Med(dummysgg, simulationMaterialsPtr) + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - ! Define movie observation on sgg + movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) call sgg_add_observation(dummysgg, movieObservable) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) - !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE - !----- -------------------- -----! mediaPtr => media + do iter = 1, 6 sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) end do @@ -674,54 +702,25 @@ integer function test_flush_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + outputRequested, ThereAreWires) outputs => GetOutputs() - !Dummy first update - outputs(1)%movieProbe%serializedTimeSize = 1 - outputs(1)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo - - outputs(1)%movieProbe%xValueForTime(1, 1) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1, 2) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1, 3) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1, 4) = 0.0_RKIND - - outputs(1)%movieProbe%yValueForTime(1, 1) = 0.1_RKIND - outputs(1)%movieProbe%yValueForTime(1, 2) = 0.2_RKIND - outputs(1)%movieProbe%yValueForTime(1, 3) = 0.3_RKIND - outputs(1)%movieProbe%yValueForTime(1, 4) = 0.4_RKIND - - outputs(1)%movieProbe%zValueForTime(1, 1) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(1, 2) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(1, 3) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(1, 4) = 0.0_RKIND - - !Dummy second update outputs(1)%movieProbe%serializedTimeSize = 2 - outputs(1)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo - - outputs(1)%movieProbe%xValueForTime(2, 1) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(2, 2) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(2, 3) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(2, 4) = 0.0_RKIND - outputs(1)%movieProbe%yValueForTime(2, 1) = 0.11_RKIND - outputs(1)%movieProbe%yValueForTime(2, 2) = 0.22_RKIND - outputs(1)%movieProbe%yValueForTime(2, 3) = 0.33_RKIND - outputs(1)%movieProbe%yValueForTime(2, 4) = 0.44_RKIND + outputs(1)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo + outputs(1)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo - outputs(1)%movieProbe%zValueForTime(2, 1) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(2, 2) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(2, 3) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(2, 4) = 0.0_RKIND + outputs(1)%movieProbe%yValueForTime(1,:) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] + outputs(1)%movieProbe%yValueForTime(2,:) = [0.11_RKIND, 0.22_RKIND, 0.33_RKIND, 0.44_RKIND] call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) - expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0001'//'.vtu' + expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts0001.vtu' test_err = test_err + assert_file_exists(expectedPath) - expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0002'//'.vtu' + expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts0002.vtu' test_err = test_err + assert_file_exists(expectedPath) call close_outputs() @@ -732,6 +731,7 @@ integer function test_flush_movie_probe() bind(c) result(err) err = test_err end function + integer function test_init_frequency_slice_probe() bind(c) result(err) use output use outputTypes @@ -740,37 +740,38 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools - type(solver_output_t), pointer, dimension(:) :: outputs + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(bounds_t) :: dummyBound + type(solver_output_t), pointer :: outputs(:) - ! Init inputs - type(SGGFDTDINFO) :: dummysgg - type(media_matrices_t), pointer :: mediaPtr - type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr - type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr - type(sim_control_t) :: dummyControl - logical :: ThereAreWires = .false. - logical :: outputRequested - type(bounds_t) :: dummyBound - - !Auxiliar variables type(media_matrices_t), target :: media - type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials - type(limit_t), dimension(1:6), target :: sinpml_fullsize - type(Obses_t) :: frequencySliceObservation + type(media_matrices_t), pointer :: mediaPtr + + type(MediaData_t), allocatable, target :: simulationMaterials(:) + type(MediaData_t), pointer :: simulationMaterialsPtr(:) + + type(limit_t), target :: sinpml_fullsize(6) + type(limit_t), pointer :: sinpml_fullsizePtr(:) - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + type(Obses_t) :: frequencySliceObservation - integer(kind=SINGLE) :: expectedNumMeasurments - integer(kind=SINGLE) :: expectedTotalFrequnecies - integer(kind=SINGLE) :: mpidir = 3 - character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) + real(kind=RKIND_tiempo), pointer :: timeArray(:) + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - err = 1 !If test_err is not updated at the end it will be shown - test_err = 0 + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: expectedTotalFrequnecies + integer(kind=SINGLE) :: mpidir = 3 + integer(kind=SINGLE) :: iter + integer(kind=SINGLE) :: test_err = 0 + logical :: ThereAreWires = .false. + logical :: outputRequested + + character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + + err = 1 - ! Setup sgg call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) @@ -778,8 +779,8 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) call sgg_set_dt(dummysgg, dt) call init_simulation_material_list(simulationMaterials) - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) simulationMaterialsPtr => simulationMaterials + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) call sgg_set_Med(dummysgg, simulationMaterialsPtr) call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) @@ -787,19 +788,19 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - ! Define movie observation on sgg frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5) call sgg_add_observation(dummysgg, frequencySliceObservation) + expectedTotalFrequnecies = 6_SINGLE call create_geometry_media(media, 0, 8, 0, 8, 0, 8) - !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE - !----- -------------------- -----! mediaPtr => media do iter = 1, 6 @@ -809,23 +810,34 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + outputRequested, ThereAreWires) outputs => GetOutputs() - test_err = test_err + assert_integer_equal(outputs(1)%outputID, FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, 4, 'Unexpected number of columns') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nMeasuredElements, expectedNumMeasurments, 'Unexpected number of measurments') - test_err = test_err + assert_integer_equal(size(outputs(1)%frequencySliceProbe%xValueForFreq), expectedNumMeasurments * expectedTotalFrequnecies, 'Unexpected allocation size') - if (size(outputs(1)%frequencySliceProbe%frequencySlice) /= expectedTotalFrequnecies) then - test_err = 1 - end if + test_err = test_err + assert_integer_equal(outputs(1)%outputID, & + FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') + + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, & + 4, 'Unexpected number of columns') + + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nMeasuredElements, & + expectedNumMeasurments, 'Unexpected number of measurements') + + test_err = test_err + assert_integer_equal( & + size(outputs(1)%frequencySliceProbe%xValueForFreq), & + expectedNumMeasurments * expectedTotalFrequnecies, 'Unexpected allocation size') + + test_err = test_err + assert_integer_equal( & + size(outputs(1)%frequencySliceProbe%frequencySlice), & + expectedTotalFrequnecies, 'Unexpected frequency count') call close_outputs() err = test_err end function + integer function test_update_frequency_slice_probe() bind(c) result(err) use output use outputTypes @@ -834,64 +846,68 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools - type(solver_output_t), pointer, dimension(:) :: outputs + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(bounds_t) :: dummyBound + type(solver_output_t), pointer :: outputs(:) - ! Init inputs - type(SGGFDTDINFO) :: dummysgg - type(media_matrices_t), pointer :: mediaPtr - type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr - type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr - type(sim_control_t) :: dummyControl - logical :: ThereAreWires = .false. - logical :: outputRequested - type(bounds_t) :: dummyBound - - !Auxiliar variables type(media_matrices_t), target :: media - type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials - type(limit_t), dimension(1:6), target :: sinpml_fullsize - type(Obses_t) :: frequencySliceObservation + type(media_matrices_t), pointer :: mediaPtr - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + type(MediaData_t), allocatable, target :: simulationMaterials(:) + type(MediaData_t), pointer :: simulationMaterialsPtr(:) - integer(kind=SINGLE) :: expectedNumMeasurments - integer(kind=SINGLE) :: mpidir = 3 - character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) + type(limit_t), target :: sinpml_fullsize(6) + type(limit_t), pointer :: sinpml_fullsizePtr(:) - !DummyField required variables - type(dummyFields_t), target :: dummyfields - type(fields_reference_t) :: fields + type(Obses_t) :: frequencySliceObservation - err = 1 !If test_err is not updated at the end it will be shown - test_err = 0 + real(kind=RKIND_tiempo), pointer :: timeArray(:) + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + + type(dummyFields_t), target :: dummyFields + type(fields_reference_t) :: fields + + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: mpidir = 3 + integer(kind=SINGLE) :: iter + integer(kind=SINGLE) :: test_err = 0 + logical :: ThereAreWires = .false. + logical :: outputRequested + + character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + + err = 1 - ! Setup sgg call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) call sgg_set_tiempo(dummysgg, timeArray) call sgg_set_dt(dummysgg, dt) + call init_simulation_material_list(simulationMaterials) - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) simulationMaterialsPtr => simulationMaterials + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) call sgg_set_Med(dummysgg, simulationMaterialsPtr) + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - ! Define movie observation on sgg + frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5) call sgg_add_observation(dummysgg, frequencySliceObservation) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) - !----- Defining PEC surface -----! + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE - !----- -------------------- -----! mediaPtr => media + do iter = 1, 6 sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) end do @@ -899,47 +915,67 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) + call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + outputRequested, ThereAreWires) outputs => GetOutputs() - ! Set dummy field status - - call create_dummy_fields(dummyfields, 1, 5, 0.1_RKIND) - fields%E%x => dummyfields%Ex - fields%E%y => dummyfields%Ey - fields%E%z => dummyfields%Ez - fields%E%deltax => dummyfields%dxe - fields%E%deltaY => dummyfields%dye - fields%E%deltaZ => dummyfields%dze - fields%H%x => dummyfields%Hx - fields%H%y => dummyfields%Hy - fields%H%z => dummyfields%Hz - fields%H%deltax => dummyfields%dxh - fields%H%deltaY => dummyfields%dyh - fields%H%deltaZ => dummyfields%dzh - - dummyfields%Hx(3, 3, 3) = 2.0_RKIND - dummyfields%Hy(3, 3, 3) = 5.0_RKIND - dummyfields%Hz(3, 3, 3) = 4.0_RKIND - - call update_outputs(mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) - - test_err = test_err + assert_integer_equal(outputs(1)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, 4, 'Unexpected number of columns') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nMeasuredElements, expectedNumMeasurments, 'Unexpected number of measurments') - test_err = test_err + assert_integer_equal(size(outputs(1)%frequencySliceProbe%frequencySlice), expectedNumMeasurments * BuffObse, 'Unexpected allocation size') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 1), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 2), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 3), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 4), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 5), (0.2_CKIND ,0.2_CKIND), 0.00001_RKIND, 'Value error') + call create_dummy_fields(dummyFields, 1, 5, 0.1_RKIND) + + fields%E%x => dummyFields%Ex + fields%E%y => dummyFields%Ey + fields%E%z => dummyFields%Ez + fields%E%deltax => dummyFields%dxe + fields%E%deltaY => dummyFields%dye + fields%E%deltaZ => dummyFields%dze + fields%H%x => dummyFields%Hx + fields%H%y => dummyFields%Hy + fields%H%z => dummyFields%Hz + fields%H%deltax => dummyFields%dxh + fields%H%deltaY => dummyFields%dyh + fields%H%deltaZ => dummyFields%dzh + + dummyFields%Hx(3,3,3) = 2.0_RKIND + dummyFields%Hy(3,3,3) = 5.0_RKIND + dummyFields%Hz(3,3,3) = 4.0_RKIND + + call update_outputs(mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, & + dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) + + test_err = test_err + assert_integer_equal(outputs(1)%outputID, & + FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') + + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, & + 4, 'Unexpected number of columns') + + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nMeasuredElements, & + expectedNumMeasurments, 'Unexpected number of measurements') + + test_err = test_err + assert_integer_equal( & + size(outputs(1)%frequencySliceProbe%frequencySlice), & + expectedNumMeasurments * BuffObse, 'Unexpected allocation size') + + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,1), & + (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,2), & + (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,3), & + (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,4), & + (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,5), & + (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') call close_outputs() err = test_err end function + integer function test_flush_frequency_slice_probe() bind(c) result(err) use output use outputTypes @@ -948,122 +984,103 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) use mod_sggMethods use mod_assertionTools - type(solver_output_t), pointer, dimension(:) :: outputs + type(SGGFDTDINFO) :: dummysgg + type(sim_control_t) :: dummyControl + type(bounds_t) :: dummyBound + type(solver_output_t), pointer :: outputs(:) - ! Init inputs - type(SGGFDTDINFO) :: dummysgg - type(media_matrices_t), pointer :: mediaPtr - type(MediaData_t), dimension(:), pointer :: simulationMaterialsPtr - type(limit_t), dimension(:), pointer :: sinpml_fullsizePtr - type(sim_control_t) :: dummyControl - logical :: ThereAreWires = .false. - logical :: outputRequested - type(bounds_t) :: dummyBound - - !Auxiliar variables type(media_matrices_t), target :: media - type(MediaData_t), dimension(:), allocatable, target :: simulationMaterials - type(limit_t), dimension(1:6), target :: sinpml_fullsize - type(Obses_t) :: movieObservable - type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe - type(fields_reference_t) :: fields - - real(kind=RKIND_tiempo), pointer, dimension(:) :: timeArray - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - - integer(kind=SINGLE) :: expectedNumMeasurments - integer(kind=SINGLE) :: mpidir = 3 - character(len=BUFSIZE) :: test_folder_path = trim(adjustl('tmp_cases/')) - character(len=BUFSIZE) :: expectedPath + type(media_matrices_t), pointer :: mediaPtr + + type(MediaData_t), allocatable, target :: simulationMaterials(:) + type(MediaData_t), pointer :: simulationMaterialsPtr(:) - err = 1 !If test_err is not updated at the end it will be shown - test_err = 0 + type(limit_t), target :: sinpml_fullsize(6) + type(limit_t), pointer :: sinpml_fullsizePtr(:) + type(Obses_t) :: movieObservable + type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + type(fields_reference_t) :: fields + type(dummyFields_t), target :: dummyFields + + real(kind=RKIND_tiempo), pointer :: timeArray(:) + real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo + integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE + integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: mpidir = 3 + integer(kind=SINGLE) :: iter + integer(kind=SINGLE) :: test_err = 0 + logical :: ThereAreWires = .false. + logical :: outputRequested + character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + character(len=BUFSIZE) :: expectedPath + + err = 1 + + !--- Probe bounds --- lowerBoundMovieProbe%x = 2 lowerBoundMovieProbe%y = 2 lowerBoundMovieProbe%z = 2 - upperBoundMovieProbe%x = 5 upperBoundMovieProbe%y = 5 upperBoundMovieProbe%z = 5 - ! Setup sgg + !--- Setup SGG --- call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) call sgg_set_tiempo(dummysgg, timeArray) call sgg_set_dt(dummysgg, dt) + call init_simulation_material_list(simulationMaterials) - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) simulationMaterialsPtr => simulationMaterials + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) call sgg_set_Med(dummysgg, simulationMaterialsPtr) - call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) + + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0,0,0,6,6,6)) + call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1,1,1,5,5,5)) call sgg_set_NumPlaneWaves(dummysgg, 1) - call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - ! Define movie observation on sgg - movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) + call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0,0,0,6,6,6)) + + movieObservable = create_movie_observation(2,2,2,5,5,5) call sgg_add_observation(dummysgg, movieObservable) - call create_geometry_media(media, 0, 8, 0, 8, 0, 8) - !----- Defining PEC surface -----! - call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + + call create_geometry_media(media, 0,8,0,8,0,8) + call assing_material_id_to_media_matrix_coordinate(media,iEy,3,3,3,simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media,iEy,4,3,3,simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media,iEy,4,4,3,simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media,iEy,3,4,3,simulationMaterials(0)%Id) + expectedNumMeasurments = 4_SINGLE - !----- -------------------- -----! mediaPtr => media + do iter = 1, 6 - sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + sinpml_fullsize(iter) = create_limit_t(0,8,0,8,0,8,10,10,10) end do sinpml_fullsizePtr => sinpml_fullsize dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) - call init_outputs(dummysgg, mediaPtr, sinpml_fullsizePtr, dummyControl, ThereAreWires, dummyBound, outputRequested) - + call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + outputRequested, ThereAreWires) outputs => GetOutputs() - !Dummy first update + !--- Dummy first update --- outputs(1)%movieProbe%serializedTimeSize = 1 outputs(1)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo + outputs(1)%movieProbe%xValueForTime(1,:) = 0.0_RKIND + outputs(1)%movieProbe%yValueForTime(1,:) = [0.1_RKIND,0.2_RKIND,0.3_RKIND,0.4_RKIND] + outputs(1)%movieProbe%zValueForTime(1,:) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1, 1) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1, 2) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1, 3) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(1, 4) = 0.0_RKIND - - outputs(1)%movieProbe%yValueForTime(1, 1) = 0.1_RKIND - outputs(1)%movieProbe%yValueForTime(1, 2) = 0.2_RKIND - outputs(1)%movieProbe%yValueForTime(1, 3) = 0.3_RKIND - outputs(1)%movieProbe%yValueForTime(1, 4) = 0.4_RKIND - - outputs(1)%movieProbe%zValueForTime(1, 1) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(1, 2) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(1, 3) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(1, 4) = 0.0_RKIND - - !Dummy second update + !--- Dummy second update --- outputs(1)%movieProbe%serializedTimeSize = 2 outputs(1)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo - - outputs(1)%movieProbe%xValueForTime(2, 1) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(2, 2) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(2, 3) = 0.0_RKIND - outputs(1)%movieProbe%xValueForTime(2, 4) = 0.0_RKIND - - outputs(1)%movieProbe%yValueForTime(2, 1) = 0.11_RKIND - outputs(1)%movieProbe%yValueForTime(2, 2) = 0.22_RKIND - outputs(1)%movieProbe%yValueForTime(2, 3) = 0.33_RKIND - outputs(1)%movieProbe%yValueForTime(2, 4) = 0.44_RKIND - - outputs(1)%movieProbe%zValueForTime(2, 1) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(2, 2) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(2, 3) = 0.0_RKIND - outputs(1)%movieProbe%zValueForTime(2, 4) = 0.0_RKIND + outputs(1)%movieProbe%xValueForTime(2,:) = 0.0_RKIND + outputs(1)%movieProbe%yValueForTime(2,:) = [0.11_RKIND,0.22_RKIND,0.33_RKIND,0.44_RKIND] + outputs(1)%movieProbe%zValueForTime(2,:) = 0.0_RKIND call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) + !--- Assert generated files --- expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0001'//'.vtu' test_err = test_err + assert_file_exists(expectedPath) @@ -1077,3 +1094,4 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) err = test_err end function + diff --git a/testData/input_examples/probes/movie_and_frequency_slices.fdtd.json b/testData/input_examples/probes/movie_and_frequency_slices.fdtd.json new file mode 100644 index 00000000..a6686d01 --- /dev/null +++ b/testData/input_examples/probes/movie_and_frequency_slices.fdtd.json @@ -0,0 +1,197 @@ +{ + "_format": "FDTD Input file", + "general": { + "timeStep": 3.0813e-12, + "numberOfSteps": 1298 + }, + "boundary": { + "all": { + "type": "mur" + } + }, + "mesh": { + "grid": { + "numberOfCells": [ + 30, + 30, + 30 + ], + "steps": { + "x": [ + 0.002 + ], + "y": [ + 0.002 + ], + "z": [ + 0.002 + ] + } + }, + "coordinates": [ + { + "id": 1, + "relativePosition": [ + 0.0, + 10.0, + 10.0 + ] + }, + { + "id": 2, + "relativePosition": [ + 10.0, + 10.0, + 10.0 + ] + }, + { + "id": 3, + "relativePosition": [ + 10.0, + 0.0, + 10.0 + ] + } + ], + "elements": [ + { + "id": 1, + "type": "cell", + "intervals": [ + [ + [ + 0.0, + 20.0, + 20.0 + ], + [ + 20.0, + 20.0, + 20.0 + ] + ], + [ + [ + 20.0, + 20.0, + 20.0 + ], + [ + 20.0, + 20.0, + 10.0 + ] + ], + [ + [ + 20.0, + 20.0, + 10.0 + ], + [ + 20.0, + 0.0, + 10.0 + ] + ] + ] + }, + { + "id": 2, + "type": "cell", + "intervals": [ + [ + [ + 15, + 15, + 15 + ], + [ + 25, + 25, + 25 + ] + ] + ] + } + ] + }, + "materials": [], + "materialAssociations": [], + "sources": [ + { + "name": "nodalSource", + "type": "nodalSource", + "magnitudeFile": "predefinedExcitation.1.exc", + "elementIds": [ + 1 + ] + } + ], + "probes": [ + { + "name": "electric_field_movie_x", + "type": "movie", + "field": "electric", + "component": "x", + "elementIds": [2] + }, + { + "name": "magnetic_field_movie_y", + "type": "movie", + "field": "magnetic", + "component": "y", + "elementIds": [2] + }, + { + "name": "current_density_movie_z", + "type": "movie", + "field": "currentDensity", + "component": "z", + "elementIds": [2] + }, + { + "name": "electric_field_frequency_slice_x", + "type": "movie", + "field": "electric", + "component": "x", + "elementIds": [2], + "domain": { + "type": "frequency", + "initialFrequency": 1e6, + "finalFrequency": 1e9, + "numberOfFrequencies": 30, + "frequencySpacing": "logarithmic" + } + }, + { + "name": "magnetic_field_frequency_slice_y", + "type": "movie", + "field": "magnetic", + "component": "y", + "elementIds": [2], + "domain": { + "type": "frequency", + "initialFrequency": 1e6, + "finalFrequency": 1e9, + "numberOfFrequencies": 30, + "frequencySpacing": "logarithmic" + } + }, + { + "name": "current_density_frequency_slice_z", + "type": "movie", + "field": "currentDensity", + "component": "z", + "elementIds": [2], + "domain": { + "type": "frequency", + "initialFrequency": 1e6, + "finalFrequency": 1e9, + "numberOfFrequencies": 30, + "frequencySpacing": "logarithmic" + } + } + ] +} \ No newline at end of file diff --git a/testData/input_examples/probes/time_movie_over_cube.fdtd.json b/testData/input_examples/probes/time_movie_over_cube.fdtd.json index 663f1512..771039e4 100644 --- a/testData/input_examples/probes/time_movie_over_cube.fdtd.json +++ b/testData/input_examples/probes/time_movie_over_cube.fdtd.json @@ -48,7 +48,7 @@ ] ] ] - }, + } ] }, "materials": [ From 8d046181354867e904c1f7589f1bb7b383108d31 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 22 Dec 2025 12:18:52 +0100 Subject: [PATCH 41/67] Added new cases to movieProbe --- src_main_pub/fdetypes.F90 | 5 + src_output/movieProbeOutput.F90 | 200 ++++++++++++++++++++++++++++---- src_output/outputUtils.F90 | 106 ++++++++++++++++- 3 files changed, 284 insertions(+), 27 deletions(-) diff --git a/src_main_pub/fdetypes.F90 b/src_main_pub/fdetypes.F90 index 90495f54..1e62d43b 100755 --- a/src_main_pub/fdetypes.F90 +++ b/src_main_pub/fdetypes.F90 @@ -181,6 +181,11 @@ module FDETYPES integer (kind=4), parameter :: iBloqueJx=100*iEx,iBloqueJy=100*iEy,iBloqueJz=100*iEz integer (kind=4), parameter :: iBloqueMx=100*iHx,iBloqueMy=100*iHy,iBloqueMz=100*iHz ! + integer (kind=4), parameter :: VOLUMIC_M_MEASURE(3) = [iCur, iMEC, iMHC] !Module + integer (kind=4), parameter :: VOLUMIC_X_MEASURE(3) = [iCurx, iExC, iHxC] + integer (kind=4), parameter :: VOLUMIC_Y_MEASURE(3) = [iCury, iEyC, iHyC] + integer (kind=4), parameter :: VOLUMIC_Z_MEASURE(3) = [iCurz, iEzC, iHzC] + ! CHARACTER (LEN=*), PARAMETER :: SEPARADOR='______________' integer (kind=4), PARAMETER :: comi=1,fine=2, icoord=1,jcoord=2,kcoord=3 diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index b1fbb50f..efe01e08 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -31,28 +31,37 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, integer(kind=SINGLE), intent(in) :: mpidir, field character(len=BUFSIZE), intent(in) :: outputTypeExtension - type(MediaData_t), dimension(:) :: registeredMedia + type(MediaData_t), dimension(:), intent(in) :: registeredMedia type(media_matrices_t), intent(in) :: geometryMedia type(limit_t), dimension(:), intent(in) :: sinpml_fullsize type(domain_t), intent(in) :: domain - if (domain%domainType /= TIME_DOMAIN) call StopOnError(0, 0, "Unexpected domain type for movie probe") - this%lowerBound = lowerBound this%upperBound = upperBound this%fieldComponent = field !This can refer to field or currentDensity this%domain = domain this%path = get_output_path() + call get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) - allocate (this%timeStep(BuffObse)) - allocate (this%xValueForTime(BuffObse, this%nMeasuredElements)) - allocate (this%yValueForTime(BuffObse, this%nMeasuredElements)) - allocate (this%zValueForTime(BuffObse, this%nMeasuredElements)) - this%xValueForTime = 0.0_RKIND - this%yValueForTime = 0.0_RKIND - this%zValueForTime = 0.0_RKIND + call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) + + if (any(VOLUMIC_M_MEASURE == this%fieldComponent)) then + call alloc_and_init(this%xValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) + call alloc_and_init(this%yValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) + call alloc_and_init(this%zValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) + else + if (any(VOLUMIC_X_MEASURE == this%fieldComponent)) then + call alloc_and_init(this%xValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) + elseif (any(VOLUMIC_Y_MEASURE == this%fieldComponent)) then + call alloc_and_init(this%yValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) + elseif (any(VOLUMIC_Z_MEASURE == this%fieldComponent)) then + call alloc_and_init(this%zValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) + else + call StopOnError(0, 0, "Unexpected output type for movie probe") + end if + end if contains function get_output_path() result(outputPath) @@ -76,14 +85,166 @@ subroutine update_movie_probe_output(this, step, geometryMedia, registeredMedia, type(limit_t), dimension(:), intent(in) :: sinpml_fullsize type(fields_reference_t), intent(in) :: fieldsReference + integer(kind=4) :: request + request = this%fieldComponent + this%serializedTimeSize = this%serializedTimeSize + 1 - select case (this%fieldComponent) - case (iCur) - call save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) - end select + if (any(VOLUMIC_M_MEASURE == request)) then + select case (request) + case (iCur); call save_current_module(this, fieldsReference, step) + case (iMEC); call save_field_module(this, fieldsReference, request, step) + case (iMHC); call save_field_module(this, fieldsReference, request, step) + case default; StopOnError(0, 0, "Volumic measure not supported") + end select + + else if (any(VOLUMIC_X_MEASURE == request)) then + select case (request) + case (iCurX); call save_current_component(this%xValueForTime, fieldsReference, step, iEx) + case (iExC); call save_field_component(this, fieldsReference, request, step) + case (iHxC); call save_field_component(this, fieldsReference, request, step) + case default; StopOnError(0, 0, "Volumic measure not supported") + end select + + else if (any(VOLUMIC_Y_MEASURE == request)) then + select case (request) + case (iCurY); call save_current_component(this%yValueForTime, fieldsReference, step, iEy) + case (iEyC); call save_field_component(this, fieldsReference, request, step) + case (iHyC); call save_field_component(this, fieldsReference, request, step) + case default; StopOnError(0, 0, "Volumic measure not supported") + end select + + else if (any(VOLUMIC_Z_MEASURE == request)) then + select case (request) + case (iCurZ); call save_current_component(this%zValueForTime, fieldsReference, step, iEz) + case (iEzC); call save_field_component(this, fieldsReference, request, step) + case (iHzC); call save_field_component(this, fieldsReference, request, step) + case default; StopOnError(0, 0, "Volumic measure not supported") + end select + end if end subroutine update_movie_probe_output + subroutine save_current_module(this, fieldsReference, simTime) + type(movie_probe_output_t), intent(inout) :: this + type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND_tiempo), intent(in) :: simTime + + integer :: i, j, k, coordIdx + + this%timeStep(this%serializedTimeSize) = simTime + + coordIdx = 0 + do i = this%lowerBound%x, this%upperBound%x + do j = this%lowerBound%y, this%upperBound%y + do k = this%lowerBound%z, this%upperBound%z + if (saveCurrentFrom(i, j, k)) then + coordIdx = coordIdx + 1 + call save_current(this%xValueForTime, timeIdx, coordIdx, iEx, i, j, k, fieldsReference) + call save_current(this%yValueForTime, timeIdx, coordIdx, iEy, i, j, k, fieldsReference) + call save_current(this%zValueForTime, timeIdx, coordIdx, iEz, i, j, k, fieldsReference) + end if + end do + end do + end do + end subroutine + + subroutine save_current_component(currentData, fieldsReference, simTime, fieldDir) + real(kind=RKIND), intent(inout) :: currentData(:, :) + type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND_tiempo), intent(in) :: simTime + integer, intent(in) :: fieldDir + + integer :: i, j, k, coordIdx + + this%timeStep(this%serializedTimeSize) = simTime + + coordIdx = 0 + do i = this%lowerBound%x, this%upperBound%x + do j = this%lowerBound%y, this%upperBound%y + do k = this%lowerBound%z, this%upperBound%z + if (saveCurrentFrom(i, j, k)) then + coordIdx = coordIdx + 1 + call save_current(currentData, timeIdx, coordIdx, fieldDir, i, j, k, fieldsReference) + end if + end do + end do + end do + end subroutine + + subroutine save_current(currentData, timeIdx, coordIdx, field, i, j, k, fieldsReference) + real(kind=RKIND), intent(inout) :: currentData(:, :) + integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx, field, i, j, k + type(fields_reference_t), intent(in) :: fieldsReference + + real(kind=RKIND) :: jdir + jdir = computeJ(field, i, j, k, fieldsReference) + currentData(timeIdx, coordIdx) = jdir + end subroutine + + subroutine save_field_module(this, fieldsReference, request, simTime) + type(movie_probe_output_t), intent(inout) :: this + type(fields_reference_t), intent(in) :: fieldsReference + integer, intent(in) :: request + real(kind=RKIND_tiempo), intent(in) :: simTime + + type(field_data_t), pointer :: field + integer :: i, j, k, coordIdx + + if (request == iMEC) then + field => fieldsReference%E + else if (request == iMHC) then + field => fieldsReference%H + end if + + this%timeStep(this%serializedTimeSize) = simTime + + coordIdx = 0 + do i = this%lowerBound%x, this%upperBound%x + do j = this%lowerBound%y, this%upperBound%y + do k = this%lowerBound%z, this%upperBound%z + if (saveFieldFrom(i, j, k)) then + coordIdx = coordIdx + 1 + this%xValueForTime(timeIdx, coordIdx) = field%x(i, j, k) + this%yValueForTime(timeIdx, coordIdx) = field%y(i, j, k) + this%zValueForTime(timeIdx, coordIdx) = field%z(i, j, k) + end if + end do + end do + end do + + end subroutine + + subroutine save_field_component(fieldData, fieldsReference, request, simTime) + real(kind=RKIND), intent(in) :: fieldData + type(fields_reference_t), intent(in) :: fieldsReference + integer, intent(in) :: request + real(kind=RKIND_tiempo), intent(in) :: simTime + + real(kind=RKIND), pointer :: fieldComponent(:,:,:) + integer :: i, j, k, coordIdx + + fieldComponent = get_field_component() + + + this%timeStep(this%serializedTimeSize) = simTime + + coordIdx = 0 + do i = this%lowerBound%x, this%upperBound%x + do j = this%lowerBound%y, this%upperBound%y + do k = this%lowerBound%z, this%upperBound%z + if (saveFieldFrom(i, j, k)) then + coordIdx = coordIdx + 1 + this%xValueForTime(timeIdx, coordIdx) = field%x(i, j, k) + this%yValueForTime(timeIdx, coordIdx) = field%y(i, j, k) + this%zValueForTime(timeIdx, coordIdx) = field%z(i, j, k) + end if + end do + end do + end do + + end subroutine + + subroutine flush_movie_probe_output(this) type(movie_probe_output_t), intent(inout) :: this integer :: status, i @@ -204,17 +365,6 @@ subroutine save_current_data(this, step, fieldsReference, geometryMedia, registe end do if (n < this%nMeasuredElements) call StopOnError(0, 0, "Missing measurment to update at movie probe") - contains - - subroutine save_current_component() - real(kind=RKIND) :: jdir - jdir = computeJ(field, i, j, k, fieldsReference) - - this%timeStep(this%serializedTimeSize) = step - this%xValueForTime(this%serializedTimeSize, n) = merge(jdir, 0.0_RKIND, field == iEx) - this%yValueForTime(this%serializedTimeSize, n) = merge(jdir, 0.0_RKIND, field == iEy) - this%zValueForTime(this%serializedTimeSize, n) = merge(jdir, 0.0_RKIND, field == iEz) - end subroutine save_current_component end subroutine save_current_data subroutine write_vtu_timestep(this, stepIndex, filename) diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 4651bdff..24bb7fcd 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -28,6 +28,7 @@ module mod_outputUtils public :: computej public :: computeJ1 public :: computeJ2 + public :: alloc_and_init !=========================== !=========================== @@ -41,10 +42,112 @@ module mod_outputUtils !=========================== interface get_coordinates_extension - module procedure get_probe_coords_extension, get_probe_bounds_coords_extension + module procedure get_probe_coords_extension, get_probe_bounds_coords_extension end interface get_coordinates_extension + interface alloc_and_init + procedure alloc_and_init_time_1D + procedure alloc_and_init_int_1D + procedure alloc_and_init_int_2D + procedure alloc_and_init_int_3D + procedure alloc_and_init_real_1D + procedure alloc_and_init_real_2D + procedure alloc_and_init_real_3D + procedure alloc_and_init_complex_1D + procedure alloc_and_init_complex_2D + procedure alloc_and_init_complex_3D + end interface + contains + subroutine alloc_and_init_time_1D(array, n1, initVal) + integer(RKIND_tiempo), allocatable, intent(inout) :: array(:) + integer, intent(IN) :: n1 + integer(RKIND_tiempo), intent(IN) :: initVal + + allocate (array(n1)) + array = initVal + END subroutine alloc_and_init_int_1D + + subroutine alloc_and_init_int_1D(array, n1, initVal) + integer(SINGLE), allocatable, intent(inout) :: array(:) + integer, intent(IN) :: n1 + integer(SINGLE), intent(IN) :: initVal + + allocate (array(n1)) + array = initVal + END subroutine alloc_and_init_int_1D + + subroutine alloc_and_init_int_2D(array, n1, n2, initVal) + integer(SINGLE), allocatable, intent(inout) :: array(:, :) + integer, intent(IN) :: n1, n2 + integer(SINGLE), intent(IN) :: initVal + + allocate (array(n1, n2)) + array = initVal + END subroutine alloc_and_init_int_2D + + subroutine alloc_and_init_int_3D(array, n1, n2, n3, initVal) + integer(SINGLE), allocatable, intent(inout) :: array(:, :, :) + integer, intent(IN) :: n1, n2, n3 + integer(SINGLE), intent(IN) :: initVal + + allocate (array(n1, n2, n3)) + array = initVal + END subroutine alloc_and_init_int_3D + + subroutine alloc_and_init_real_1D(array, n1, initVal) + REAL(RKIND), allocatable, intent(inout) :: array(:) + integer, intent(IN) :: n1 + REAL(RKIND), intent(IN) :: initVal + + allocate (array(n1)) + array = initVal + END subroutine alloc_and_init_real_1D + + subroutine alloc_and_init_real_2D(array, n1, n2, initVal) + REAL(RKIND), allocatable, intent(inout) :: array(:, :) + integer, intent(IN) :: n1, n2 + REAL(RKIND), intent(IN) :: initVal + + allocate (array(n1, n2)) + array = initVal + END subroutine alloc_and_init_real_2D + + subroutine alloc_and_init_real_3D(array, n1, n2, n3, initVal) + REAL(RKIND), allocatable, intent(inout) :: array(:, :, :) + integer, intent(IN) :: n1, n2, n3 + REAL(RKIND), intent(IN) :: initVal + + allocate (array(n1, n2, n3)) + array = initVal + END subroutine alloc_and_init_real_3D + + subroutine alloc_and_init_complex_1D(array, n1, initVal) + COMPLEX(CKIND), allocatable, intent(inout) :: array(:) + integer, intent(IN) :: n1 + COMPLEX(CKIND), intent(IN) :: initVal + + allocate (array(n1)) + array = initVal + END subroutine alloc_and_init_complex_1D + + subroutine alloc_and_init_complex_2D(array, n1, n2, initVal) + COMPLEX(CKIND), allocatable, intent(inout) :: array(:, :) + integer, intent(IN) :: n1, n2 + COMPLEX(CKIND), intent(IN) :: initVal + + allocate (array(n1, n2)) + array = initVal + END subroutine alloc_and_init_complex_2D + + subroutine alloc_and_init_complex_3D(array, n1, n2, n3, initVal) + COMPLEX(CKIND), allocatable, intent(inout) :: array(:, :, :) + integer, intent(IN) :: n1, n2, n3 + COMPLEX(CKIND), intent(IN) :: initVal + + allocate (array(n1, n2, n3)) + array = initVal + END subroutine alloc_and_init_complex_3D function get_probe_coords_extension(coordinates, mpidir) result(ext) type(cell_coordinate_t) :: coordinates @@ -305,7 +408,6 @@ logical function isThinWire(field, i, j, k, geometryMedia, registeredMedia) isThinWire = registeredMedia(mediaIndex)%is%ThinWire end function - logical function isPEC(field, i, j, k, geometryMedia, registeredMedia) integer(kind=4), intent(in) :: field, i, j, k type(media_matrices_t), intent(in) :: geometryMedia From 120282c6ae1f9160ebdd8b74472c4a89efe1db76 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 22 Dec 2025 12:19:25 +0100 Subject: [PATCH 42/67] Cleanup compilation errors --- src_main_pub/timestepping.F90 | 2 +- src_output/output.F90 | 182 ++++++++++++++++++++++++++++------ src_output/outputTypes.F90 | 27 ++++- src_output/outputUtils.F90 | 47 +++++++++ 4 files changed, 222 insertions(+), 36 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 50f95c99..85dc88cf 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -1505,7 +1505,7 @@ subroutine initializeObservation() #endif write(dubuf,*) 'Init Observation...'; call print11(this%control%layoutnumber,dubuf) #ifdef CompileWithNewOutputModule - call init_outputs(this%sgg, this%media, this%sinPML_fullsize, this%control, this%thereAre%wires, this%bounds, this%thereAre%Observation) + call init_outputs(this%sgg, this%media, this%sinPML_fullsize, this%bounds, this%control, this%thereAre%Observation, this%thereAre%wires) #else call InitObservation (this%sgg,this%media,this%tag_numbers, & this%thereAre%Observation,this%thereAre%wires,this%thereAre%FarFields,this%initialtimestep,this%lastexecutedtime, & diff --git a/src_output/output.F90 b/src_output/output.F90 index baffaf37..c799e45a 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -10,7 +10,7 @@ module output use mod_movieProbeOutput use mod_frequencySliceProbeOutput use mod_farFieldOutput - + implicit none private @@ -34,8 +34,6 @@ module output private :: get_required_output_count !=========================== - - integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0, & WIRE_CURRENT_PROBE_ID = 1, & WIRE_CHARGE_PROBE_ID = 2, & @@ -45,20 +43,6 @@ module output FREQUENCY_SLICE_PROBE_ID = 6, & FAR_FIELD_PROBE_ID = 7 - type solver_output_t - integer(kind=SINGLE) :: outputID - type(point_probe_output_t), allocatable :: pointProbe !iEx, iEy, iEz, iHx, iHy, iHz - type(wire_current_probe_output_t), allocatable :: wireCurrentProbe !Jx, Jy, Jz - type(wire_charge_probe_output_t), allocatable :: wireChargeProbe !Qx, Qy, Qz - type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !BloqueXJ, BloqueYJ, BloqueZJ, BloqueXM, BloqueYM, BloqueZM - type(volumic_current_probe_t), allocatable :: volumicCurrentProbe !icurX, icurY, icurZ - type(volumic_field_probe_output_t), allocatable :: volumicFieldProbe - type(line_integral_probe_output_t), allocatable :: lineIntegralProbe - type(movie_probe_output_t), allocatable :: movieProbe !iCur if timeDomain - type(frequency_slice_probe_output_t), allocatable :: frequencySliceProbe !iCur if freqDomain - type(far_field_probe_output_t), allocatable :: farFieldOutput !farfield - end type solver_output_t - REAL(KIND=RKIND), save :: eps0, mu0 REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu type(solver_output_t), pointer, dimension(:), save :: outputs @@ -109,19 +93,19 @@ module output contains function GetOutputs() result(r) - type(solver_output_t), pointer, dimension(:) :: r - r => outputs - return + type(solver_output_t), pointer, dimension(:) :: r + r => outputs + return end function - subroutine init_outputs(sgg, media, sinpml_fullsize, control, ThereAreWires, bounds, OutputRequested) + subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observationsExists, wiresExists) type(SGGFDTDINFO), intent(in) :: sgg type(media_matrices_t), intent(in) :: media type(limit_t), dimension(:), intent(in) :: SINPML_fullsize type(bounds_t) :: bounds type(sim_control_t), intent(inout) :: control - logical, intent(inout) :: ThereAreWires - logical, intent(out) :: OutputRequested + logical, intent(inout) :: wiresExists + logical, intent(out) :: observationsExists type(domain_t) :: domain type(spheric_domain_t) :: sphericRange @@ -132,7 +116,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, ThereAreWires, bou integer(kind=SINGLE) :: requestedOutputs character(len=BUFSIZE) :: outputTypeExtension - OutputRequested = .false. + observationsExists = .false. requestedOutputs = get_required_output_count(sgg) outputs => NULL() @@ -144,6 +128,13 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, ThereAreWires, bou InvEps(0:sgg%NumMedia - 1) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia - 1)%Epr) InvMu(0:sgg%NumMedia - 1) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia - 1)%Mur) + do ii = 1, sgg%NumberRequest + do i = 1, sgg%Observation(ii)%nP + call eliminate_unnecesary_observation_points(sgg%Observation(ii)%P(i), output(ii)%item(i), & + sgg%Sweep, sgg%SINPMLSweep, sgg%Observation(ii)%P(1)%ZI, sgg%Observation(ii)%P(1)%ZE, control%layoutnumber, control%size) + end do + end do + do ii = 1, sgg%NumberRequest do i = 1, sgg%Observation(ii)%nP lowerBound%x = sgg%observation(ii)%P(i)%XI @@ -168,7 +159,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, ThereAreWires, bou call init_solver_output(outputs(outputCount)%pointProbe, lowerBound, outputRequestType, domain, outputTypeExtension, control%mpidir, sgg%dt) call create_empty_files(outputs(outputCount)%pointProbe) case (iJx, iJy, iJz) - if (ThereAreWires) then + if (wiresExists) then outputCount = outputCount + 1 outputs(outputCount)%outputID = WIRE_CURRENT_PROBE_ID @@ -194,7 +185,9 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, ThereAreWires, bou call create_empty_files(outputs(outputCount)%bulkCurrentProbe) !! call adjust_computation_range --- Required due to issues in mpi region edges - case (iCur) + case (iCur, iMEC, iMHC, iCurX, iCurY, iCurZ, iExC, iEyC, iEyC, iHxC, iHyC, iHyC) + call adjust_bound_range() + if (domain%domainType == TIME_DOMAIN) then outputCount = outputCount + 1 @@ -203,7 +196,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, ThereAreWires, bou call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, SINPML_fullsize, outputTypeExtension, control%mpidir) call create_pvd(outputs(outputCount)%movieProbe%path, outputs(outputCount)%movieProbe%PDVUnit) - else if ( domain%domainType == FREQUENCY_DOMAIN ) then + else if (domain%domainType == FREQUENCY_DOMAIN) then outputCount = outputCount + 1 outputs(outputCount)%outputID = FREQUENCY_SLICE_PROBE_ID @@ -225,9 +218,22 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, control, ThereAreWires, bou end do end do - if (outputCount /= 0) OutputRequested = .true. + if (outputCount /= 0) observationsExists = .true. return contains + subroutine adjust_bound_range() + select case (outputRequestType) + case (iExC, iEyC, iHzC, iMhC) + lowerBound%z = max(sgg%Sweep(fieldo(field, 'Z'))%ZI, sgg%observation(ii)%P(i)%ZI) + upperBound%z = min(sgg%Sweep(fieldo(field, 'Z'))%ZE - 1, sgg%observation(ii)%P(i)%ZE) + case (iEzC, iHxC, iHyC, iMeC) + lowerBound%z = max(sgg%Sweep(fieldo(field, 'Z'))%ZI, sgg%observation(ii)%P(i)%ZI) + upperbound%z = min(sgg%Sweep(fieldo(field, 'Z'))%ZE, sgg%observation(ii)%P(i)%ZE) + case (iCur, iCurX, iCurY, iCurZ) + lowerBound%z = max(sgg%Sweep(fieldo(field, 'X'))%ZI, sgg%observation(ii)%P(i)%ZI) !ojo estaba sweep(iEz) para ser conservador...puede dar problemas!! 03/07/15 + upperbound%z = min(sgg%Sweep(fieldo(field, 'X'))%ZE, sgg%observation(ii)%P(i)%ZE) !ojo estaba sweep(iEz) para ser conservador...puede dar problemas!! 03/07/15 + end select + end subroutine function preprocess_domain(observation, timeArray, simulationTimeStep, finalStepIndex) result(newDomain) type(Obses_t), intent(in) :: observation real(kind=RKIND_tiempo), pointer, dimension(:), intent(in) :: timeArray @@ -320,14 +326,14 @@ subroutine update_outputs(geometryMedia, materialList, SINPML_fullsize, control, fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos call update_solver_output(outputs(i)%pointProbe, discreteTime, fieldComponent) case (WIRE_CURRENT_PROBE_ID) - call update_solver_output(outputs(i)%wireCurrentProbe, discreteTime, control%wiresflavor, control%wirecrank, InvEps, InvMu) + call update_solver_output(outputs(i)%wireCurrentProbe, discreteTime, control%wiresflavor, control%wirecrank, InvEps, InvMu) case (WIRE_CHARGE_PROBE_ID) call update_solver_output(outputs(i)%wireChargeProbe, discreteTime) case (BULK_PROBE_ID) fieldReference = get_field_reference(outputs(i)%bulkCurrentProbe%fieldComponent) call update_solver_output(outputs(i)%bulkCurrentProbe, discreteTime, fieldReference) case (MOVIE_PROBE_ID) - call update_solver_output(outputs(i)%movieProbe, discreteTime, geometryMedia, materialList, SINPML_fullsize, fieldsReference) + call update_solver_output(outputs(i)%movieProbe, discreteTime, geometryMedia, materialList, SINPML_fullsize, fieldsReference) case (FREQUENCY_SLICE_PROBE_ID) call update_solver_output(outputs(i)%frequencySliceProbe, discreteTime, geometryMedia, materialList, SINPML_fullsize, fieldsReference) case (FAR_FIELD_PROBE_ID) @@ -458,4 +464,118 @@ function get_required_output_count(sgg) result(count) end do return end function -end module output + + subroutine eliminate_unnecessary_observation_points(observation_probe, output_item, sweep, SINPMLSweep, ZI, ZE, layoutnumber, size) + type(item_t), intent(inout) :: output_item + type(observable_t), intent(inout) :: observation_probe + type(XYZlimit_t), dimension(1:6), intent(in) :: sweep, SINPMLSweep + integer(kind=4), intent(in) :: ZI, ZE, layoutnumber, size + integer(kind=4) :: field + + ! Initialize output_item trancos + output_item%Xtrancos = observation_probe%Xtrancos + output_item%Ytrancos = observation_probe%Ytrancos + output_item%Ztrancos = observation_probe%Ztrancos + + output_item%XItrancos = ceiling(real(observation_probe%XI)/real(output_item%Xtrancos)) + output_item%YItrancos = ceiling(real(observation_probe%YI)/real(output_item%Ytrancos)) + output_item%ZItrancos = ceiling(real(observation_probe%ZI)/real(output_item%Ztrancos)) + + output_item%XEtrancos = int(observation_probe%XE/output_item%Xtrancos) + output_item%YEtrancos = int(observation_probe%YE/output_item%Ytrancos) + output_item%ZEtrancos = int(observation_probe%ZE/output_item%Ztrancos) + +#ifdef CompileWithMPI + output_item%MPISubComm = -1 +#endif + + field = observation_probe%What + + select case (field) + case (iBloqueJx, iBloqueJy, iBloqueMx, iBloqueMy, iExC, iEyC, iHzC, iMhC, iEzC, iHxC, iHyC, iMeC) + call eliminate_observation_block(observation_probe, output_item, sweep, field, layoutnumber, size) + case (iEx, iVx, iEy, iVy, iHz, iBloqueMz, iJx, iJy, iQx, iQy) + call eliminate_observation_range(observation_probe, sweep, field, layoutnumber, size, lower_inclusive=.false.) + case (iEz, iVz, iJz, iQz, iBloqueJz, iHx, iHy) + call eliminate_observation_range(observation_probe, sweep, field, layoutnumber, size, lower_inclusive=.true.) + case (iCur, iCurX, iCurY, iCurZ, mapvtk) + call eliminate_observation_current(observation_probe, output_item, sweep, field, layoutnumber, size) + case (FarField) + call eliminate_observation_farfield(observation_probe, output_item, SINPMLSweep, ZI, ZE, layoutnumber, size) + end select + end subroutine + +! Generic subroutine for block observations + subroutine eliminate_observation_block(obs, out, sweep, field, layoutnumber, size) + type(observable_t), intent(inout) :: obs + type(item_t), intent(inout) :: out + type(XYZlimit_t), dimension(1:6), intent(in) :: sweep + integer, intent(in) :: field, layoutnumber, size + + call eliminate_observation_range_generic(obs, out, sweep(fieldo(field, 'Z'))%ZI, & + sweep(fieldo(field, 'Z'))%ZE, layoutnumber, size) + end subroutine + +! Generic Z-range check with optional inclusive lower bound + subroutine eliminate_observation_range(obs, sweep, field, layoutnumber, size, lower_inclusive) + type(observable_t), intent(inout) :: obs + type(XYZlimit_t), dimension(1:6), intent(in) :: sweep + integer, intent(in) :: field, layoutnumber, size + logical, intent(in) :: lower_inclusive + + if (lower_inclusive) then + if ((obs%ZI > sweep(fieldo(field, 'Z'))%ZE) .or. (obs%ZI < sweep(fieldo(field, 'Z'))%ZI)) obs%What = nothing + else + if ((obs%ZI >= sweep(fieldo(field,'Z'))%ZE) .and. (layoutnumber /= size-1) .or. (obs%ZI < sweep(fieldo(field,'Z'))%ZI)) obs%What = nothing + end if + end subroutine + +! Generic subroutine for currents + subroutine eliminate_observation_current(obs, out, sweep, field, layoutnumber, size) + type(observable_t), intent(inout) :: obs + type(item_t), intent(inout) :: out + type(XYZlimit_t), dimension(1:6), intent(in) :: sweep + integer, intent(in) :: field, layoutnumber, size + + call eliminate_observation_range_generic(obs, out, sweep(fieldo(field, 'Z'))%ZI, sweep(fieldo(field, 'Z'))%ZE, layoutnumber, size) + if ((field == iCur .or. field == iCurX .or. field == iCurY .or. field == mapvtk)) then + obs%ZE = min(obs%ZE, sweep(iHx)%ZE) + end if + end subroutine + +! Far field specialized + subroutine eliminate_observation_farfield(obs, out, sweep, ZI, ZE, layoutnumber, size) + type(observable_t), intent(inout) :: obs + type(item_t), intent(inout) :: out + type(XYZlimit_t), dimension(1:6), intent(in) :: sweep + integer(kind=4), intent(in) :: ZI, ZE, layoutnumber, size + + call eliminate_observation_range_generic(obs, out, sweep(iHz)%ZI, sweep(iHz)%ZE, layoutnumber, size, ZI, ZE) + end subroutine + +! The ultimate generic routine for MPI and Z-limits + subroutine eliminate_observation_range_generic(obs, out, Z_lower, Z_upper, layoutnumber, size, Zstart, Zend) + type(observable_t), intent(inout) :: obs + type(item_t), intent(inout) :: out + integer, intent(in) :: Z_lower, Z_upper, layoutnumber, size + integer, optional, intent(in) :: Zstart, Zend + + integer :: zi_local, ze_local + zi_local = merge(Zstart, obs%ZI, present(Zstart)) + ze_local = merge(Zend, obs%ZE, present(Zend)) + + if ((zi_local > Z_upper) .or. (ze_local < Z_lower)) then + obs%What = nothing +#ifdef CompileWithMPI + out%MPISubComm = -1 + else + out%MPISubComm = 1 + end if + out%MPIRoot = 0 + if ((obs%ZI >= Z_lower) .and. (obs%ZI <= Z_upper)) out%MPIRoot = layoutnumber + call MPIinitSubcomm(layoutnumber, size, out%MPISubComm, out%MPIRoot, out%MPIGroupIndex) +#endif + end if + end subroutine + + end module output diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 8bf62f6b..30b3f152 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -21,6 +21,25 @@ module outputTypes character(len=4), parameter :: timeExtension = 'tm' character(len=4), parameter :: frequencyExtension = 'fq' + type solver_output_t + integer(kind=SINGLE) :: outputID + type(point_probe_output_t), allocatable :: pointProbe !iEx, iEy, iEz, iHx, iHy, iHz + type(wire_current_probe_output_t), allocatable :: wireCurrentProbe !Jx, Jy, Jz + type(wire_charge_probe_output_t), allocatable :: wireChargeProbe !Qx, Qy, Qz + type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !BloqueXJ, BloqueYJ, BloqueZJ, BloqueXM, BloqueYM, BloqueZM + type(volumic_current_probe_t), allocatable :: volumicCurrentProbe !icurX, icurY, icurZ + type(volumic_field_probe_output_t), allocatable :: volumicFieldProbe + type(line_integral_probe_output_t), allocatable :: lineIntegralProbe + type(movie_probe_output_t), allocatable :: movieProbe !iCur if timeDomain + type(frequency_slice_probe_output_t), allocatable :: frequencySliceProbe !iCur if freqDomain + type(far_field_probe_output_t), allocatable :: farFieldOutput !farfield + +#ifdef CompileWithMPI + integer(kind=4) :: MPISubcomm, MPIRoot, MPIGroupIndex + integer(kind=4) :: ZIorig, ZEorig +#endif + end type solver_output_t + type :: domain_t real(kind=RKIND_tiempo) :: tstart = 0.0_RKIND_tiempo, tstop = 0.0_RKIND_tiempo, tstep = 0.0_RKIND_tiempo real(kind=RKIND) :: fstart = 0.0_RKIND, fstop = 0.0_RKIND, fstep @@ -35,7 +54,7 @@ module outputTypes end type type cell_coordinate_t - integer(kind=SINGLE) :: x,y,z + integer(kind=SINGLE) :: x, y, z end type cell_coordinate_t type field_data_t @@ -177,7 +196,7 @@ module outputTypes character(len=BUFSIZE) :: path integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE - integer(kind=SINGLE), dimension(:,:), allocatable :: coords + integer(kind=SINGLE), dimension(:, :), allocatable :: coords integer(kind=SINGLE) :: nFreq = 0_SINGLE real(kind=RKIND), dimension(:), allocatable :: frequencySlice complex(kind=CKIND), dimension(:, :), allocatable :: valueForFreq @@ -192,7 +211,7 @@ module outputTypes integer(kind=SINGLE) :: fieldComponent integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE - integer(kind=SINGLE), dimension(:,:), allocatable :: coords + integer(kind=SINGLE), dimension(:, :), allocatable :: coords !Intent storage order: !(:) == (timeinstance) => timeValue @@ -215,7 +234,7 @@ module outputTypes integer(kind=SINGLE) :: fieldComponent integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE - integer(kind=SINGLE), dimension(:,:), allocatable :: coords + integer(kind=SINGLE), dimension(:, :), allocatable :: coords !Intent storage order: !(:) == (frquencyinstance) => timeValue diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 24bb7fcd..3e06b4fc 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -351,6 +351,53 @@ function prefix(campo) result(ext) return end function prefix + function fieldo(field, dir) result(fieldo2) + integer :: fieldo2, field + character(len=1) :: dir + fieldo2 = -1 + select case (field) + case (iEx, iEy, iEz, iHx, iHy, iHz); fieldo2 = field + case (iJx, iVx, iBloqueJx, iExC, iQx); fieldo2 = iEx + case (iJy, iVy, iBloqueJy, iEyC, iQy); fieldo2 = iEy + case (iJz, iVz, iBloqueJz, iEzC, iQz); fieldo2 = iEz + case (iBloqueMx, iHxC); fieldo2 = iHx + case (iBloqueMy, iHyC); fieldo2 = iHy + case (iBloqueMz, iHzC); fieldo2 = iHz + case (iMEC) + select case (dir) + CASE ('X', 'x'); fieldo2 = iEx + CASE ('Y', 'y'); fieldo2 = iEY + CASE ('Z', 'z'); fieldo2 = iEz + END SELECT + case (iMHC) + select case (dir) + CASE ('X', 'x'); fieldo2 = ihx + CASE ('Y', 'y'); fieldo2 = iHY + CASE ('Z', 'z'); fieldo2 = iHz + END SELECT + case (iCur, iCurX, icurY, icurZ, mapvtk) !los pongo en efield para evitar problemas con el MPI + select case (dir) + CASE ('X', 'x'); fieldo2 = iEx + CASE ('Y', 'y'); fieldo2 = iEY + CASE ('Z', 'z'); fieldo2 = iEz + END SELECT + end select + end function + + function get_field_component(fieldId, fieldReference) result(component) + type(fields_reference_t), intent(in) :: fieldReference + integer(kind=SINGLE), intent(in) :: fieldId + real(kind=RKIND), pointer, dimension(:, :, :) :: component + select case (fieldId) + case (iEx); component => fieldsReference%E%x + case (iEy); component => fieldsReference%E%y + case (iEz); component => fieldsReference%E%z + case (iHx); component => fieldsReference%H%x + case (iHy); component => fieldsReference%H%y + case (iHz); component => fieldsReference%H%z + end select + end function + function open_file(fileUnit, fileName) result(iostat) character(len=*), intent(in) :: fileName integer(kind=SINGLE), intent(in) :: fileUnit From 204c55c6a50bc1249fb8660f2636e355883b38a6 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 23 Dec 2025 10:35:44 +0100 Subject: [PATCH 43/67] Refactor movie probe output --- src_output/movieProbeOutput.F90 | 241 +++++++++++++++----------------- 1 file changed, 111 insertions(+), 130 deletions(-) diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index efe01e08..85bd61d2 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -25,15 +25,14 @@ module mod_movieProbeOutput contains - subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir) + subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, control, problemInfo, outputTypeExtension) type(movie_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(MediaData_t), dimension(:), intent(in) :: registeredMedia - type(media_matrices_t), intent(in) :: geometryMedia - type(limit_t), dimension(:), intent(in) :: sinpml_fullsize + type(sim_control_t), intent(in) :: control + type(problem_info_t), intent(in) :: problemInfo type(domain_t), intent(in) :: domain @@ -43,7 +42,7 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, this%domain = domain this%path = get_output_path() - call get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) + call get_measurements_coords(this, problemInfo) call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) @@ -67,8 +66,8 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, mpidir) - prefixFieldExtension = get_prefix_extension(field, mpidir) + probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, control%mpidir) + prefixFieldExtension = get_prefix_extension(field, control%mpidir) outputPath = & trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) return @@ -76,13 +75,10 @@ end function get_output_path end subroutine init_movie_probe_output - subroutine update_movie_probe_output(this, step, geometryMedia, registeredMedia, sinpml_fullsize, fieldsReference) + subroutine update_movie_probe_output(this, step, fieldsReference, problemInfo) type(movie_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step - - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:), intent(in) :: registeredMedia - type(limit_t), dimension(:), intent(in) :: sinpml_fullsize + type(problem_info_t), intent(in) :: problemInfo type(fields_reference_t), intent(in) :: fieldsReference integer(kind=4) :: request @@ -92,42 +88,43 @@ subroutine update_movie_probe_output(this, step, geometryMedia, registeredMedia, if (any(VOLUMIC_M_MEASURE == request)) then select case (request) - case (iCur); call save_current_module(this, fieldsReference, step) - case (iMEC); call save_field_module(this, fieldsReference, request, step) - case (iMHC); call save_field_module(this, fieldsReference, request, step) - case default; StopOnError(0, 0, "Volumic measure not supported") + case (iCur); call save_current_module(this, fieldsReference, step, problemInfo) + case (iMEC); call save_field_module(this, fieldsReference%E, request, step, problemInfo) + case (iMHC); call save_field_module(this, fieldsReference%H, request, step, problemInfo) + case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select else if (any(VOLUMIC_X_MEASURE == request)) then select case (request) - case (iCurX); call save_current_component(this%xValueForTime, fieldsReference, step, iEx) - case (iExC); call save_field_component(this, fieldsReference, request, step) - case (iHxC); call save_field_component(this, fieldsReference, request, step) - case default; StopOnError(0, 0, "Volumic measure not supported") + case (iCurX); call save_current_component(this%xValueForTime, fieldsReference, step, problemInfo, iEx) + case (iExC); call save_field_component(this%xValueForTime, fieldsReference%E%x, step, problemInfo, iEx) + case (iHxC); call save_field_component(this%xValueForTime, fieldsReference%H%x, step, problemInfo, iHx) + case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select else if (any(VOLUMIC_Y_MEASURE == request)) then select case (request) - case (iCurY); call save_current_component(this%yValueForTime, fieldsReference, step, iEy) - case (iEyC); call save_field_component(this, fieldsReference, request, step) - case (iHyC); call save_field_component(this, fieldsReference, request, step) - case default; StopOnError(0, 0, "Volumic measure not supported") + case (iCurY); call save_current_component(this%yValueForTime, fieldsReference, step, problemInfo, iEy) + case (iEyC); call save_field_component(this%yValueForTime, fieldsReference%E%y, step, problemInfo, iEy) + case (iHyC); call save_field_component(this%yValueForTime, fieldsReference%H%y, step, problemInfo, iHy) + case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select else if (any(VOLUMIC_Z_MEASURE == request)) then select case (request) - case (iCurZ); call save_current_component(this%zValueForTime, fieldsReference, step, iEz) - case (iEzC); call save_field_component(this, fieldsReference, request, step) - case (iHzC); call save_field_component(this, fieldsReference, request, step) - case default; StopOnError(0, 0, "Volumic measure not supported") + case (iCurZ); call save_current_component(this%zValueForTime, fieldsReference, step, problemInfo, iEz) + case (iEzC); call save_field_component(this%zValueForTime, fieldsReference%E%z, step, problemInfo, iEz) + case (iHzC); call save_field_component(this%zValueForTime, fieldsReference%H%z, step, problemInfo, iHz) + case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select end if end subroutine update_movie_probe_output - subroutine save_current_module(this, fieldsReference, simTime) + subroutine save_current_module(this, fieldsReference, simTime, problemInfo) type(movie_probe_output_t), intent(inout) :: this type(fields_reference_t), intent(in) :: fieldsReference real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo integer :: i, j, k, coordIdx @@ -137,21 +134,20 @@ subroutine save_current_module(this, fieldsReference, simTime) do i = this%lowerBound%x, this%upperBound%x do j = this%lowerBound%y, this%upperBound%y do k = this%lowerBound%z, this%upperBound%z - if (saveCurrentFrom(i, j, k)) then coordIdx = coordIdx + 1 - call save_current(this%xValueForTime, timeIdx, coordIdx, iEx, i, j, k, fieldsReference) - call save_current(this%yValueForTime, timeIdx, coordIdx, iEy, i, j, k, fieldsReference) - call save_current(this%zValueForTime, timeIdx, coordIdx, iEz, i, j, k, fieldsReference) - end if + call save_current(this%xValueForTime, timeIdx, coordIdx, iEx, i, j, k, fieldsReference, problemInfo) + call save_current(this%yValueForTime, timeIdx, coordIdx, iEy, i, j, k, fieldsReference, problemInfo) + call save_current(this%zValueForTime, timeIdx, coordIdx, iEz, i, j, k, fieldsReference, problemInfo) end do end do end do end subroutine - subroutine save_current_component(currentData, fieldsReference, simTime, fieldDir) + subroutine save_current_component(currentData, fieldsReference, simTime, problemInfo, fieldDir) real(kind=RKIND), intent(inout) :: currentData(:, :) type(fields_reference_t), intent(in) :: fieldsReference real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo integer, intent(in) :: fieldDir integer :: i, j, k, coordIdx @@ -162,89 +158,105 @@ subroutine save_current_component(currentData, fieldsReference, simTime, fieldDi do i = this%lowerBound%x, this%upperBound%x do j = this%lowerBound%y, this%upperBound%y do k = this%lowerBound%z, this%upperBound%z - if (saveCurrentFrom(i, j, k)) then - coordIdx = coordIdx + 1 - call save_current(currentData, timeIdx, coordIdx, fieldDir, i, j, k, fieldsReference) - end if + coordIdx = coordIdx + 1 + call save_current(currentData, timeIdx, coordIdx, fieldDir, i, j, k, fieldsReference, problemInfo) end do end do end do end subroutine - subroutine save_current(currentData, timeIdx, coordIdx, field, i, j, k, fieldsReference) + subroutine save_current(currentData, timeIdx, coordIdx, field, i, j, k, fieldsReference, problemInfo) real(kind=RKIND), intent(inout) :: currentData(:, :) integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx, field, i, j, k type(fields_reference_t), intent(in) :: fieldsReference + type(problem_info_t), intent(in) :: problemInfo real(kind=RKIND) :: jdir - jdir = computeJ(field, i, j, k, fieldsReference) + jdir = 0.0 + if (saveCurrentFrom(field, i,j,k, problemInfo)) then + jdir = computeJ(field, i, j, k, fieldsReference) + end if currentData(timeIdx, coordIdx) = jdir end subroutine - subroutine save_field_module(this, fieldsReference, request, simTime) + subroutine save_field_module(this, field, simTime, problemInfo) type(movie_probe_output_t), intent(inout) :: this - type(fields_reference_t), intent(in) :: fieldsReference - integer, intent(in) :: request + type(field_data_t), pointer :: field real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo - type(field_data_t), pointer :: field integer :: i, j, k, coordIdx - if (request == iMEC) then - field => fieldsReference%E - else if (request == iMHC) then - field => fieldsReference%H - end if - this%timeStep(this%serializedTimeSize) = simTime coordIdx = 0 do i = this%lowerBound%x, this%upperBound%x do j = this%lowerBound%y, this%upperBound%y do k = this%lowerBound%z, this%upperBound%z - if (saveFieldFrom(i, j, k)) then - coordIdx = coordIdx + 1 - this%xValueForTime(timeIdx, coordIdx) = field%x(i, j, k) - this%yValueForTime(timeIdx, coordIdx) = field%y(i, j, k) - this%zValueForTime(timeIdx, coordIdx) = field%z(i, j, k) - end if + coordIdx = coordIdx + 1 + call save_field(this%xValueForTime, timeIdx, coordIdx, iEx, i, j, k, field%x(i, j, k), problemInfo) + call save_field(this%yValueForTime, timeIdx, coordIdx, iEy, i, j, k, field%y(i, j, k), problemInfo) + call save_field(this%zValueForTime, timeIdx, coordIdx, iEz, i, j, k, field%z(i, j, k), problemInfo) end do end do end do end subroutine - subroutine save_field_component(fieldData, fieldsReference, request, simTime) - real(kind=RKIND), intent(in) :: fieldData - type(fields_reference_t), intent(in) :: fieldsReference - integer, intent(in) :: request + subroutine save_field_component(fieldData, fieldComponent, simTime, problemInfo, fieldDir) + real(kind=RKIND), intent(inout) :: fieldData(:, :) + type(field_data_t), intent(in) :: fieldComponent(:,:,:) real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: fieldDir - real(kind=RKIND), pointer :: fieldComponent(:,:,:) integer :: i, j, k, coordIdx - fieldComponent = get_field_component() - - this%timeStep(this%serializedTimeSize) = simTime coordIdx = 0 do i = this%lowerBound%x, this%upperBound%x do j = this%lowerBound%y, this%upperBound%y do k = this%lowerBound%z, this%upperBound%z - if (saveFieldFrom(i, j, k)) then - coordIdx = coordIdx + 1 - this%xValueForTime(timeIdx, coordIdx) = field%x(i, j, k) - this%yValueForTime(timeIdx, coordIdx) = field%y(i, j, k) - this%zValueForTime(timeIdx, coordIdx) = field%z(i, j, k) - end if + coordIdx = coordIdx + 1 + call save_field(fieldData, timeIdx, coordIdx, fieldDir, i, j, k, fieldComponent(i,j,k), problemInfo) end do end do end do + end subroutine + + subroutine save_field(fieldData, timeIdx, coordIdx, field, i, j, k, fieldValue, problemInfo) + real(kind=RKIND), intent(inout) :: fieldData(:, :) + integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx, field, i, j, k + real(kind=RKIND), intent(in) :: fieldValue + type(problem_info_t), intent(in) :: problemInfo + real(kind=RKIND) :: savedValue + savedValue = 0.0 + if (saveFieldFrom(field, i,j,k, problemInfo)) then + savedValue = fieldValue + end if + fieldData(timeIdx, coordIdx) = savedValue end subroutine + logical function saveCurrentFrom(field, i,j,k, problemInfo) + integer, intent(in) :: i,j,k, field + type(problem_info_t) :: problemInfo + saveCurrentFrom = isWithinBounds(field, i,j,k,problemInfo%simulationBounds) + if(saveCurrentFrom) then + saveCurrentFrom = isThinWire(field, i,j,k,problemInfo%geometryToMaterialData, problemInfo%materialList) & + .or. isPEC(field, i,j,k,problemInfo%geometryToMaterialData, problemInfo%materialList) + end if + end function + + logical function saveFieldFrom(field, i,j,k, problemInfo) + integer, intent(in) :: i,j,k, field + type(problem_info_t) :: problemInfo + saveCurrentFrom = isWithinBounds(field, i,j,k,problemInfo%simulationBounds) + end function + + subroutine flush_movie_probe_output(this) type(movie_probe_output_t), intent(inout) :: this integer :: status, i @@ -265,15 +277,17 @@ end subroutine clear_memory_data end subroutine flush_movie_probe_output - subroutine get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) + subroutine get_measurements_coords(this, problemInfo) + procedure(logical_func), pointer :: checker => null() ! Pointer to logical function type(movie_probe_output_t), intent(inout) :: this - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:), intent(in) :: registeredMedia - type(limit_t), dimension(:), intent(in) :: sinpml_fullsize + type(problem_info_t), intent(in) :: problemInfo + integer(kind=4), dimension(3) :: fieldTriplet integer(kind=SINGLE) :: i, j, k, field integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend integer(kind=SINGLE) :: count + integer(kind=SINGLE) :: xField, zField + ! Limites de la región de interés istart = this%lowerBound%x jstart = this%lowerBound%y @@ -287,12 +301,25 @@ subroutine get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_ count = 0 select case (this%fieldComponent) case (iCur) + checker => requiredMeasureForCurrent + xField = iEx + zField = iEz + case (iMEC) + checker => requiredMeasureForField + xField = iEx + zField = iEz + case (iMHC) + checker => requiredMeasureForField + xField = iHx + zField = iHz + end select + do i = istart, iend do j = jstart, jend do k = kstart, kend - do field = iEx, iEz - if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then - if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then + do field = xField, zField + if (isWithinBounds(field, i, j, k, problemInfo)) then + if (checker(field, i, j, k, problemInfo)) then count = count + 1 end if end if @@ -300,72 +327,26 @@ subroutine get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_ end do end do end do - end select this%nMeasuredElements = count - allocate (this%coords(3, this%nMeasuredElements)) count = 0 - select case (this%fieldComponent) - case (iCur) - do i = istart, iend - do j = jstart, jend - do k = kstart, kend - do field = iEx, iEz - if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then - if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then - count = count + 1 - this%coords(:, count) = [i, j, k] - end if - end if - end do - end do - end do - end do - end select - - end subroutine get_measurements_coords - - subroutine save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) - type(movie_probe_output_t), intent(inout) :: this - real(kind=RKIND_tiempo), intent(in) :: step - type(fields_reference_t), intent(in) :: fieldsReference - - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:) :: registeredMedia - type(limit_t), dimension(:), intent(in) :: sinpml_fullsize - - integer(kind=SINGLE) :: i, j, k, field - integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend - integer(kind=SINGLE) :: n - - istart = this%lowerBound%x - jstart = this%lowerBound%y - kstart = this%lowerBound%z - - iend = this%upperBound%x - jend = this%upperBound%y - kend = this%upperBound%z - - n = 0 do i = istart, iend do j = jstart, jend do k = kstart, kend - do field = iEx, iEz - if (isWithinBounds(field, i, j, k, SINPML_fullsize)) then - if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then - n = n + 1 - call save_current_component() + do field = xField, zField + if (isWithinBounds(field, i, j, k, problemInfo)) then + if (checker(field, i, j, k, problemInfo)) then + count = count + 1 + this%coords(:, count) = [i, j, k] end if end if end do end do end do end do - - if (n < this%nMeasuredElements) call StopOnError(0, 0, "Missing measurment to update at movie probe") - end subroutine save_current_data + end subroutine get_measurements_coords subroutine write_vtu_timestep(this, stepIndex, filename) use vtk_fortran From def20784c723588dbcc31ee142f997d3a035f109 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 23 Dec 2025 10:36:40 +0100 Subject: [PATCH 44/67] Simplify argument requests --- src_output/CMakeLists.txt | 1 + src_output/output.F90 | 83 +++------ src_output/outputTypes.F90 | 329 ++++++++++++++--------------------- src_output/outputUpdater.F90 | 39 +++++ src_output/outputUtils.F90 | 105 ++++++----- src_utils/CMakeLists.txt | 6 + src_utils/valueReplacer.F90 | 155 +++++++++++++++++ 7 files changed, 420 insertions(+), 298 deletions(-) create mode 100644 src_output/outputUpdater.F90 create mode 100644 src_utils/CMakeLists.txt create mode 100644 src_utils/valueReplacer.F90 diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index 74f9847c..c59288ca 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -14,5 +14,6 @@ add_library(fdtd-output target_link_libraries(fdtd-output semba-types semba-components + semba-utils VTKFortran::VTKFortran ) \ No newline at end of file diff --git a/src_output/output.F90 b/src_output/output.F90 index c799e45a..91a8279f 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -46,6 +46,7 @@ module output REAL(KIND=RKIND), save :: eps0, mu0 REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu type(solver_output_t), pointer, dimension(:), save :: outputs + type(problem_info_t), save :: problemInfo interface init_solver_output module procedure & @@ -98,12 +99,18 @@ function GetOutputs() result(r) return end function + function GetProblemInfo() result(r) + type(problem_info_t), pointer :: r + r => problemInfo + return + end function + subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observationsExists, wiresExists) type(SGGFDTDINFO), intent(in) :: sgg type(media_matrices_t), intent(in) :: media type(limit_t), dimension(:), intent(in) :: SINPML_fullsize type(bounds_t) :: bounds - type(sim_control_t), intent(inout) :: control + type(sim_control_t), intent(in) :: control logical, intent(inout) :: wiresExists logical, intent(out) :: observationsExists @@ -119,6 +126,11 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio observationsExists = .false. requestedOutputs = get_required_output_count(sgg) + problemInfo%geometryToMaterialData => media + problemInfo%materialList => sgg%Med + problemInfo%simulationBounds => bounds + problemInfo%problemDimension => SINPML_fullsize + outputs => NULL() allocate (outputs(requestedOutputs)) @@ -156,7 +168,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = POINT_PROBE_ID allocate (outputs(outputCount)%pointProbe) - call init_solver_output(outputs(outputCount)%pointProbe, lowerBound, outputRequestType, domain, outputTypeExtension, control%mpidir, sgg%dt) + call init_solver_output(outputs(outputCount)%pointProbe, lowerBound, outputRequestType, domain, outputTypeExtension, control, sgg%dt) call create_empty_files(outputs(outputCount)%pointProbe) case (iJx, iJy, iJz) if (wiresExists) then @@ -164,7 +176,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = WIRE_CURRENT_PROBE_ID allocate (outputs(outputCount)%wireCurrentProbe) - call init_solver_output(outputs(outputCount)%wireCurrentProbe, lowerBound, NODE, outputRequestType, domain, sgg%Med, outputTypeExtension, control%mpidir, control%wiresflavor) + call init_solver_output(outputs(outputCount)%wireCurrentProbe, lowerBound, NODE, outputRequestType, domain, outputTypeExtension, control, problemInfo) call create_empty_files(outputs(outputCount)%wireCurrentProbe) end if @@ -173,7 +185,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = WIRE_CHARGE_PROBE_ID allocate (outputs(outputCount)%wireChargeProbe) - call init_solver_output(outputs(outputCount)%wireChargeProbe, lowerBound, NODE, outputRequestType, domain, outputTypeExtension, control%mpidir, control%wiresflavor) + call init_solver_output(outputs(outputCount)%wireChargeProbe, lowerBound, NODE, outputRequestType, domain, outputTypeExtension, control) call create_empty_files(outputs(outputCount)%wireChargeProbe) case (iBloqueJx, iBloqueJy, iBloqueJz, iBloqueMx, iBloqueMy, iBloqueMz) @@ -181,7 +193,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = BULK_PROBE_ID allocate (outputs(outputCount)%bulkCurrentProbe) - call init_solver_output(outputs(outputCount)%bulkCurrentProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control%mpidir) + call init_solver_output(outputs(outputCount)%bulkCurrentProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control) call create_empty_files(outputs(outputCount)%bulkCurrentProbe) !! call adjust_computation_range --- Required due to issues in mpi region edges @@ -193,7 +205,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputCount = outputCount + 1 outputs(outputCount)%outputID = MOVIE_PROBE_ID allocate (outputs(outputCount)%movieProbe) - call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, SINPML_fullsize, outputTypeExtension, control%mpidir) + call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control, problemInfo) call create_pvd(outputs(outputCount)%movieProbe%path, outputs(outputCount)%movieProbe%PDVUnit) else if (domain%domainType == FREQUENCY_DOMAIN) then @@ -201,7 +213,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputCount = outputCount + 1 outputs(outputCount)%outputID = FREQUENCY_SLICE_PROBE_ID allocate (outputs(outputCount)%frequencySliceProbe) - call init_solver_output(outputs(outputCount)%frequencySliceProbe, lowerBound, upperBound, outputRequestType, domain, media, sgg%Med, SINPML_fullsize, outputTypeExtension, control%mpidir, sgg%dt) + call init_solver_output(outputs(outputCount)%frequencySliceProbe, lowerBound, upperBound, sgg%dt, outputRequestType, domain, outputTypeExtension, control, problemInfo) call create_pvd(outputs(outputCount)%frequencySliceProbe%path, outputs(outputCount)%frequencySliceProbe%PDVUnit) end if @@ -211,7 +223,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputCount = outputCount + 1 outputs(outputCount)%outputID = FAR_FIELD_PROBE_ID allocate (outputs(outputCount)%farFieldOutput) - call init_solver_output(outputs(outputCount)%farFieldOutput, sgg, lowerBound, upperBound,outputRequestType, domain, sphericRange, control, outputTypeExtension, sgg%Observation(ii)%FileNormalize, eps0, mu0, media, SINPML_fullsize, bounds) + call init_solver_output(outputs(outputCount)%farFieldOutput, sgg, lowerBound, upperBound, outputRequestType, domain, sphericRange, outputTypeExtension, sgg%Observation(ii)%FileNormalize, control, problemInfo, eps0, mu0) case default call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') end select @@ -304,15 +316,11 @@ subroutine create_output_files() end do end subroutine create_output_files - subroutine update_outputs(geometryMedia, materialList, SINPML_fullsize, control, discreteTimeArray, timeIndx, fieldsReference, bounds) + subroutine update_outputs(control, discreteTimeArray, timeIndx, fieldsReference) integer(kind=SINGLE), intent(in) :: timeIndx real(kind=RKIND_tiempo), dimension(:), intent(in) :: discreteTimeArray integer(kind=SINGLE) :: i, id - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:) :: materialList - type(limit_t), dimension(:), intent(in) :: SINPML_fullsize type(sim_control_t), intent(in) :: control - type(bounds_t), intent(in) :: bounds real(kind=RKIND), pointer, dimension(:, :, :) :: fieldComponent type(field_data_t) :: fieldReference type(fields_reference_t), intent(in) :: fieldsReference @@ -323,63 +331,26 @@ subroutine update_outputs(geometryMedia, materialList, SINPML_fullsize, control, do i = 1, size(outputs) select case (outputs(i)%outputID) case (POINT_PROBE_ID) - fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos + fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent, fieldsReference) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos call update_solver_output(outputs(i)%pointProbe, discreteTime, fieldComponent) case (WIRE_CURRENT_PROBE_ID) - call update_solver_output(outputs(i)%wireCurrentProbe, discreteTime, control%wiresflavor, control%wirecrank, InvEps, InvMu) + call update_solver_output(outputs(i)%wireCurrentProbe, discreteTime, contorl, InvEps, InvMu) case (WIRE_CHARGE_PROBE_ID) call update_solver_output(outputs(i)%wireChargeProbe, discreteTime) case (BULK_PROBE_ID) - fieldReference = get_field_reference(outputs(i)%bulkCurrentProbe%fieldComponent) + fieldReference = get_field_reference(outputs(i)%bulkCurrentProbe%fieldComponent, fieldsReference) call update_solver_output(outputs(i)%bulkCurrentProbe, discreteTime, fieldReference) case (MOVIE_PROBE_ID) - call update_solver_output(outputs(i)%movieProbe, discreteTime, geometryMedia, materialList, SINPML_fullsize, fieldsReference) + call update_solver_output(outputs(i)%movieProbe, discreteTime, problemInfo, fieldsReference) case (FREQUENCY_SLICE_PROBE_ID) - call update_solver_output(outputs(i)%frequencySliceProbe, discreteTime, geometryMedia, materialList, SINPML_fullsize, fieldsReference) + call update_solver_output(outputs(i)%frequencySliceProbe, discreteTime, problemInfo, fieldsReference) case (FAR_FIELD_PROBE_ID) - call update_solver_output(outputs(i)%farFieldOutput, timeIndx, bounds, fieldsReference) + call update_solver_output(outputs(i)%farFieldOutput, timeIndx, problemInfo, fieldsReference) case default call stoponerror(0, 0, 'Output update not implemented') end select end do - contains - function get_field_component(fieldId) result(field) - integer(kind=SINGLE), intent(in) :: fieldId - real(kind=RKIND), pointer, dimension(:, :, :) :: field - select case (fieldId) - case (iEx); field => fieldsReference%E%x - case (iEy); field => fieldsReference%E%y - case (iEz); field => fieldsReference%E%z - case (iHx); field => fieldsReference%H%x - case (iHy); field => fieldsReference%H%y - case (iHz); field => fieldsReference%H%z - end select - end function get_field_component - - function get_field_reference(fieldId) result(field) - integer(kind=SINGLE), intent(in) :: fieldId - type(field_data_t) :: field - select case (fieldId) - case (iBloqueJx, iBloqueJy, iBloqueJz) - field%x => fieldsReference%E%x - field%y => fieldsReference%E%y - field%z => fieldsReference%E%z - - field%deltaX => fieldsReference%E%deltax - field%deltaY => fieldsReference%E%deltay - field%deltaZ => fieldsReference%E%deltaz - case (iBloqueMx, iBloqueMy, iBloqueMz) - field%x => fieldsReference%H%x - field%y => fieldsReference%H%y - field%z => fieldsReference%H%z - - field%deltaX => fieldsReference%H%deltax - field%deltaY => fieldsReference%H%deltay - field%deltaZ => fieldsReference%H%deltaz - end select - end function get_field_reference - end subroutine update_outputs subroutine flush_outputs(simulationTimeArray, simulationTimeIndex, control, fields, bounds, farFieldFlushRequested) diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 30b3f152..25bf163c 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -12,52 +12,50 @@ module outputTypes #endif implicit none - integer, parameter :: UNDEFINED_DOMAIN = -1 - integer, parameter :: TIME_DOMAIN = 0 - integer, parameter :: FREQUENCY_DOMAIN = 1 - integer, parameter :: BOTH_DOMAIN = 2 +!===================================================== +! Parameters & constants +!===================================================== + integer, parameter :: UNDEFINED_DOMAIN = -1 + integer, parameter :: TIME_DOMAIN = 0 + integer, parameter :: FREQUENCY_DOMAIN = 1 + integer, parameter :: BOTH_DOMAIN = 2 character(len=4), parameter :: datFileExtension = '.dat' - character(len=4), parameter :: timeExtension = 'tm' + character(len=4), parameter :: timeExtension = 'tm' character(len=4), parameter :: frequencyExtension = 'fq' - type solver_output_t - integer(kind=SINGLE) :: outputID - type(point_probe_output_t), allocatable :: pointProbe !iEx, iEy, iEz, iHx, iHy, iHz - type(wire_current_probe_output_t), allocatable :: wireCurrentProbe !Jx, Jy, Jz - type(wire_charge_probe_output_t), allocatable :: wireChargeProbe !Qx, Qy, Qz - type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe !BloqueXJ, BloqueYJ, BloqueZJ, BloqueXM, BloqueYM, BloqueZM - type(volumic_current_probe_t), allocatable :: volumicCurrentProbe !icurX, icurY, icurZ - type(volumic_field_probe_output_t), allocatable :: volumicFieldProbe - type(line_integral_probe_output_t), allocatable :: lineIntegralProbe - type(movie_probe_output_t), allocatable :: movieProbe !iCur if timeDomain - type(frequency_slice_probe_output_t), allocatable :: frequencySliceProbe !iCur if freqDomain - type(far_field_probe_output_t), allocatable :: farFieldOutput !farfield - -#ifdef CompileWithMPI - integer(kind=4) :: MPISubcomm, MPIRoot, MPIGroupIndex - integer(kind=4) :: ZIorig, ZEorig -#endif - end type solver_output_t +!===================================================== +! Basic helper / geometry types +!===================================================== + type :: cell_coordinate_t + integer(kind=SINGLE) :: x, y, z + end type cell_coordinate_t type :: domain_t - real(kind=RKIND_tiempo) :: tstart = 0.0_RKIND_tiempo, tstop = 0.0_RKIND_tiempo, tstep = 0.0_RKIND_tiempo - real(kind=RKIND) :: fstart = 0.0_RKIND, fstop = 0.0_RKIND, fstep + real(kind=RKIND_tiempo) :: tstart = 0.0_RKIND_tiempo + real(kind=RKIND_tiempo) :: tstop = 0.0_RKIND_tiempo + real(kind=RKIND_tiempo) :: tstep = 0.0_RKIND_tiempo + real(kind=RKIND) :: fstart = 0.0_RKIND + real(kind=RKIND) :: fstop = 0.0_RKIND + real(kind=RKIND) :: fstep integer(kind=SINGLE) :: fnum = 0 integer(kind=SINGLE) :: domainType = UNDEFINED_DOMAIN logical :: logarithmicSpacing = .false. end type domain_t - type spheric_domain_t - real(kind=RKIND) :: phiStart = 0.0_RKIND, phiStop = 0.0_RKIND, phiStep = 0.0_RKIND - real(kind=RKIND) :: thetaStart = 0.0_RKIND, thetaStop = 0.0_RKIND, thetastep = 0.0_RKIND - end type - - type cell_coordinate_t - integer(kind=SINGLE) :: x, y, z - end type cell_coordinate_t - - type field_data_t + type :: spheric_domain_t + real(kind=RKIND) :: phiStart = 0.0_RKIND + real(kind=RKIND) :: phiStop = 0.0_RKIND + real(kind=RKIND) :: phiStep = 0.0_RKIND + real(kind=RKIND) :: thetaStart = 0.0_RKIND + real(kind=RKIND) :: thetaStop = 0.0_RKIND + real(kind=RKIND) :: thetastep = 0.0_RKIND + end type spheric_domain_t + +!===================================================== +! Field & current data containers +!===================================================== + type :: field_data_t real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: x => NULL() real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: y => NULL() real(kind=RKIND), pointer, dimension(:, :, :), contiguous :: z => NULL() @@ -66,190 +64,133 @@ module outputTypes real(kind=RKIND), pointer, dimension(:), contiguous :: deltaZ => NULL() end type field_data_t - type fields_reference_t + type :: fields_reference_t type(field_data_t) :: E type(field_data_t) :: H end type fields_reference_t - type point_probe_output_t - integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field - type(domain_t) :: domain - type(cell_coordinate_t) :: coordinates + type :: current_values_t + real(kind=RKIND) :: current = 0.0_RKIND + real(kind=RKIND) :: deltaVoltage = 0.0_RKIND + real(kind=RKIND) :: plusVoltage = 0.0_RKIND + real(kind=RKIND) :: minusVoltage = 0.0_RKIND + real(kind=RKIND) :: voltageDiference = 0.0_RKIND + end type current_values_t + +!===================================================== +! Abstract probe hierarchy +!===================================================== + type :: abstract_probe_t + integer(kind=SINGLE) :: columnas + type(domain_t) :: domain + type(cell_coordinate_t) :: mainCoords + integer(kind=SINGLE) :: component + character(len=BUFSIZE) :: path + end type abstract_probe_t + + type, extends(abstract_probe_t) :: abstract_time_probe_t + integer(kind=SINGLE) :: fileUnitTime + integer(kind=SINGLE) :: nTime + real(kind=RKIND_tiempo), allocatable :: timeStep(:) + end type abstract_time_probe_t + + type, extends(abstract_probe_t) :: abstract_frequency_probe_t + integer(kind=SINGLE) :: fileUnitFreq + integer(kind=SINGLE) :: nFreq + real(kind=RKIND), allocatable :: frequencySlice(:) + complex(kind=CKIND), allocatable :: auxExp_E(:), auxExp_H(:) + end type abstract_frequency_probe_t + + type, extends(abstract_probe_t) :: abstract_time_frequency_probe_t integer(kind=SINGLE) :: fileUnitTime, fileUnitFreq - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: fieldComponent - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE, nFreq = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND - - real(kind=RKIND), dimension(:), allocatable :: frequencySlice - complex(kind=CKIND), dimension(:), allocatable :: valueForFreq - complex(kind=CKIND), dimension(:), allocatable :: auxExp_E - complex(kind=CKIND), dimension(:), allocatable :: auxExp_H + integer(kind=SINGLE) :: nTime, nFreq + real(kind=RKIND_tiempo), allocatable :: timeStep(:) + real(kind=RKIND), allocatable :: frequencySlice(:) + complex(kind=CKIND), allocatable :: auxExp_E(:), auxExp_H(:) + end type abstract_time_frequency_probe_t + +!===================================================== +! Concrete probe types +!===================================================== + type, extends(abstract_time_frequency_probe_t) :: point_probe_output_t + real(kind=RKIND) :: valueForTime(:) + complex(kind=CKIND), allocatable :: valueForFreq(:) end type point_probe_output_t - type wire_charge_probe_output_t - integer(kind=SINGLE) :: columnas = 2_SINGLE - integer(kind=SINGLE) :: fileUnitTime - type(domain_t) :: domain - type(cell_coordinate_t) :: coordinates - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: chargeComponent + type, extends(abstract_time_probe_t) :: wire_charge_probe_output_t integer(kind=SINGLE) :: sign = +1 - + real(kind=RKIND) :: chargeValue(:) type(CurrentSegments), pointer :: segment - - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - real(kind=RKIND), dimension(BuffObse) :: chargeValue end type wire_charge_probe_output_t - type current_values_t - real(kind=RKIND) :: current = 0.0_RKIND, deltaVoltage = 0.0_RKIND - real(kind=RKIND) :: plusVoltage = 0.0_RKIND, minusVoltage = 0.0_RKIND, voltageDiference = 0.0_RKIND - end type - - type wire_current_probe_output_t - integer(kind=SINGLE) :: columnas = 6_SINGLE !reference, corriente, -e*dl, vplus, vminus, vplus-vminus - integer(kind=SINGLE) :: fileUnitTime - type(domain_t) :: domain - type(cell_coordinate_t) :: coordinates - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: currentComponent + type :: wire_current_probe_output_t integer(kind=SINGLE) :: sign = +1 - + type(current_values_t) :: currentValues(BuffObse) type(CurrentSegments), pointer :: segment #ifdef CompileWithBerengerWires - type(TSegment), pointer :: segmentBerenger + type(TSegment), pointer :: segmentBerenger #endif #ifdef CompileWithSlantedWires - class(Segment), pointer :: segmentSlanted + class(Segment), pointer :: segmentSlanted #endif - - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - type(current_values_t), dimension(BuffObse) :: currentValues end type wire_current_probe_output_t - type bulk_current_probe_output_t - integer(kind=SINGLE) :: columnas = 2_SINGLE !reference and field - integer(kind=SINGLE) :: fileUnitTime - type(domain_t) :: domain - type(cell_coordinate_t) :: lowerBound - type(cell_coordinate_t) :: upperBound - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: fieldComponent - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(BuffObse) :: timeStep = 0.0_RKIND - real(kind=RKIND), dimension(BuffObse) :: valueForTime = 0.0_RKIND - + type, extends(abstract_time_probe_t) :: bulk_current_probe_output_t + type(cell_coordinate_t) :: auxCoords + real(kind=RKIND) :: valueForTime(:) end type bulk_current_probe_output_t - type volumic_current_probe_t - integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components - type(domain_t) :: domain - type(cell_coordinate_t) :: lowerBound - type(cell_coordinate_t) :: upperBound - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: fieldComponent - - !Intent storage order: - !(:) == (timeinstance) => timeValue - !(:,:) == (timeInstance, componentId) => escalar - - !Time Domain (requires first allocation) - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(:), allocatable :: timeStep - real(kind=RKIND), dimension(:, :), allocatable :: xValueForTime - real(kind=RKIND), dimension(:, :), allocatable :: yValueForTime - real(kind=RKIND), dimension(:, :), allocatable :: zValueForTime - - !Intent storage order: - !(:) == (frquencyinstance) => timeValue - !(:,:) == (frquencyinstance, componentId) => escalar - - !Frequency Domain (requires first allocation) - integer(kind=SINGLE) :: nFreq = 0_SINGLE - real(kind=RKIND), dimension(:), allocatable :: frequencySlice - complex(kind=CKIND), dimension(:, :), allocatable :: xValueForFreq - complex(kind=CKIND), dimension(:, :), allocatable :: yValueForFreq - complex(kind=CKIND), dimension(:, :), allocatable :: zValueForFreq - complex(kind=CKIND), dimension(:), allocatable :: auxExp_E - complex(kind=CKIND), dimension(:), allocatable :: auxExp_H - - end type volumic_current_probe_t - - type volumic_field_probe_output_t - !!!!!Pending - end type volumic_field_probe_output_t - type line_integral_probe_output_t - !!!!!Pending - end type line_integral_probe_output_t - type far_field_probe_output_t - integer(kind=SINGLE) :: fileUnitFreq - integer(kind=SINGLE) :: fieldComponent - integer(kind=SINGLE) :: columnas = 6_SINGLE !reference and current components - type(domain_t) :: domain - type(spheric_domain_t) :: sphericRange - type(cell_coordinate_t) :: lowerBound - type(cell_coordinate_t) :: upperBound - character(len=BUFSIZE) :: path - - integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE - integer(kind=SINGLE), dimension(:, :), allocatable :: coords - integer(kind=SINGLE) :: nFreq = 0_SINGLE - real(kind=RKIND), dimension(:), allocatable :: frequencySlice - complex(kind=CKIND), dimension(:, :), allocatable :: valueForFreq + type, extends(abstract_frequency_probe_t) :: far_field_probe_output_t + type(spheric_domain_t) :: sphericRange + type(cell_coordinate_t) :: auxCoords + integer(kind=SINGLE) :: nPoints + integer(kind=SINGLE), allocatable :: coords(:, :) + complex(kind=CKIND), allocatable :: valueForFreq(:, :) end type far_field_probe_output_t - type movie_probe_output_t - integer(kind=SINGLE) :: PDVUnit - integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components - type(domain_t) :: domain - type(cell_coordinate_t) :: lowerBound - type(cell_coordinate_t) :: upperBound - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: fieldComponent - - integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE - integer(kind=SINGLE), dimension(:, :), allocatable :: coords - - !Intent storage order: - !(:) == (timeinstance) => timeValue - !(:,:) == (timeInstance, componentId) => escalar - - !Time Domain (requires first allocation) - integer(kind=SINGLE) :: serializedTimeSize = 0_SINGLE - real(kind=RKIND_tiempo), dimension(:), allocatable :: timeStep - real(kind=RKIND), dimension(:, :), allocatable :: xValueForTime - real(kind=RKIND), dimension(:, :), allocatable :: yValueForTime - real(kind=RKIND), dimension(:, :), allocatable :: zValueForTime + + type, extends(abstract_time_probe_t) :: movie_probe_output_t + type(cell_coordinate_t) :: auxCoords + integer(kind=SINGLE) :: nPoints + integer(kind=SINGLE), allocatable :: coords(:, :) + real(kind=RKIND), allocatable :: xValueForTime(:, :) + real(kind=RKIND), allocatable :: yValueForTime(:, :) + real(kind=RKIND), allocatable :: zValueForTime(:, :) end type movie_probe_output_t - type frequency_slice_probe_output_t - integer(kind=SINGLE) :: PDVUnit - integer(kind=SINGLE) :: columnas = 4_SINGLE !reference and current components - type(domain_t) :: domain - type(cell_coordinate_t) :: lowerBound - type(cell_coordinate_t) :: upperBound - character(len=BUFSIZE) :: path - integer(kind=SINGLE) :: fieldComponent - - integer(kind=SINGLE) :: nMeasuredElements = 0_SINGLE - integer(kind=SINGLE), dimension(:, :), allocatable :: coords - - !Intent storage order: - !(:) == (frquencyinstance) => timeValue - !(:,:) == (frquencyinstance, componentId) => escalar - - !Frequency Domain (requires first allocation) - integer(kind=SINGLE) :: nFreq = 0_SINGLE - real(kind=RKIND), dimension(:), allocatable :: frequencySlice - complex(kind=CKIND), dimension(:, :), allocatable :: xValueForFreq - complex(kind=CKIND), dimension(:, :), allocatable :: yValueForFreq - complex(kind=CKIND), dimension(:, :), allocatable :: zValueForFreq - complex(kind=CKIND), dimension(:), allocatable :: auxExp_E - complex(kind=CKIND), dimension(:), allocatable :: auxExp_H + + type, extends(abstract_frequency_probe_t) :: frequency_slice_probe_output_t + type(cell_coordinate_t) :: auxCoords + integer(kind=SINGLE) :: nPoints + integer(kind=SINGLE), allocatable :: coords(:, :) + complex(kind=CKIND), allocatable :: xValueForFreq(:, :) + complex(kind=CKIND), allocatable :: yValueForFreq(:, :) + complex(kind=CKIND), allocatable :: zValueForFreq(:, :) end type frequency_slice_probe_output_t +!===================================================== +! High-level aggregation types +!===================================================== + type :: solver_output_t + integer(kind=SINGLE) :: outputID + type(point_probe_output_t), allocatable :: pointProbe + type(wire_current_probe_output_t), allocatable :: wireCurrentProbe + type(wire_charge_probe_output_t), allocatable :: wireChargeProbe + type(bulk_current_probe_output_t), allocatable :: bulkCurrentProbe + type(movie_probe_output_t), allocatable :: movieProbe + type(frequency_slice_probe_output_t), allocatable :: frequencySliceProbe + type(far_field_probe_output_t), allocatable :: farFieldOutput +#ifdef CompileWithMPI + integer(kind=4) :: MPISubcomm, MPIRoot, MPIGroupIndex + integer(kind=4) :: ZIorig, ZEorig +#endif + end type solver_output_t + + type :: problem_info_t + type(media_matrices_t), pointer :: geometryToMaterialData + type(limit_t), pointer :: problemDimension(:) + type(bounds_t), pointer :: simulationBounds + type(MediaData_t), pointer :: materialList(:) + end type problem_info_t + contains end module outputTypes diff --git a/src_output/outputUpdater.F90 b/src_output/outputUpdater.F90 new file mode 100644 index 00000000..963c42d0 --- /dev/null +++ b/src_output/outputUpdater.F90 @@ -0,0 +1,39 @@ +module mod_outputUpdater + implicit none + use FDETYPES +contains + subroutine save_next_scalar(scalar, idx, val) + real, intent(inout) :: scalar(:) + integer, intent(in) :: idx + real, intent(in) :: val + scalar(idx) = val + end subroutine save_next_scalar + + subroutine save_next_vector(xVector, yVector, zVector, idx, xVal, yVal, zVal) + real, intent(inout) :: xVector(:), yVector(:), zVector(:) + integer, intent(in) :: idx + real, intent(in) :: xVal, yVal, zVal + xVector(idx) = xVal + yVector(idx) = yVal + zVector(idx) = zVal + end subroutine save_next_vector + + subroutine add_value(scalar, idx, val) + complex, intent(inout) :: scalar(:) + integer, intent(in) :: idx + complex, intent(in) :: val + scalar(idx) = val + scalar(idx) + end subroutine update_scalar_value_freq + + subroutine update_vector_value_freq(xVector, yVector, zVector, idx, xVal, yVal, zVal) + real, intent(inout) :: xVector(:), yVector(:), zVector(:) + integer, intent(in) :: idx + real, intent(in) :: xVal, yVal, zVal + xVector(idx) = xVal + xVector(idx) + yVector(idx) = yVal + yVector(idx) + zVector(idx) = zVal + zVector(idx) + end subroutine update_vector_value_freq + + subroutine save_scalar_timestep_for_valid_points(scalar, lowerCoord, upperCoord, idx) + +end module mod_outputUpdater \ No newline at end of file diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 3e06b4fc..82bec233 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -13,6 +13,8 @@ module mod_outputUtils !=========================== public :: get_coordinates_extension public :: get_prefix_extension + public :: get_field_component + public :: get_field_reference public :: open_file public :: close_file public :: create_or_clear_file @@ -398,6 +400,30 @@ function get_field_component(fieldId, fieldReference) result(component) end select end function + function get_field_reference(fieldId, fieldReference) result(field) + type(fields_reference_t), intent(in) :: fieldReference + integer(kind=SINGLE), intent(in) :: fieldId + type(field_data_t) :: field + select case (fieldId) + case (iBloqueJx, iBloqueJy, iBloqueJz) + field%x => fieldsReference%E%x + field%y => fieldsReference%E%y + field%z => fieldsReference%E%z + + field%deltaX => fieldsReference%E%deltax + field%deltaY => fieldsReference%E%deltay + field%deltaZ => fieldsReference%E%deltaz + case (iBloqueMx, iBloqueMy, iBloqueMz) + field%x => fieldsReference%H%x + field%y => fieldsReference%H%y + field%z => fieldsReference%H%z + + field%deltaX => fieldsReference%H%deltax + field%deltaY => fieldsReference%H%deltay + field%deltaZ => fieldsReference%H%deltaz + end select + end function get_field_reference + function open_file(fileUnit, fileName) result(iostat) character(len=*), intent(in) :: fileName integer(kind=SINGLE), intent(in) :: fileUnit @@ -444,82 +470,65 @@ integer function getBlockCurrentDirection(field) end select end function - logical function isThinWire(field, i, j, k, geometryMedia, registeredMedia) + logical function isThinWire(field, i, j, k, problem) integer(kind=4), intent(in) :: field, i, j, k - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:), intent(in) :: registeredMedia + type(problem_info_t), intent(in) :: problem integer(kind=SINGLE) :: mediaIndex - mediaIndex = getMediaIndex(field, i, j, k, geometryMedia) - isThinWire = registeredMedia(mediaIndex)%is%ThinWire + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) + isThinWire = problem%materialList(mediaIndex)%is%ThinWire end function - logical function isPEC(field, i, j, k, geometryMedia, registeredMedia) + logical function isPEC(field, i, j, k, problem) integer(kind=4), intent(in) :: field, i, j, k - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:), intent(in) :: registeredMedia + type(problem_info_t), intent(in) :: problem integer(kind=SINGLE) :: mediaIndex - mediaIndex = getMediaIndex(field, i, j, k, geometryMedia) - isPEC = registeredMedia(mediaIndex)%is%PEC + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) + isPEC = problem%materialList(mediaIndex)%is%PEC end function - logical function isSurface(field, i, j, k, geometryMedia, registeredMedia) + logical function isSurface(field, i, j, k, problem) integer(kind=4), intent(in) :: field, i, j, k - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:), intent(in) :: registeredMedia + type(problem_info_t), intent(in) :: problem integer(kind=SINGLE) :: mediaIndex - mediaIndex = getMediaIndex(field, i, j, k, geometryMedia) - isSurface = registeredMedia(mediaIndex)%is%Surface + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) + isSurface = problem%materialList(mediaIndex)%is%Surface end function - function getMediaIndex(field, i, j, k, media) result(res) - type(media_matrices_t), intent(in) :: media + logical function isWithinBounds(field, i, j, k, problem) integer(kind=4), intent(in) :: field, i, j, k - integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: res - select case (field) - case (iEx); res = media%sggMiEx(i, j, k) - case (iEy); res = media%sggMiEy(i, j, k) - case (iEz); res = media%sggMiEz(i, j, k) - case (iHx); res = media%sggMiHx(i, j, k) - case (iHy); res = media%sggMiHy(i, j, k) - case (iHz); res = media%sggMiHz(i, j, k) - case default; call StopOnError(0, 0, 'Unrecognized field') - end select + type(problem_info_t), intent(in) :: problem + + isWithinBounds = (i <= problem%problemDimension(field)%XE) .and. & + (j <= problem%problemDimension(field)%YE) .and. & + (k <= problem%problemDimension(field)%ZE) end function - logical function isWithinBounds(field, i, j, k, SINPML_fullsize) - implicit none - TYPE(limit_t), DIMENSION(:), INTENT(IN) :: SINPML_fullsize + logical function isMediaVacuum(field, i, j, k, problem) integer(kind=4), intent(in) :: field, i, j, k - isWithinBounds = (i <= SINPML_fullsize(field)%XE) .and. & - (j <= SINPML_fullsize(field)%YE) .and. & - (k <= SINPML_fullsize(field)%ZE) - end function + type(problem_info_t), intent(in) :: problem - logical function isMediaVacuum(field, i, j, k, media) - implicit none - TYPE(media_matrices_t), INTENT(IN) :: media - integer(kind=4) :: field, i, j, k - integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex, vacuum = 1 - mediaIndex = getMediaIndex(field, i, j, k, media) + integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex + integer(kind=INTEGERSIZEOFMEDIAMATRICES), parameter :: vacuum = 1 + + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) isMediaVacuum = (mediaIndex == vacuum) end function - logical function isSplitOrAdvanced(field, i, j, k, media, simulationMedia) - implicit none - type(MediaData_t), dimension(:), intent(in) :: simulationMedia - type(media_matrices_t), intent(in) :: media - integer(kind=4) :: field, i, j, k + logical function isSplitOrAdvanced(field, i, j, k, problem) + integer(kind=4), intent(in) :: field, i, j, k + type(problem_info_t), intent(in) :: problem + integer(kind=INTEGERSIZEOFMEDIAMATRICES) :: mediaIndex - mediaIndex = getMediaIndex(field, i, j, k, media) - isSplitOrAdvanced = simulationMedia(mediaIndex)%is%split_and_useless .or. & - simulationMedia(mediaIndex)%is%already_YEEadvanced_byconformal + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) + isSplitOrAdvanced = problem%materialList(mediaIndex)%is%split_and_useless .or. & + problem%materialList(mediaIndex)%is%already_YEEadvanced_byconformal end function function computej(field, i, j, k, fields_reference) result(res) diff --git a/src_utils/CMakeLists.txt b/src_utils/CMakeLists.txt new file mode 100644 index 00000000..e0c36221 --- /dev/null +++ b/src_utils/CMakeLists.txt @@ -0,0 +1,6 @@ +add_library(fdtd-utils + "valueReplacer.f90" +) +target_link_libraries(fdtd-utils + semba-types +) \ No newline at end of file diff --git a/src_utils/valueReplacer.F90 b/src_utils/valueReplacer.F90 new file mode 100644 index 00000000..0fd5f4bc --- /dev/null +++ b/src_utils/valueReplacer.F90 @@ -0,0 +1,155 @@ +module value_replacer_mod + implicit none + use FDETYPES, only: RKIND, CKIND, SINGLE, RKIND_tiempo + private + + public :: replace_value + + interface replace_value + ! Scalars + module procedure replace_scalar_int + module procedure replace_scalar_real + module procedure replace_scalar_real_t + module procedure replace_scalar_complex + + ! 1D arrays + module procedure replace_1d_int + module procedure replace_1d_real + module procedure replace_1d_real_t + module procedure replace_1d_complex + + ! 2D arrays + module procedure replace_2d_int + module procedure replace_2d_real + module procedure replace_2d_real_t + module procedure replace_2d_complex + + ! 3D arrays + module procedure replace_3d_int + module procedure replace_3d_real + module procedure replace_3d_real_t + module procedure replace_3d_complex + end interface + +contains + !===================== + ! Scalar replacements + !===================== + subroutine replace_scalar_int(x, val) + integer(SINGLE), intent(inout) :: x + integer(SINGLE), intent(in) :: val + x = val + end subroutine + + subroutine replace_scalar_real(x, val) + real(RKIND), intent(inout) :: x + real(RKIND), intent(in) :: val + x = val + end subroutine + + subroutine replace_scalar_real_t(x, val) + real(RKIND_tiempo), intent(inout) :: x + real(RKIND_tiempo), intent(in) :: val + x = val + end subroutine + + subroutine replace_scalar_complex(x, val) + complex(CKIND), intent(inout) :: x + complex(CKIND), intent(in) :: val + x = val + end subroutine + + !===================== + ! 1D array replacements + !===================== + subroutine replace_1d_int(x, idx1, val) + integer(SINGLE), intent(inout) :: x(:) + integer(SINGLE), intent(in) :: idx1 + integer(SINGLE), intent(in) :: val + x(idx1) = val + end subroutine + + subroutine replace_1d_real(x, idx1, val) + real(RKIND), intent(inout) :: x(:) + integer(SINGLE), intent(in) :: idx1 + real(RKIND), intent(in) :: val + x(idx1) = val + end subroutine + + subroutine replace_1d_real_t(x, idx1, val) + real(RKIND_tiempo), intent(inout) :: x(:) + integer(SINGLE), intent(in) :: idx1 + real(RKIND_tiempo), intent(in) :: val + x(idx1) = val + end subroutine + + subroutine replace_1d_complex(x, idx1, val) + complex(CKIND), intent(inout) :: x(:) + integer(SINGLE), intent(in) :: idx1 + complex(CKIND), intent(in) :: val + x(idx1) = val + end subroutine + + !===================== + ! 2D array replacements + !===================== + subroutine replace_2d_int(x, idx1, idx2, val) + integer(SINGLE), intent(inout) :: x(:,:) + integer(SINGLE), intent(in) :: idx1, idx2 + integer(SINGLE), intent(in) :: val + x(idx1, idx2) = val + end subroutine + + subroutine replace_2d_real(x, idx1, idx2, val) + real(RKIND), intent(inout) :: x(:,:) + integer(SINGLE), intent(in) :: idx1, idx2 + real(RKIND), intent(in) :: val + x(idx1, idx2) = val + end subroutine + + subroutine replace_2d_real_t(x, idx1, idx2, val) + real(RKIND_tiempo), intent(inout) :: x(:,:) + integer(SINGLE), intent(in) :: idx1, idx2 + real(RKIND_tiempo), intent(in) :: val + x(idx1, idx2) = val + end subroutine + + subroutine replace_2d_complex(x, idx1, idx2, val) + complex(CKIND), intent(inout) :: x(:,:) + integer(SINGLE), intent(in) :: idx1, idx2 + complex(CKIND), intent(in) :: val + x(idx1, idx2) = val + end subroutine + + !===================== + ! 3D array replacements + !===================== + subroutine replace_3d_int(x, idx1, idx2, idx3, val) + integer(SINGLE), intent(inout) :: x(:,:,:) + integer(SINGLE), intent(in) :: idx1, idx2, idx3 + integer(SINGLE), intent(in) :: val + x(idx1, idx2, idx3) = val + end subroutine + + subroutine replace_3d_real(x, idx1, idx2, idx3, val) + real(RKIND), intent(inout) :: x(:,:,:) + integer(SINGLE), intent(in) :: idx1, idx2, idx3 + real(RKIND), intent(in) :: val + x(idx1, idx2, idx3) = val + end subroutine + + subroutine replace_3d_real_t(x, idx1, idx2, idx3, val) + real(RKIND_tiempo), intent(inout) :: x(:,:,:) + integer(SINGLE), intent(in) :: idx1, idx2, idx3 + real(RKIND_tiempo), intent(in) :: val + x(idx1, idx2, idx3) = val + end subroutine + + subroutine replace_3d_complex(x, idx1, idx2, idx3, val) + complex(CKIND), intent(inout) :: x(:,:,:) + integer(SINGLE), intent(in) :: idx1, idx2, idx3 + complex(CKIND), intent(in) :: val + x(idx1, idx2, idx3) = val + end subroutine + +end module value_replacer_mod From 1b2c275c3d9853b4b67efd9b7673c5a1812387fd Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 23 Dec 2025 11:37:37 +0100 Subject: [PATCH 45/67] Added legend to movie probe --- src_output/movieProbeOutput.F90 | 365 ++++++++++++++++++-------------- 1 file changed, 207 insertions(+), 158 deletions(-) diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 85bd61d2..efa83389 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -17,10 +17,27 @@ module mod_movieProbeOutput !=========================== ! Private interface summary !=========================== - private :: get_measurements_coords - private :: save_current_data + ! Data Extraction & Processing + private :: count_required_coords + private :: save_current_module + private :: save_current_component + private :: save_current + private :: save_field_module + private :: save_field_component + private :: save_field + + ! Output & File Management private :: write_vtu_timestep private :: update_pvd + + ! Validation Logic (Functions) + private :: isValidPointForCurrent + private :: isValidPointForField + private :: volumicCurrentRequest + private :: volumicElectricRequest + private :: volumicMagneticRequest + private :: componentCurrentRequest + private :: componentFieldRequest !=========================== contains @@ -28,7 +45,7 @@ module mod_movieProbeOutput subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, control, problemInfo, outputTypeExtension) type(movie_probe_output_t), intent(out) :: this type(cell_coordinate_t), intent(in) :: lowerBound, upperBound - integer(kind=SINGLE), intent(in) :: mpidir, field + integer(kind=SINGLE), intent(in) :: field character(len=BUFSIZE), intent(in) :: outputTypeExtension type(sim_control_t), intent(in) :: control @@ -36,29 +53,29 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, type(domain_t), intent(in) :: domain - this%lowerBound = lowerBound - this%upperBound = upperBound - this%fieldComponent = field !This can refer to field or currentDensity + this%mainCoords = lowerBound + this%auxCoords = upperBound + this%component = field !This can refer to electric, magnetic or currentDensity this%domain = domain this%path = get_output_path() - call get_measurements_coords(this, problemInfo) + call count_required_coords(this, problemInfo) call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) - if (any(VOLUMIC_M_MEASURE == this%fieldComponent)) then - call alloc_and_init(this%xValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) - call alloc_and_init(this%yValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) - call alloc_and_init(this%zValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) + if (any(VOLUMIC_M_MEASURE == this%component)) then + call alloc_and_init(this%xValueForTime, BuffObse, this%nPoints, 0.0_RKIND) + call alloc_and_init(this%yValueForTime, BuffObse, this%nPoints, 0.0_RKIND) + call alloc_and_init(this%zValueForTime, BuffObse, this%nPoints, 0.0_RKIND) else - if (any(VOLUMIC_X_MEASURE == this%fieldComponent)) then - call alloc_and_init(this%xValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) - elseif (any(VOLUMIC_Y_MEASURE == this%fieldComponent)) then - call alloc_and_init(this%yValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) - elseif (any(VOLUMIC_Z_MEASURE == this%fieldComponent)) then - call alloc_and_init(this%zValueForTime, BuffObse, this%nMeasuredElements, 0.0_RKIND) + if (any(VOLUMIC_X_MEASURE == this%component)) then + call alloc_and_init(this%xValueForTime, BuffObse, this%nPoints, 0.0_RKIND) + elseif (any(VOLUMIC_Y_MEASURE == this%component)) then + call alloc_and_init(this%yValueForTime, BuffObse, this%nPoints, 0.0_RKIND) + elseif (any(VOLUMIC_Z_MEASURE == this%component)) then + call alloc_and_init(this%zValueForTime, BuffObse, this%nPoints, 0.0_RKIND) else - call StopOnError(0, 0, "Unexpected output type for movie probe") + call StopOnError(control%layoutnumber, control%size, "Unexpected output type for movie probe") end if end if @@ -66,7 +83,7 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, control%mpidir) + probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%auxCoords, control%mpidir) prefixFieldExtension = get_prefix_extension(field, control%mpidir) outputPath = & trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) @@ -82,9 +99,9 @@ subroutine update_movie_probe_output(this, step, fieldsReference, problemInfo) type(fields_reference_t), intent(in) :: fieldsReference integer(kind=4) :: request - request = this%fieldComponent + request = this%component - this%serializedTimeSize = this%serializedTimeSize + 1 + this%nTime = this%nTime + 1 if (any(VOLUMIC_M_MEASURE == request)) then select case (request) @@ -128,16 +145,18 @@ subroutine save_current_module(this, fieldsReference, simTime, problemInfo) integer :: i, j, k, coordIdx - this%timeStep(this%serializedTimeSize) = simTime + this%timeStep(this%nTime) = simTime coordIdx = 0 - do i = this%lowerBound%x, this%upperBound%x - do j = this%lowerBound%y, this%upperBound%y - do k = this%lowerBound%z, this%upperBound%z + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (isValidForCurrent(iCur, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_current(this%xValueForTime, timeIdx, coordIdx, iEx, i, j, k, fieldsReference, problemInfo) - call save_current(this%yValueForTime, timeIdx, coordIdx, iEy, i, j, k, fieldsReference, problemInfo) - call save_current(this%zValueForTime, timeIdx, coordIdx, iEz, i, j, k, fieldsReference, problemInfo) + call save_current(this%xValueForTime, timeIdx, coordIdx, iEx, i, j, k, fieldsReference) + call save_current(this%yValueForTime, timeIdx, coordIdx, iEy, i, j, k, fieldsReference) + call save_current(this%zValueForTime, timeIdx, coordIdx, iEz, i, j, k, fieldsReference) + end if end do end do end do @@ -152,51 +171,52 @@ subroutine save_current_component(currentData, fieldsReference, simTime, problem integer :: i, j, k, coordIdx - this%timeStep(this%serializedTimeSize) = simTime + this%timeStep(this%nTime) = simTime coordIdx = 0 - do i = this%lowerBound%x, this%upperBound%x - do j = this%lowerBound%y, this%upperBound%y - do k = this%lowerBound%z, this%upperBound%z - coordIdx = coordIdx + 1 - call save_current(currentData, timeIdx, coordIdx, fieldDir, i, j, k, fieldsReference, problemInfo) + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (isValidForCurrent(fieldDir, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + call save_current(currentData, timeIdx, coordIdx, fieldDir, i, j, k, fieldsReference) + end if end do end do end do end subroutine - subroutine save_current(currentData, timeIdx, coordIdx, field, i, j, k, fieldsReference, problemInfo) + subroutine save_current(currentData, timeIdx, coordIdx, field, i, j, k, fieldsReference) real(kind=RKIND), intent(inout) :: currentData(:, :) integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx, field, i, j, k type(fields_reference_t), intent(in) :: fieldsReference - type(problem_info_t), intent(in) :: problemInfo real(kind=RKIND) :: jdir - jdir = 0.0 - if (saveCurrentFrom(field, i,j,k, problemInfo)) then - jdir = computeJ(field, i, j, k, fieldsReference) - end if + jdir = computeJ(field, i, j, k, fieldsReference) currentData(timeIdx, coordIdx) = jdir end subroutine - subroutine save_field_module(this, field, simTime, problemInfo) + subroutine save_field_module(this, field, simTime, problemInfo, request) type(movie_probe_output_t), intent(inout) :: this type(field_data_t), pointer :: field real(kind=RKIND_tiempo), intent(in) :: simTime type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: request integer :: i, j, k, coordIdx - this%timeStep(this%serializedTimeSize) = simTime + this%timeStep(this%nTime) = simTime coordIdx = 0 - do i = this%lowerBound%x, this%upperBound%x - do j = this%lowerBound%y, this%upperBound%y - do k = this%lowerBound%z, this%upperBound%z - coordIdx = coordIdx + 1 - call save_field(this%xValueForTime, timeIdx, coordIdx, iEx, i, j, k, field%x(i, j, k), problemInfo) - call save_field(this%yValueForTime, timeIdx, coordIdx, iEy, i, j, k, field%y(i, j, k), problemInfo) - call save_field(this%zValueForTime, timeIdx, coordIdx, iEz, i, j, k, field%z(i, j, k), problemInfo) + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (isValidPointForField(request, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + call save_field(this%xValueForTime, timeIdx, coordIdx, field%x(i, j, k)) + call save_field(this%yValueForTime, timeIdx, coordIdx, field%y(i, j, k)) + call save_field(this%zValueForTime, timeIdx, coordIdx, field%z(i, j, k)) + end if end do end do end do @@ -205,70 +225,48 @@ subroutine save_field_module(this, field, simTime, problemInfo) subroutine save_field_component(fieldData, fieldComponent, simTime, problemInfo, fieldDir) real(kind=RKIND), intent(inout) :: fieldData(:, :) - type(field_data_t), intent(in) :: fieldComponent(:,:,:) + type(field_data_t), intent(in) :: fieldComponent(:, :, :) real(kind=RKIND_tiempo), intent(in) :: simTime type(problem_info_t), intent(in) :: problemInfo integer, intent(in) :: fieldDir integer :: i, j, k, coordIdx - this%timeStep(this%serializedTimeSize) = simTime + this%timeStep(this%nTime) = simTime coordIdx = 0 - do i = this%lowerBound%x, this%upperBound%x - do j = this%lowerBound%y, this%upperBound%y - do k = this%lowerBound%z, this%upperBound%z - coordIdx = coordIdx + 1 - call save_field(fieldData, timeIdx, coordIdx, fieldDir, i, j, k, fieldComponent(i,j,k), problemInfo) + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (isValidPointForField(fieldDir, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + coordIdx = coordIdx + 1 + call save_field(fieldData, timeIdx, coordIdx, fieldComponent(i, j, k)) + end if end do end do end do end subroutine - subroutine save_field(fieldData, timeIdx, coordIdx, field, i, j, k, fieldValue, problemInfo) + subroutine save_field(fieldData, timeIdx, coordIdx, fieldValue) real(kind=RKIND), intent(inout) :: fieldData(:, :) - integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx, field, i, j, k + integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx real(kind=RKIND), intent(in) :: fieldValue - type(problem_info_t), intent(in) :: problemInfo - - real(kind=RKIND) :: savedValue - savedValue = 0.0 - if (saveFieldFrom(field, i,j,k, problemInfo)) then - savedValue = fieldValue - end if - fieldData(timeIdx, coordIdx) = savedValue + fieldData(timeIdx, coordIdx) = fieldValue end subroutine - - logical function saveCurrentFrom(field, i,j,k, problemInfo) - integer, intent(in) :: i,j,k, field - type(problem_info_t) :: problemInfo - saveCurrentFrom = isWithinBounds(field, i,j,k,problemInfo%simulationBounds) - if(saveCurrentFrom) then - saveCurrentFrom = isThinWire(field, i,j,k,problemInfo%geometryToMaterialData, problemInfo%materialList) & - .or. isPEC(field, i,j,k,problemInfo%geometryToMaterialData, problemInfo%materialList) - end if - end function - - logical function saveFieldFrom(field, i,j,k, problemInfo) - integer, intent(in) :: i,j,k, field - type(problem_info_t) :: problemInfo - saveCurrentFrom = isWithinBounds(field, i,j,k,problemInfo%simulationBounds) - end function - - subroutine flush_movie_probe_output(this) type(movie_probe_output_t), intent(inout) :: this integer :: status, i - do i = 1, this%serializedTimeSize + do i = 1, this%nTime call update_pvd(this, i, this%PDVUnit) end do call clear_memory_data() contains subroutine clear_memory_data() - this%serializedTimeSize = 0 + this%nTime = 0 this%timeStep = 0.0_RKIND this%xValueForTime = 0.0_RKIND this%yValueForTime = 0.0_RKIND @@ -277,77 +275,6 @@ end subroutine clear_memory_data end subroutine flush_movie_probe_output - subroutine get_measurements_coords(this, problemInfo) - procedure(logical_func), pointer :: checker => null() ! Pointer to logical function - type(movie_probe_output_t), intent(inout) :: this - type(problem_info_t), intent(in) :: problemInfo - - integer(kind=4), dimension(3) :: fieldTriplet - integer(kind=SINGLE) :: i, j, k, field - integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend - integer(kind=SINGLE) :: count - integer(kind=SINGLE) :: xField, zField - - ! Limites de la región de interés - istart = this%lowerBound%x - jstart = this%lowerBound%y - kstart = this%lowerBound%z - - iend = this%upperBound%x - jend = this%upperBound%y - kend = this%upperBound%z - - ! Primer barrido para contar cuántos puntos válidos - count = 0 - select case (this%fieldComponent) - case (iCur) - checker => requiredMeasureForCurrent - xField = iEx - zField = iEz - case (iMEC) - checker => requiredMeasureForField - xField = iEx - zField = iEz - case (iMHC) - checker => requiredMeasureForField - xField = iHx - zField = iHz - end select - - do i = istart, iend - do j = jstart, jend - do k = kstart, kend - do field = xField, zField - if (isWithinBounds(field, i, j, k, problemInfo)) then - if (checker(field, i, j, k, problemInfo)) then - count = count + 1 - end if - end if - end do - end do - end do - end do - - this%nMeasuredElements = count - allocate (this%coords(3, this%nMeasuredElements)) - - count = 0 - do i = istart, iend - do j = jstart, jend - do k = kstart, kend - do field = xField, zField - if (isWithinBounds(field, i, j, k, problemInfo)) then - if (checker(field, i, j, k, problemInfo)) then - count = count + 1 - this%coords(:, count) = [i, j, k] - end if - end if - end do - end do - end do - end do - end subroutine get_measurements_coords - subroutine write_vtu_timestep(this, stepIndex, filename) use vtk_fortran implicit none @@ -411,4 +338,126 @@ subroutine update_pvd(this, stepIndex, unitPVD) '" group="" part="0" file="'//trim(filename)//'"/>' end subroutine update_pvd -end module mod_movieProbeOutput + subroutine count_required_coords(this, problemInfo) + type(movie_probe_output_t), intent(inout) :: this + type(problem_info_t), intent(in) :: problemInfo + + procedure(logical_func), pointer :: checker => null() ! Pointer to logical function + integer :: component, count + select case (this%component) + case (iCur) + checker => volumicCurrentRequest + component = iCur + case (iMEC) + checker => volumicElectricRequest + component = iMEC + case (iMHC) + checker => volumicMagneticRequest + component = iMHC + case (iCurx) + checker => componentCurrentRequest + component = iEx + case (iExC) + checker => componentFieldRequest + component = iEx + case (iHxC) + checker => componentFieldRequest + component = iHx + case (iCurY) + checker => componentCurrentRequest + component = iEy + case (iEyC) + checker => componentFieldRequest + component = iEy + case (iHyC) + checker => componentFieldRequest + component = iHy + case (iCurZ) + checker => componentCurrentRequest + component = iEz + case (iEzC) + checker => componentFieldRequest + component = iEz + case (iHzC) + checker => componentFieldRequest + component = iHz + end select + + count = 0 + do i = istart, iend + do j = jstart, jend + do k = kstart, kend + if (checker(component, i, j, k, problemInfo)) count = count + 1 + end do + end do + end do + end do + this%nPoints = count + + end subroutine + + logical function isValidPointForCurrent(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + select case (request) + case (iCur) + isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz) + isValidPointForCurrent = componentCurrentRequest(request, i, j, k, problemInfo) + case default + isValidPointForCurrent = .false. + end select + end function + + logical function isValidPointForField(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + select case (request) + case (iMEC) + isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) + case (iMHC) + isValidPointForField = volumicMagneticRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz, iHx, iHy, iHz) + isValidPointForField = componentFieldRequest(request, i, j, k, problemInfo) + case default + isValidPointForField = .false. + end select + end function + + logical function volumicCurrentRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) & + .or. componentCurrentRequest(iEy, i, j, k, problemInfo) & + .or. componentCurrentRequest(iEz, i, j, k, problemInfo) + end function + logical function volumicElectricRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + volumicCurrentRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & + .or. componentFieldRequest(iEy, i, j, k, problemInfo) & + .or. componentFieldRequest(iEz, i, j, k, problemInfo) + end function + logical function volumicMagneticRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + volumicCurrentRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & + .or. componentFieldRequest(iHy, i, j, k, problemInfo) & + .or. componentFieldRequest(iHz, i, j, k, problemInfo) + end function + logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, fieldDir + type(problem_info_t) :: problemInfo + componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo%problemDimension) + if (componentCurrentRequest) then + componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo%geometryToMaterialData, problemInfo%materialList) & + .or. isThinWire(fieldDir, i, j, k, problemInfo%geometryToMaterialData, problemInfo%materialList) + end if + end function + logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, fieldDir + type(problem_info_t) :: problemInfo + componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo%problemDimension) + end function + + end module mod_movieProbeOutput From 0f567ed6c55249f0a610d1099229279a160a83ab Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 7 Jan 2026 13:58:18 +0100 Subject: [PATCH 46/67] Added frequency slice vtk flush --- src_main_pub/fdetypes.F90 | 4 + src_output/frequencySliceProbeOutput.F90 | 538 ++++++++++++++++------- src_output/movieProbeOutput.F90 | 84 +++- src_output/output.F90 | 4 +- 4 files changed, 444 insertions(+), 186 deletions(-) diff --git a/src_main_pub/fdetypes.F90 b/src_main_pub/fdetypes.F90 index 1e62d43b..94ef58c7 100755 --- a/src_main_pub/fdetypes.F90 +++ b/src_main_pub/fdetypes.F90 @@ -185,6 +185,10 @@ module FDETYPES integer (kind=4), parameter :: VOLUMIC_X_MEASURE(3) = [iCurx, iExC, iHxC] integer (kind=4), parameter :: VOLUMIC_Y_MEASURE(3) = [iCury, iEyC, iHyC] integer (kind=4), parameter :: VOLUMIC_Z_MEASURE(3) = [iCurz, iEzC, iHzC] + + integer (kind=4), parameter :: CURRENT_MEASURE(4) = [iCur, iCurx, iCury, iCurz] + integer (kind=4), parameter :: ELECTRIC_FIELD_MEASURE(4) = [iMEC, iExC, iEyC, iEzC] + integer (kind=4), parameter :: MAGNETIC_FIELD_MEASURE(4) = [iMHC, iHxC, iHyC, iHzC] ! CHARACTER (LEN=*), PARAMETER :: SEPARADOR='______________' integer (kind=4), PARAMETER :: comi=1,fine=2, icoord=1,jcoord=2,kcoord=3 diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index 4f9beeec..b9c511d0 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -25,43 +25,50 @@ module mod_frequencySliceProbeOutput contains - subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir, timeInterval) + subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeInterval, field, domain, outputTypeExtension, control, problemInfo) type(frequency_slice_probe_output_t), intent(out) :: this type(cell_coordinate_t), intent(in) :: lowerBound, upperBound - integer(kind=SINGLE), intent(in) :: mpidir, field + real(kind=RKIND_tiempo), intent(in) :: timeInterval + integer(kind=SINGLE), intent(in) :: field + type(domain_t), intent(in) :: domain character(len=BUFSIZE), intent(in) :: outputTypeExtension + type(sim_control_t), intent(in) :: control + type(problem_info_t), intent(in) :: problemInfo - type(MediaData_t), dimension(:), intent(in) :: registeredMedia - type(media_matrices_t), intent(in) :: geometryMedia - type(limit_t), dimension(:), intent(in) :: sinpml_fullsize - - type(domain_t), intent(in) :: domain - real(kind=RKIND_tiempo), intent(in) :: timeInterval integer :: i - if (domain%domainType /= FREQUENCY_DOMAIN) call StopOnError(0, 0, "Unexpected domain type for frequency_slice probe") - - this%lowerBound = lowerBound - this%upperBound = upperBound - this%fieldComponent = field !This can refer to field or currentDensity + this%mainCoords = lowerBound + this%auxCoords = upperBound + this%component = field !This can refer to electric, magnetic or currentDensity this%domain = domain this%path = get_output_path() - call get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) this%nFreq = domain%fnum - allocate (this%frequencySlice(this%nFreq)) - allocate (this%xValueForFreq(this%nFreq, this%nMeasuredElements)) - allocate (this%yValueForFreq(this%nFreq, this%nMeasuredElements)) - allocate (this%zValueForFreq(this%nFreq, this%nMeasuredElements)) do i = 1, this%nFreq call init_frequency_slice(this%frequencySlice, this%domain) end do - this%xValueForFreq = (0.0_RKIND, 0.0_RKIND) - this%yValueForFreq = (0.0_RKIND, 0.0_RKIND) - this%zValueForFreq = (0.0_RKIND, 0.0_RKIND) - allocate (this%auxExp_E(this%nFreq)) - allocate (this%auxExp_H(this%nFreq)) + call count_required_coords(this, problemInfo) + + if (any(VOLUMIC_M_MEASURE == this%component)) then + call alloc_and_init(this%xValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + call alloc_and_init(this%yValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + call alloc_and_init(this%zValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + else + if (any(VOLUMIC_X_MEASURE == this%component)) then + call alloc_and_init(this%xValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + elseif (any(VOLUMIC_Y_MEASURE == this%component)) then + call alloc_and_init(this%yValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + elseif (any(VOLUMIC_Z_MEASURE == this%component)) then + call alloc_and_init(this%zValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + else + call StopOnError(control%layoutnumber, control%size, "Unexpected output type for movie probe") + end if + end if + + call alloc_and_init(this%auxExp_E, this%nFreq, (0.0_RKIND, 0.0_RKIND)) + call alloc_and_init(this%auxExp_H, this%nFreq, (0.0_RKIND, 0.0_RKIND)) + do i = 1, this%nFreq this%auxExp_E(i) = timeInterval*(1.0E0_RKIND, 0.0E0_RKIND)*Exp(mcpi2*this%frequencySlice(i)) !el dt deberia ser algun tipo de promedio this%auxExp_H(i) = this%auxExp_E(i)*Exp(mcpi2*this%frequencySlice(i)*timeInterval*0.5_RKIND) @@ -71,8 +78,8 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, field function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, mpidir) - prefixFieldExtension = get_prefix_extension(field, mpidir) + 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 @@ -80,156 +87,181 @@ end function get_output_path end subroutine init_frequency_slice_probe_output - subroutine update_frequency_slice_probe_output(this, step, geometryMedia, registeredMedia, sinpml_fullsize, fieldsReference) + subroutine update_frequency_slice_probe_output(this, step, fieldsReference, problemInfo) type(frequency_slice_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step - - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:), intent(in) :: registeredMedia - type(limit_t), dimension(:), intent(in) :: sinpml_fullsize + type(problem_info_t), intent(in) :: problemInfo type(fields_reference_t), intent(in) :: fieldsReference - select case (this%fieldComponent) - case (iCur) - call save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) - end select + integer(kind=4) :: request + request = this%component + + if (any(VOLUMIC_M_MEASURE == request)) then + select case (request) + case (iCur); call save_current_module(this, fieldsReference, step, problemInfo) + case (iMEC); call save_field_module(this, fieldsReference%E, request, step, problemInfo) + case (iMHC); call save_field_module(this, fieldsReference%H, request, step, problemInfo) + case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") + end select + + else if (any(VOLUMIC_X_MEASURE == request)) then + select case (request) + case (iCurX); call save_current_component(this%xValueForFreq, fieldsReference, problemInfo, iEx, this%auxExp_E, this%nFreq, step) + case (iExC); call save_field_component(this%xValueForFreq, fieldsReference%E%x, step, problemInfo, iEx) + case (iHxC); call save_field_component(this%xValueForFreq, fieldsReference%H%x, step, problemInfo, iHx) + case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") + end select + + else if (any(VOLUMIC_Y_MEASURE == request)) then + select case (request) + case (iCurY); call save_current_component(this%yValueForFreq, fieldsReference, problemInfo, iEy, this%auxExp_E, this%nFreq, step) + case (iEyC); call save_field_component(this%yValueForFreq, fieldsReference%E%y, step, problemInfo, iEy) + case (iHyC); call save_field_component(this%yValueForFreq, fieldsReference%H%y, step, problemInfo, iHy) + case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") + end select + + else if (any(VOLUMIC_Z_MEASURE == request)) then + select case (request) + case (iCurZ); call save_current_component(this%zValueForFreq, fieldsReference, problemInfo, iEz, this%auxExp_E, this%nFreq, step) + case (iEzC); call save_field_component(this%zValueForFreq, fieldsReference%E%z, step, problemInfo, iEz) + case (iHzC); call save_field_component(this%zValueForFreq, fieldsReference%H%z, step, problemInfo, iHz) + case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") + end select + end if end subroutine update_frequency_slice_probe_output - subroutine flush_frequency_slice_probe_output(this) - type(frequency_slice_probe_output_t), intent(inout) :: this - integer :: status, i + subroutine save_current_module(this, fieldsReference, problemInfo, step) + type(movie_probe_output_t), intent(inout) :: this + type(fields_reference_t), intent(in) :: fieldsReference + type(problem_info_t), intent(in) :: problemInfo + real(kind=RKIND_tiempo), intent(in) :: step - do i = 1, this%nFreq - call update_pvd(this, i, this%PDVUnit) + integer :: i, j, k, coordIdx + + coordIdx = 0 + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (isValidForCurrent(iCur, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + call save_current(this%xValueForTime, iEx, coordIdx, i, j, k, fieldsReference, auxExp, this%nFreq, step) + call save_current(this%yValueForTime, iEy, coordIdx, i, j, k, fieldsReference, auxExp, this%nFreq, step) + call save_current(this%zValueForTime, iEz, coordIdx, i, j, k, fieldsReference, auxExp, this%nFreq, step) + end if end do + end do + end do + end subroutine - end subroutine flush_frequency_slice_probe_output - - subroutine get_measurements_coords(this, geometryMedia, registeredMedia, sinpml_fullsize) - type(frequency_slice_probe_output_t), intent(inout) :: this - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:) :: registeredMedia - type(limit_t), dimension(:), intent(in) :: sinpml_fullsize - - integer(kind=SINGLE) :: i, j, k, field - integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend - integer(kind=SINGLE) :: count - ! Limites de la región de interés - istart = this%lowerBound%x - jstart = this%lowerBound%y - kstart = this%lowerBound%z - - iend = this%upperBound%x - jend = this%upperBound%y - kend = this%upperBound%z - - ! Primer barrido para contar cuántos puntos válidos - count = 0 - select case (this%fieldComponent) - case (iCur) - do i = istart, iend - do j = jstart, jend - do k = kstart, kend - do field = iEx, iEz - if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then - if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then - count = count + 1 - end if - end if - end do - end do - end do - end do - end select - - this%nMeasuredElements = count + subroutine save_current_component(currentData, fieldsReference, problemInfo, fieldDir, auxExp, nFreq, step) + complex(kind=CKIND), intent(inout) :: currentData(:, :) + type(fields_reference_t), intent(in) :: fieldsReference + type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: fieldDir, nFreq + complex(kind=ckind), intent(in) :: auxExp + real(kind=RKIND_tiempo), intent(in) :: step - allocate (this%coords(3, this%nMeasuredElements)) + integer :: i, j, k, coordIdx - count = 0 - select case (this%fieldComponent) - case (iCur) - do i = istart, iend - do j = jstart, jend - do k = kstart, kend - do field = iEx, iEz - if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then - if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then - count = count + 1 - this%coords(:, count) = [i, j, k] - end if - end if - end do - end do - end do - end do - end select + this%timeStep(this%nTime) = simTime - end subroutine get_measurements_coords + coordIdx = 0 + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (isValidForCurrent(fieldDir, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + call save_current(currentData, fieldDir, coordIdx, i, j, k, fieldsReference, auxExp, nFreq, step) + end if + end do + end do + end do + end subroutine - subroutine save_current_data(this, step, fieldsReference, geometryMedia, registeredMedia, sinpml_fullsize) - type(frequency_slice_probe_output_t), intent(inout) :: this - real(kind=RKIND_tiempo), intent(in) :: step + subroutine save_current(valorComplex, direction, coordIdx, i, j, k, fieldsReference, auxExp, nFreq, step) + integer, intent(in) :: direction + complex(kind=CKIND), intent(inout) :: valorComplex + complex(kind=CKIND), intent(in) :: auxExp + integer, intent(in) :: i, j, k, coordIdx, nFreq type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND_tiempo), intent(in) :: step - type(media_matrices_t), intent(in) :: geometryMedia - type(MediaData_t), dimension(:) :: registeredMedia - type(limit_t), dimension(:), intent(in) :: sinpml_fullsize - - integer(kind=SINGLE) :: i, j, k, field - integer(kind=SINGLE) :: istart, jstart, kstart, iend, jend, kend - integer(kind=SINGLE) :: n - - istart = this%lowerBound%x - jstart = this%lowerBound%y - kstart = this%lowerBound%z + integer :: iter + complex(kind=CKIND) :: z_cplx = (0.0_RKIND, 0.0_RKIND) - iend = this%upperBound%x - jend = this%upperBound%y - kend = this%upperBound%z + jdir = computej(direction, i, j, k, fieldReference) - n = 0 - do i = istart, iend - do j = jstart, jend - do k = kstart, kend - do field = iEx, iEz - if (isWithinBounds(field, i, j, k, SINPML_fullsize)) then - if (isPEC(field, i, j, k, geometryMedia, registeredMedia)) then - n = n + 1 - call save_current_component() - end if - end if - end do + do iter = 1, nFreq + valorComplex(i, coordIdx) = valorComplex(i, coordIdx) + (auxExp(i)**step)*jdir + end do + end subroutine + + subroutine save_field_module(this, field, simTime, problemInfo, request) + type(movie_probe_output_t), intent(inout) :: this + type(field_data_t), pointer :: field + real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: request + + integer :: i, j, k, coordIdx + + this%timeStep(this%nTime) = simTime + + coordIdx = 0 + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (isValidPointForField(request, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + call save_field(this%xValueForTime, timeIdx, coordIdx, field%x(i, j, k)) + call save_field(this%yValueForTime, timeIdx, coordIdx, field%y(i, j, k)) + call save_field(this%zValueForTime, timeIdx, coordIdx, field%z(i, j, k)) + end if end do end do end do - if (n < this%nMeasuredElements) call StopOnError(0, 0, "Missing measurment to update at frequency_slice probe") - contains + end subroutine - subroutine save_current_component() - real(kind=RKIND) :: jdir - integer :: freqIdx - jdir = computeJ(field, i, j, k, fieldsReference) + subroutine save_field_component(fieldData, fieldComponent, simTime, problemInfo, fieldDir) + real(kind=RKIND), intent(inout) :: fieldData(:, :) + type(field_data_t), intent(in) :: fieldComponent(:, :, :) + real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: fieldDir - do freqIdx = 1, this%nFreq - call updateComplexComponent(iEx, field, this%xValueForFreq(freqIdx, n), jdir, this%auxExp_E(freqIdx)**step) - call updateComplexComponent(iEy, field, this%yValueForFreq(freqIdx, n), jdir, this%auxExp_E(freqIdx)**step) - call updateComplexComponent(iEz, field, this%zValueForFreq(freqIdx, n), jdir, this%auxExp_E(freqIdx)**step) - end do - end subroutine save_current_component + integer :: i, j, k, coordIdx + + this%timeStep(this%nTime) = simTime + + coordIdx = 0 + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (isValidPointForField(fieldDir, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + call save_field(fieldData, timeIdx, coordIdx, fieldComponent(i, j, k)) + end if + end do + end do + end do + end subroutine - subroutine updateComplexComponent(direction, fieldIndex, valorComplex, jdir, auxExp) - integer, intent(in) :: direction, fieldIndex - complex(kind=CKIND), intent(inout) :: valorComplex - complex(kind=CKIND), intent(in) :: auxExp - real(kind=RKIND), intent(in) :: jdir + subroutine save_field(fieldData, timeIdx, coordIdx, fieldValue) + real(kind=RKIND), intent(inout) :: fieldData(:, :) + integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx + real(kind=RKIND), intent(in) :: fieldValue + fieldData(timeIdx, coordIdx) = fieldValue + end subroutine - complex(kind=CKIND) :: z_cplx = (0.0_RKIND, 0.0_RKIND) + subroutine flush_frequency_slice_probe_output(this) + type(frequency_slice_probe_output_t), intent(inout) :: this + integer :: status, i - valorComplex = merge(valorComplex + auxExp*jdir, z_cplx, fieldIndex == direction) - end subroutine updateComplexComponent - end subroutine save_current_data + do i = 1, this%nFreq + call update_pvd(this, i, this%PDVUnit) + end do + end subroutine flush_frequency_slice_probe_output subroutine write_vtu_frequency_slice(this, freq, filename) use vtk_fortran @@ -239,13 +271,32 @@ subroutine write_vtu_frequency_slice(this, freq, filename) integer, intent(in) :: freq character(len=*), intent(in) :: filename + character(len=BUFSIZE) :: requestName type(vtk_file) :: vtkOutput integer :: ierr, npts, i real(kind=RKIND), allocatable :: x(:), y(:), z(:) - real(kind=RKIND), allocatable :: Jx(:), Jy(:), Jz(:) + complex(kind=CKIND), allocatable :: Componentx(:), Componenty(:), Componentz(:) + logical :: writeX, writeY, writeZ + + !================= Determine the measure type ================= + select case (this%component) + case (CURRENT_MEASURE) + requestName = 'Current' + case (ELECTRIC_FIELD_MEASURE) + requestName = 'Electric' + case (MAGNETIC_FIELD_MEASURE) + requestName = 'Magnetic' + case default + requestName = 'Unknown' + end select - npts = this%nMeasuredElements + !================= Determine which components to write ================= + writeX = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_X_MEASURE == this%component) + writeY = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_Y_MEASURE == this%component) + writeZ = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_Z_MEASURE == this%component) + !================= Allocate and fill coordinates ================= + npts = this%nPoints allocate (x(npts), y(npts), z(npts)) do i = 1, npts x(i) = this%coords(1, i) @@ -253,24 +304,55 @@ subroutine write_vtu_frequency_slice(this, freq, filename) z(i) = this%coords(3, i) end do - allocate (Jx(npts), Jy(npts), Jz(npts)) - do i = 1, npts - Jx(i) = this%xValueForFreq(freq, i) - Jy(i) = this%yValueForFreq(freq, i) - Jz(i) = this%zValueForFreq(freq, i) - end do ierr = vtkOutput%initialize(format='ASCII', filename=trim(filename), mesh_topology='UnstructuredGrid') ierr = vtkOutput%xml_writer%write_geo(n=npts, x=x, y=y, z=z) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentX', x=Jx) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentY', x=Jy) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentZ', x=Jz) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + + !================= Allocate and fill component arrays ================= + if (writeX) then + allocate (Componentx(npts)) + do i = 1, npts + Componentx(i) = this%xValueForFreq(freq, i) + end do + end if + + if (writeY) then + allocate (Componenty(npts)) + do i = 1, npts + Componenty(i) = this%yValueForFreq(freq, i) + end do + end if + + if (writeZ) then + allocate (Componentz(npts)) + do i = 1, npts + Componentz(i) = this%zValueForFreq(freq, i) + end do + end if + + !================= Write arrays to VTK ================= + if (writeX) then + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'X', x=Componentx) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + deallocate (Componentx) + end if + + if (writeY) then + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'Y', x=Componenty) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + deallocate (Componenty) + end if + + if (writeZ) then + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'Z', x=Componentz) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + deallocate (Componentz) + end if + ierr = vtkOutput%xml_writer%finalize() + deallocate (x, y, z) end subroutine write_vtu_frequency_slice @@ -294,4 +376,126 @@ subroutine update_pvd(this, freq, unitPVD) '" group="" part="0" file="'//trim(filename)//'"/>' end subroutine update_pvd -end module mod_frequencySliceProbeOutput + subroutine count_required_coords(this, problemInfo) + type(movie_probe_output_t), intent(inout) :: this + type(problem_info_t), intent(in) :: problemInfo + + procedure(logical_func), pointer :: checker => null() ! Pointer to logical function + integer :: component, count + select case (this%component) + case (iCur) + checker => volumicCurrentRequest + component = iCur + case (iMEC) + checker => volumicElectricRequest + component = iMEC + case (iMHC) + checker => volumicMagneticRequest + component = iMHC + case (iCurx) + checker => componentCurrentRequest + component = iEx + case (iExC) + checker => componentFieldRequest + component = iEx + case (iHxC) + checker => componentFieldRequest + component = iHx + case (iCurY) + checker => componentCurrentRequest + component = iEy + case (iEyC) + checker => componentFieldRequest + component = iEy + case (iHyC) + checker => componentFieldRequest + component = iHy + case (iCurZ) + checker => componentCurrentRequest + component = iEz + case (iEzC) + checker => componentFieldRequest + component = iEz + case (iHzC) + checker => componentFieldRequest + component = iHz + end select + + count = 0 + do i = istart, iend + do j = jstart, jend + do k = kstart, kend + if (checker(component, i, j, k, problemInfo)) count = count + 1 + end do + end do + end do + end do + this%nPoints = count + + end subroutine + + logical function isValidPointForCurrent(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + select case (request) + case (iCur) + isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz) + isValidPointForCurrent = componentCurrentRequest(request, i, j, k, problemInfo) + case default + isValidPointForCurrent = .false. + end select + end function + + logical function isValidPointForField(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + select case (request) + case (iMEC) + isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) + case (iMHC) + isValidPointForField = volumicMagneticRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz, iHx, iHy, iHz) + isValidPointForField = componentFieldRequest(request, i, j, k, problemInfo) + case default + isValidPointForField = .false. + end select + end function + + logical function volumicCurrentRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) & + .or. componentCurrentRequest(iEy, i, j, k, problemInfo) & + .or. componentCurrentRequest(iEz, i, j, k, problemInfo) + end function + logical function volumicElectricRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + volumicCurrentRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & + .or. componentFieldRequest(iEy, i, j, k, problemInfo) & + .or. componentFieldRequest(iEz, i, j, k, problemInfo) + end function + logical function volumicMagneticRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + volumicCurrentRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & + .or. componentFieldRequest(iHy, i, j, k, problemInfo) & + .or. componentFieldRequest(iHz, i, j, k, problemInfo) + end function + logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, fieldDir + type(problem_info_t) :: problemInfo + componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo%problemDimension) + if (componentCurrentRequest) then + componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo%geometryToMaterialData, problemInfo%materialList) & + .or. isThinWire(fieldDir, i, j, k, problemInfo%geometryToMaterialData, problemInfo%materialList) + end if + end function + logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, fieldDir + type(problem_info_t) :: problemInfo + componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo%problemDimension) + end function + + end module mod_frequencySliceProbeOutput diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index efa83389..32e8422e 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -283,13 +283,32 @@ subroutine write_vtu_timestep(this, stepIndex, filename) integer, intent(in) :: stepIndex character(len=*), intent(in) :: filename + character(len=BUFSIZE) :: requestName type(vtk_file) :: vtkOutput integer :: ierr, npts, i real(kind=RKIND), allocatable :: x(:), y(:), z(:) - real(kind=RKIND), allocatable :: Jx(:), Jy(:), Jz(:) + real(kind=RKIND), allocatable :: Componentx(:), Componenty(:), Componentz(:) + logical :: writeX, writeY, writeZ - npts = this%nMeasuredElements + !================= Determine the measure type ================= + select case (this%component) + case (CURRENT_MEASURE) + requestName = 'Current' + case (ELECTRIC_FIELD_MEASURE) + requestName = 'Electric' + case (MAGNETIC_FIELD_MEASURE) + requestName = 'Magnetic' + case default + requestName = 'Unknown' + end select + + !================= Determine which components to write ================= + writeX = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_X_MEASURE == this%component) + writeY = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_Y_MEASURE == this%component) + writeZ = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_Z_MEASURE == this%component) + !================= Allocate and fill coordinates ================= + npts = this%nPoints allocate (x(npts), y(npts), z(npts)) do i = 1, npts x(i) = this%coords(1, i) @@ -297,24 +316,55 @@ subroutine write_vtu_timestep(this, stepIndex, filename) z(i) = this%coords(3, i) end do - allocate (Jx(npts), Jy(npts), Jz(npts)) - do i = 1, npts - Jx(i) = this%xValueForTime(stepIndex, i) - Jy(i) = this%yValueForTime(stepIndex, i) - Jz(i) = this%zValueForTime(stepIndex, i) - end do ierr = vtkOutput%initialize(format='ASCII', filename=trim(filename), mesh_topology='UnstructuredGrid') ierr = vtkOutput%xml_writer%write_geo(n=npts, x=x, y=y, z=z) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentX', x=Jx) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentY', x=Jy) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='CurrentZ', x=Jz) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + + !================= Allocate and fill component arrays ================= + if (writeX) then + allocate (Componentx(npts)) + do i = 1, npts + Componentx(i) = this%xValueForTime(stepIndex, i) + end do + end if + + if (writeY) then + allocate (Componenty(npts)) + do i = 1, npts + Componenty(i) = this%xValueForTime(stepIndex, i) + end do + end if + + if (writeZ) then + allocate (Componentz(npts)) + do i = 1, npts + Componentz(i) = this%xValueForTime(frestepIndexq, i) + end do + end if + + !================= Write arrays to VTK ================= + if (writeX) then + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'X', x=Componentx) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + deallocate (Componentx) + end if + + if (writeY) then + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'Y', x=Componenty) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + deallocate (Componenty) + end if + + if (writeZ) then + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'Z', x=Componentz) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') + deallocate (Componentz) + end if + ierr = vtkOutput%xml_writer%finalize() + deallocate (x, y, z) end subroutine write_vtu_timestep diff --git a/src_output/output.F90 b/src_output/output.F90 index 91a8279f..d6eb55fc 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -334,14 +334,14 @@ subroutine update_outputs(control, discreteTimeArray, timeIndx, fieldsReference) fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent, fieldsReference) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos call update_solver_output(outputs(i)%pointProbe, discreteTime, fieldComponent) case (WIRE_CURRENT_PROBE_ID) - call update_solver_output(outputs(i)%wireCurrentProbe, discreteTime, contorl, InvEps, InvMu) + call update_solver_output(outputs(i)%wireCurrentProbe, discreteTime, contorl, InvEps, InvMu) case (WIRE_CHARGE_PROBE_ID) call update_solver_output(outputs(i)%wireChargeProbe, discreteTime) case (BULK_PROBE_ID) fieldReference = get_field_reference(outputs(i)%bulkCurrentProbe%fieldComponent, fieldsReference) call update_solver_output(outputs(i)%bulkCurrentProbe, discreteTime, fieldReference) case (MOVIE_PROBE_ID) - call update_solver_output(outputs(i)%movieProbe, discreteTime, problemInfo, fieldsReference) + call update_solver_output(outputs(i)%movieProbe, discreteTime, problemInfo, fieldsReference) case (FREQUENCY_SLICE_PROBE_ID) call update_solver_output(outputs(i)%frequencySliceProbe, discreteTime, problemInfo, fieldsReference) case (FAR_FIELD_PROBE_ID) From de9ffe1b3b19544a0766ebea5fc92a2aacf46aac Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 7 Jan 2026 16:21:55 +0100 Subject: [PATCH 47/67] Fix Compilation errors --- src_output/CMakeLists.txt | 1 - src_output/bulkProbeOutput.F90 | 82 +++--- src_output/farFieldProbeOutput.F90 | 4 +- src_output/frequencySliceProbeOutput.F90 | 103 ++++---- src_output/movieProbeOutput.F90 | 91 +++---- src_output/outputTypes.F90 | 8 +- src_output/outputUtils.F90 | 55 ++-- src_output/pointProbeOutput.F90 | 24 +- src_output/volumicProbeOutput.F90 | 305 ----------------------- src_output/wireProbeOutput.F90 | 74 +++--- test/output/test_output.F90 | 34 ++- 11 files changed, 249 insertions(+), 532 deletions(-) delete mode 100644 src_output/volumicProbeOutput.F90 diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index c59288ca..4b65e041 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -6,7 +6,6 @@ add_library(fdtd-output "pointProbeOutput.F90" "wireProbeOutput.F90" "bulkProbeOutput.F90" - "volumicProbeOutput.F90" "movieProbeOutput.F90" "frequencySliceProbeOutput.F90" "farFieldProbeOutput.F90" diff --git a/src_output/bulkProbeOutput.F90 b/src_output/bulkProbeOutput.F90 index d0269edd..1b65553d 100644 --- a/src_output/bulkProbeOutput.F90 +++ b/src_output/bulkProbeOutput.F90 @@ -16,9 +16,9 @@ subroutine init_bulk_probe_output(this, lowerBound, upperBound, field, domain, o integer(kind=SINGLE) :: i - this%lowerBound = lowerBound - this%upperBound = upperBound - this%fieldComponent = field + this%mainCoords = lowerBound + this%auxCoords = upperBound + this%component = field this%domain = domain this%path = get_output_path() @@ -28,7 +28,7 @@ subroutine init_bulk_probe_output(this, lowerBound, upperBound, field, domain, o function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, mpidir) + 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)) @@ -61,12 +61,12 @@ subroutine update_bulk_probe_output(this, step, field) real(kind=RKIND), pointer, dimension(:, :, :) :: xF, yF, zF real(kind=RKIND), pointer, dimension(:) :: dx, dy, dz - i1_m = this%lowerBound%x - j1_m = this%lowerBound%y - k1_m = this%lowerBound%z - i2_m = this%upperBound%x - j2_m = this%upperBound%y - k2_m = this%upperBound%z + 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 = i2_m @@ -82,79 +82,79 @@ subroutine update_bulk_probe_output(this, step, field) dy => field%deltaY dz => field%deltaZ - this%serializedTimeSize = this%serializedTimeSize + 1 - this%timeStep(this%serializedTimeSize) = step - this%valueForTime(this%serializedTimeSize) = 0.0_RKIND !Clear uninitialized value - selectcase (this%fieldComponent) + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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%serializedTimeSize) = & - this%valueForTime(this%serializedTimeSize) + & + 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 @@ -166,7 +166,7 @@ subroutine flush_bulk_probe_output(this) type(bulk_current_probe_output_t), intent(inout) :: this character(len=BUFSIZE) :: filename integer :: i - if (this%serializedTimeSize <= 0) then + if (this%nTime <= 0) then print *, "No data to write." return end if @@ -174,7 +174,7 @@ subroutine flush_bulk_probe_output(this) filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") - do i = 1, this%serializedTimeSize + do i = 1, this%nTime write (this%fileUnitTime, fmt) this%timeStep(i), this%valueForTime(i) end do @@ -185,7 +185,7 @@ subroutine clear_time_data() this%timeStep = 0.0_RKIND_tiempo this%valueForTime = 0.0_RKIND - this%serializedTimeSize = 0 + this%nTime = 0 end subroutine clear_time_data end subroutine flush_bulk_probe_output diff --git a/src_output/farFieldProbeOutput.F90 b/src_output/farFieldProbeOutput.F90 index 7eed9bf2..f9b76dc2 100644 --- a/src_output/farFieldProbeOutput.F90 +++ b/src_output/farFieldProbeOutput.F90 @@ -33,7 +33,7 @@ subroutine init_farField_probe_output(this, sgg, lowerBound, upperBound, field, this%domain = domain this%sphericRange = sphericRange - this%fieldComponent = field + this%component = field this%path = get_output_path() this%fileUnitFreq = 2025 !Dummy unit for now @@ -58,7 +58,7 @@ subroutine init_farField_probe_output(this, sgg, lowerBound, upperBound, field, function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, control%mpidir) + 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)) diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index b9c511d0..8c57f4d8 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -51,23 +51,23 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI call count_required_coords(this, problemInfo) if (any(VOLUMIC_M_MEASURE == this%component)) then - call alloc_and_init(this%xValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) - call alloc_and_init(this%yValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) - call alloc_and_init(this%zValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + call alloc_and_init(this%xValueForFreq, this%nFreq, this%nPoints, (0.0_CKIND, 0.0_CKIND)) + call alloc_and_init(this%yValueForFreq, this%nFreq, this%nPoints, (0.0_CKIND, 0.0_CKIND)) + call alloc_and_init(this%zValueForFreq, this%nFreq, this%nPoints, (0.0_CKIND, 0.0_CKIND)) else if (any(VOLUMIC_X_MEASURE == this%component)) then - call alloc_and_init(this%xValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + call alloc_and_init(this%xValueForFreq, this%nFreq, this%nPoints, (0.0_CKIND, 0.0_CKIND)) elseif (any(VOLUMIC_Y_MEASURE == this%component)) then - call alloc_and_init(this%yValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + call alloc_and_init(this%yValueForFreq, this%nFreq, this%nPoints, (0.0_CKIND, 0.0_CKIND)) elseif (any(VOLUMIC_Z_MEASURE == this%component)) then - call alloc_and_init(this%zValueForFreq, this%nFreq, this%nPoints, (0.0_RKIND, 0.0_RKIND)) + call alloc_and_init(this%zValueForFreq, this%nFreq, this%nPoints, (0.0_CKIND, 0.0_CKIND)) else call StopOnError(control%layoutnumber, control%size, "Unexpected output type for movie probe") end if end if - call alloc_and_init(this%auxExp_E, this%nFreq, (0.0_RKIND, 0.0_RKIND)) - call alloc_and_init(this%auxExp_H, this%nFreq, (0.0_RKIND, 0.0_RKIND)) + call alloc_and_init(this%auxExp_E, this%nFreq, (0.0_CKIND, 0.0_CKIND)) + call alloc_and_init(this%auxExp_H, this%nFreq, (0.0_CKIND, 0.0_CKIND)) do i = 1, this%nFreq this%auxExp_E(i) = timeInterval*(1.0E0_RKIND, 0.0E0_RKIND)*Exp(mcpi2*this%frequencySlice(i)) !el dt deberia ser algun tipo de promedio @@ -87,9 +87,10 @@ end function get_output_path end subroutine init_frequency_slice_probe_output - subroutine update_frequency_slice_probe_output(this, step, fieldsReference, problemInfo) + subroutine update_frequency_slice_probe_output(this, step, fieldsReference, control, problemInfo) type(frequency_slice_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step + type(sim_control_t), intent(in) :: control type(problem_info_t), intent(in) :: problemInfo type(fields_reference_t), intent(in) :: fieldsReference @@ -99,8 +100,8 @@ subroutine update_frequency_slice_probe_output(this, step, fieldsReference, prob if (any(VOLUMIC_M_MEASURE == request)) then select case (request) case (iCur); call save_current_module(this, fieldsReference, step, problemInfo) - case (iMEC); call save_field_module(this, fieldsReference%E, request, step, problemInfo) - case (iMHC); call save_field_module(this, fieldsReference%H, request, step, problemInfo) + case (iMEC); call save_field_module(this, fieldsReference%E, step, request, problemInfo) + case (iMHC); call save_field_module(this, fieldsReference%H, step, request, problemInfo) case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select @@ -114,24 +115,24 @@ subroutine update_frequency_slice_probe_output(this, step, fieldsReference, prob else if (any(VOLUMIC_Y_MEASURE == request)) then select case (request) - case (iCurY); call save_current_component(this%yValueForFreq, fieldsReference, problemInfo, iEy, this%auxExp_E, this%nFreq, step) - case (iEyC); call save_field_component(this%yValueForFreq, fieldsReference%E%y, step, problemInfo, iEy) - case (iHyC); call save_field_component(this%yValueForFreq, fieldsReference%H%y, step, problemInfo, iHy) + case (iCurY); call save_current_component(this, this%yValueForFreq, fieldsReference, problemInfo, iEy, this%auxExp_E, this%nFreq, step) + case (iEyC); call save_field_component(this, this%yValueForFreq, fieldsReference%E%y, step, problemInfo, iEy) + case (iHyC); call save_field_component(this, this%yValueForFreq, fieldsReference%H%y, step, problemInfo, iHy) case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select else if (any(VOLUMIC_Z_MEASURE == request)) then select case (request) - case (iCurZ); call save_current_component(this%zValueForFreq, fieldsReference, problemInfo, iEz, this%auxExp_E, this%nFreq, step) - case (iEzC); call save_field_component(this%zValueForFreq, fieldsReference%E%z, step, problemInfo, iEz) - case (iHzC); call save_field_component(this%zValueForFreq, fieldsReference%H%z, step, problemInfo, iHz) + case (iCurZ); call save_current_component(this, this%zValueForFreq, fieldsReference, problemInfo, iEz, this%auxExp_E, this%nFreq, step) + case (iEzC); call save_field_component(this, this%zValueForFreq, fieldsReference%E%z, step, problemInfo, iEz) + case (iHzC); call save_field_component(this, this%zValueForFreq, fieldsReference%H%z, step, problemInfo, iHz) case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select end if end subroutine update_frequency_slice_probe_output - subroutine save_current_module(this, fieldsReference, problemInfo, step) - type(movie_probe_output_t), intent(inout) :: this + subroutine save_current_module(this, fieldsReference, step, problemInfo) + type(frequency_slice_probe_output_t), intent(inout) :: this type(fields_reference_t), intent(in) :: fieldsReference type(problem_info_t), intent(in) :: problemInfo real(kind=RKIND_tiempo), intent(in) :: step @@ -142,34 +143,33 @@ subroutine save_current_module(this, fieldsReference, problemInfo, step) do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y do k = this%mainCoords%z, this%auxCoords%z - if (isValidForCurrent(iCur, i, j, k, problemInfo)) then + if (isValidPointForCurrent(iCur, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_current(this%xValueForTime, iEx, coordIdx, i, j, k, fieldsReference, auxExp, this%nFreq, step) - call save_current(this%yValueForTime, iEy, coordIdx, i, j, k, fieldsReference, auxExp, this%nFreq, step) - call save_current(this%zValueForTime, iEz, coordIdx, i, j, k, fieldsReference, auxExp, this%nFreq, step) + call save_current(this%xValueForFreq, iEx, coordIdx, i, j, k, fieldsReference, this%auxExp_E, this%nFreq, step) + call save_current(this%yValueForFreq, iEy, coordIdx, i, j, k, fieldsReference, this%auxExp_E, this%nFreq, step) + call save_current(this%zValueForFreq, iEz, coordIdx, i, j, k, fieldsReference, this%auxExp_E, this%nFreq, step) end if end do end do end do end subroutine - subroutine save_current_component(currentData, fieldsReference, problemInfo, fieldDir, auxExp, nFreq, step) + subroutine save_current_component(this, currentData, fieldsReference, problemInfo, fieldDir, auxExp, nFreq, step) + type(frequency_slice_probe_output_t), intent(inout) :: this complex(kind=CKIND), intent(inout) :: currentData(:, :) type(fields_reference_t), intent(in) :: fieldsReference type(problem_info_t), intent(in) :: problemInfo integer, intent(in) :: fieldDir, nFreq - complex(kind=ckind), intent(in) :: auxExp + complex(kind=ckind), intent(in), dimension(:) :: auxExp real(kind=RKIND_tiempo), intent(in) :: step integer :: i, j, k, coordIdx - this%timeStep(this%nTime) = simTime - coordIdx = 0 do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y do k = this%mainCoords%z, this%auxCoords%z - if (isValidForCurrent(fieldDir, i, j, k, problemInfo)) then + if (isValidPointForCurrent(fieldDir, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 call save_current(currentData, fieldDir, coordIdx, i, j, k, fieldsReference, auxExp, nFreq, step) end if @@ -180,7 +180,7 @@ subroutine save_current_component(currentData, fieldsReference, problemInfo, fie subroutine save_current(valorComplex, direction, coordIdx, i, j, k, fieldsReference, auxExp, nFreq, step) integer, intent(in) :: direction - complex(kind=CKIND), intent(inout) :: valorComplex + complex(kind=CKIND), intent(inout) :: valorComplex(:,:) complex(kind=CKIND), intent(in) :: auxExp integer, intent(in) :: i, j, k, coordIdx, nFreq type(fields_reference_t), intent(in) :: fieldsReference @@ -188,16 +188,17 @@ subroutine save_current(valorComplex, direction, coordIdx, i, j, k, fieldsRefere integer :: iter complex(kind=CKIND) :: z_cplx = (0.0_RKIND, 0.0_RKIND) + real(kind=rkind) :: jdir - jdir = computej(direction, i, j, k, fieldReference) + jdir = computej(direction, i, j, k, fieldsReference) do iter = 1, nFreq valorComplex(i, coordIdx) = valorComplex(i, coordIdx) + (auxExp(i)**step)*jdir end do end subroutine - subroutine save_field_module(this, field, simTime, problemInfo, request) - type(movie_probe_output_t), intent(inout) :: this + subroutine save_field_module(this, field, simTime, request, problemInfo) + type(frequency_slice_probe_output_t), intent(inout) :: this type(field_data_t), pointer :: field real(kind=RKIND_tiempo), intent(in) :: simTime type(problem_info_t), intent(in) :: problemInfo @@ -213,9 +214,9 @@ subroutine save_field_module(this, field, simTime, problemInfo, request) do k = this%mainCoords%z, this%auxCoords%z if (isValidPointForField(request, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_field(this%xValueForTime, timeIdx, coordIdx, field%x(i, j, k)) - call save_field(this%yValueForTime, timeIdx, coordIdx, field%y(i, j, k)) - call save_field(this%zValueForTime, timeIdx, coordIdx, field%z(i, j, k)) + call save_field(this%xValueForFreq, this%nTime, coordIdx, field%x(i, j, k)) + call save_field(this%yValueForFreq, this%nTime, coordIdx, field%y(i, j, k)) + call save_field(this%zValueForFreq, this%nTime, coordIdx, field%z(i, j, k)) end if end do end do @@ -223,8 +224,9 @@ subroutine save_field_module(this, field, simTime, problemInfo, request) end subroutine - subroutine save_field_component(fieldData, fieldComponent, simTime, problemInfo, fieldDir) - real(kind=RKIND), intent(inout) :: fieldData(:, :) + subroutine save_field_component(this, fieldData, fieldComponent, simTime, problemInfo, fieldDir) + type(frequency_slice_probe_output_t), intent(inout) :: this + complex(kind=CKIND), intent(inout) :: fieldData(:, :) type(field_data_t), intent(in) :: fieldComponent(:, :, :) real(kind=RKIND_tiempo), intent(in) :: simTime type(problem_info_t), intent(in) :: problemInfo @@ -232,8 +234,6 @@ subroutine save_field_component(fieldData, fieldComponent, simTime, problemInfo, integer :: i, j, k, coordIdx - this%timeStep(this%nTime) = simTime - coordIdx = 0 do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y @@ -331,22 +331,25 @@ subroutine write_vtu_frequency_slice(this, freq, filename) !================= Write arrays to VTK ================= if (writeX) then + requestName = trim(adjustl(requestName))//'X' ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'X', x=Componentx) + ierr = vtkOutput%xml_writer%write_dataarray(data_name=requestName, x=Componentx) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') deallocate (Componentx) end if if (writeY) then + requestName = trim(adjustl(requestName))//'X' ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'Y', x=Componenty) + ierr = vtkOutput%xml_writer%write_dataarray(data_name=requestName, x=Componenty) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') deallocate (Componenty) end if if (writeZ) then + requestName = trim(adjustl(requestName))//'X' ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'Z', x=Componentz) + ierr = vtkOutput%xml_writer%write_dataarray(data_name=requestName, x=Componentz) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') deallocate (Componentz) end if @@ -377,7 +380,7 @@ subroutine update_pvd(this, freq, unitPVD) end subroutine update_pvd subroutine count_required_coords(this, problemInfo) - type(movie_probe_output_t), intent(inout) :: this + type(frequency_slice_probe_output_t), intent(inout) :: this type(problem_info_t), intent(in) :: problemInfo procedure(logical_func), pointer :: checker => null() ! Pointer to logical function @@ -422,9 +425,9 @@ subroutine count_required_coords(this, problemInfo) end select count = 0 - do i = istart, iend - do j = jstart, jend - do k = kstart, kend + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z if (checker(component, i, j, k, problemInfo)) count = count + 1 end do end do @@ -486,16 +489,16 @@ logical function volumicMagneticRequest(request, i, j, k, problemInfo) logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) integer, intent(in) :: i, j, k, fieldDir type(problem_info_t) :: problemInfo - componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo%problemDimension) + componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) if (componentCurrentRequest) then - componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo%geometryToMaterialData, problemInfo%materialList) & - .or. isThinWire(fieldDir, i, j, k, problemInfo%geometryToMaterialData, problemInfo%materialList) + componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) & + .or. isThinWire(fieldDir, i, j, k, problemInfo) end if end function logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) integer, intent(in) :: i, j, k, fieldDir type(problem_info_t) :: problemInfo - componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo%problemDimension) + componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) end function end module mod_frequencySliceProbeOutput diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 32e8422e..03c8fece 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -83,7 +83,7 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%auxCoords, control%mpidir) + 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)) @@ -92,9 +92,10 @@ end function get_output_path end subroutine init_movie_probe_output - subroutine update_movie_probe_output(this, step, fieldsReference, problemInfo) + subroutine update_movie_probe_output(this, step, fieldsReference, control, problemInfo) type(movie_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step + type(sim_control_t), intent(in) :: control type(problem_info_t), intent(in) :: problemInfo type(fields_reference_t), intent(in) :: fieldsReference @@ -113,25 +114,25 @@ subroutine update_movie_probe_output(this, step, fieldsReference, problemInfo) else if (any(VOLUMIC_X_MEASURE == request)) then select case (request) - case (iCurX); call save_current_component(this%xValueForTime, fieldsReference, step, problemInfo, iEx) - case (iExC); call save_field_component(this%xValueForTime, fieldsReference%E%x, step, problemInfo, iEx) - case (iHxC); call save_field_component(this%xValueForTime, fieldsReference%H%x, step, problemInfo, iHx) + case (iCurX); call save_current_component(this, this%xValueForTime, fieldsReference, step, problemInfo, iEx) + case (iExC); call save_field_component(this, this%xValueForTime, fieldsReference%E%x, step, problemInfo, iEx) + case (iHxC); call save_field_component(this, this%xValueForTime, fieldsReference%H%x, step, problemInfo, iHx) case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select else if (any(VOLUMIC_Y_MEASURE == request)) then select case (request) - case (iCurY); call save_current_component(this%yValueForTime, fieldsReference, step, problemInfo, iEy) - case (iEyC); call save_field_component(this%yValueForTime, fieldsReference%E%y, step, problemInfo, iEy) - case (iHyC); call save_field_component(this%yValueForTime, fieldsReference%H%y, step, problemInfo, iHy) + case (iCurY); call save_current_component(this, this%yValueForTime, fieldsReference, step, problemInfo, iEy) + case (iEyC); call save_field_component(this, this%yValueForTime, fieldsReference%E%y, step, problemInfo, iEy) + case (iHyC); call save_field_component(this, this%yValueForTime, fieldsReference%H%y, step, problemInfo, iHy) case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select else if (any(VOLUMIC_Z_MEASURE == request)) then select case (request) - case (iCurZ); call save_current_component(this%zValueForTime, fieldsReference, step, problemInfo, iEz) - case (iEzC); call save_field_component(this%zValueForTime, fieldsReference%E%z, step, problemInfo, iEz) - case (iHzC); call save_field_component(this%zValueForTime, fieldsReference%H%z, step, problemInfo, iHz) + case (iCurZ); call save_current_component(this, this%zValueForTime, fieldsReference, step, problemInfo, iEz) + case (iEzC); call save_field_component(this, this%zValueForTime, fieldsReference%E%z, step, problemInfo, iEz) + case (iHzC); call save_field_component(this, this%zValueForTime, fieldsReference%H%z, step, problemInfo, iHz) case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select end if @@ -151,18 +152,19 @@ subroutine save_current_module(this, fieldsReference, simTime, problemInfo) do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y do k = this%mainCoords%z, this%auxCoords%z - if (isValidForCurrent(iCur, i, j, k, problemInfo)) then + if (isValidPointForCurrent(iCur, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_current(this%xValueForTime, timeIdx, coordIdx, iEx, i, j, k, fieldsReference) - call save_current(this%yValueForTime, timeIdx, coordIdx, iEy, i, j, k, fieldsReference) - call save_current(this%zValueForTime, timeIdx, coordIdx, iEz, i, j, k, fieldsReference) + call save_current(this%xValueForTime, this%nTime, coordIdx, iEx, i, j, k, fieldsReference) + call save_current(this%yValueForTime, this%nTime, coordIdx, iEy, i, j, k, fieldsReference) + call save_current(this%zValueForTime, this%nTime, coordIdx, iEz, i, j, k, fieldsReference) end if end do end do end do end subroutine - subroutine save_current_component(currentData, fieldsReference, simTime, problemInfo, fieldDir) + subroutine save_current_component(this, currentData, fieldsReference, simTime, problemInfo, fieldDir) + type(movie_probe_output_t), intent(inout) :: this real(kind=RKIND), intent(inout) :: currentData(:, :) type(fields_reference_t), intent(in) :: fieldsReference real(kind=RKIND_tiempo), intent(in) :: simTime @@ -177,9 +179,9 @@ subroutine save_current_component(currentData, fieldsReference, simTime, problem do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y do k = this%mainCoords%z, this%auxCoords%z - if (isValidForCurrent(fieldDir, i, j, k, problemInfo)) then + if (isValidPointForCurrent(fieldDir, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_current(currentData, timeIdx, coordIdx, fieldDir, i, j, k, fieldsReference) + call save_current(currentData, this%nTime, coordIdx, fieldDir, i, j, k, fieldsReference) end if end do end do @@ -196,9 +198,9 @@ subroutine save_current(currentData, timeIdx, coordIdx, field, i, j, k, fieldsRe currentData(timeIdx, coordIdx) = jdir end subroutine - subroutine save_field_module(this, field, simTime, problemInfo, request) + subroutine save_field_module(this, field, request, simTime, problemInfo) type(movie_probe_output_t), intent(inout) :: this - type(field_data_t), pointer :: field + type(field_data_t), intent(in) :: field real(kind=RKIND_tiempo), intent(in) :: simTime type(problem_info_t), intent(in) :: problemInfo integer, intent(in) :: request @@ -213,9 +215,9 @@ subroutine save_field_module(this, field, simTime, problemInfo, request) do k = this%mainCoords%z, this%auxCoords%z if (isValidPointForField(request, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_field(this%xValueForTime, timeIdx, coordIdx, field%x(i, j, k)) - call save_field(this%yValueForTime, timeIdx, coordIdx, field%y(i, j, k)) - call save_field(this%zValueForTime, timeIdx, coordIdx, field%z(i, j, k)) + call save_field(this%xValueForTime, this%nTime, coordIdx, field%x(i, j, k)) + call save_field(this%yValueForTime, this%nTime, coordIdx, field%y(i, j, k)) + call save_field(this%zValueForTime, this%nTime, coordIdx, field%z(i, j, k)) end if end do end do @@ -223,7 +225,8 @@ subroutine save_field_module(this, field, simTime, problemInfo, request) end subroutine - subroutine save_field_component(fieldData, fieldComponent, simTime, problemInfo, fieldDir) + subroutine save_field_component(this, fieldData, fieldComponent, simTime, problemInfo, fieldDir) + type(movie_probe_output_t), intent(inout) :: this real(kind=RKIND), intent(inout) :: fieldData(:, :) type(field_data_t), intent(in) :: fieldComponent(:, :, :) real(kind=RKIND_tiempo), intent(in) :: simTime @@ -241,7 +244,7 @@ subroutine save_field_component(fieldData, fieldComponent, simTime, problemInfo, if (isValidPointForField(fieldDir, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 coordIdx = coordIdx + 1 - call save_field(fieldData, timeIdx, coordIdx, fieldComponent(i, j, k)) + call save_field(fieldData, this%nTime, coordIdx, fieldComponent(i, j, k)) end if end do end do @@ -260,7 +263,7 @@ subroutine flush_movie_probe_output(this) integer :: status, i do i = 1, this%nTime - call update_pvd(this, i, this%PDVUnit) + call update_pvd(this, i, this%fileUnitTime) end do call clear_memory_data() @@ -291,16 +294,16 @@ subroutine write_vtu_timestep(this, stepIndex, filename) logical :: writeX, writeY, writeZ !================= Determine the measure type ================= - select case (this%component) - case (CURRENT_MEASURE) + + if (any(CURRENT_MEASURE == this%component)) then requestName = 'Current' - case (ELECTRIC_FIELD_MEASURE) + else if (any(ELECTRIC_FIELD_MEASURE == this%component)) then requestName = 'Electric' - case (MAGNETIC_FIELD_MEASURE) + else if (any(MAGNETIC_FIELD_MEASURE == this%component)) then requestName = 'Magnetic' - case default + else requestName = 'Unknown' - end select + end if !================= Determine which components to write ================= writeX = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_X_MEASURE == this%component) @@ -337,7 +340,7 @@ subroutine write_vtu_timestep(this, stepIndex, filename) if (writeZ) then allocate (Componentz(npts)) do i = 1, npts - Componentz(i) = this%xValueForTime(frestepIndexq, i) + Componentz(i) = this%xValueForTime(stepIndex, i) end do end if @@ -392,6 +395,8 @@ subroutine count_required_coords(this, problemInfo) type(movie_probe_output_t), intent(inout) :: this type(problem_info_t), intent(in) :: problemInfo + integer :: i,j,k + procedure(logical_func), pointer :: checker => null() ! Pointer to logical function integer :: component, count select case (this%component) @@ -434,14 +439,14 @@ subroutine count_required_coords(this, problemInfo) end select count = 0 - do i = istart, iend - do j = jstart, jend - do k = kstart, kend + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z if (checker(component, i, j, k, problemInfo)) count = count + 1 end do end do end do - end do + this%nPoints = count end subroutine @@ -484,30 +489,30 @@ logical function volumicCurrentRequest(request, i, j, k, problemInfo) logical function volumicElectricRequest(request, i, j, k, problemInfo) integer, intent(in) :: i, j, k, request type(problem_info_t) :: problemInfo - volumicCurrentRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & + volumicElectricRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & .or. componentFieldRequest(iEy, i, j, k, problemInfo) & .or. componentFieldRequest(iEz, i, j, k, problemInfo) end function logical function volumicMagneticRequest(request, i, j, k, problemInfo) integer, intent(in) :: i, j, k, request type(problem_info_t) :: problemInfo - volumicCurrentRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & + volumicMagneticRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & .or. componentFieldRequest(iHy, i, j, k, problemInfo) & .or. componentFieldRequest(iHz, i, j, k, problemInfo) end function logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) integer, intent(in) :: i, j, k, fieldDir type(problem_info_t) :: problemInfo - componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo%problemDimension) + componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) if (componentCurrentRequest) then - componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo%geometryToMaterialData, problemInfo%materialList) & - .or. isThinWire(fieldDir, i, j, k, problemInfo%geometryToMaterialData, problemInfo%materialList) + componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) & + .or. isThinWire(fieldDir, i, j, k, problemInfo) end if end function logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) integer, intent(in) :: i, j, k, fieldDir type(problem_info_t) :: problemInfo - componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo%problemDimension) + componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) end function end module mod_movieProbeOutput diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 25bf163c..7e8e3dc9 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -113,17 +113,17 @@ module outputTypes ! Concrete probe types !===================================================== type, extends(abstract_time_frequency_probe_t) :: point_probe_output_t - real(kind=RKIND) :: valueForTime(:) + real(kind=RKIND), allocatable :: valueForTime(:) complex(kind=CKIND), allocatable :: valueForFreq(:) end type point_probe_output_t type, extends(abstract_time_probe_t) :: wire_charge_probe_output_t integer(kind=SINGLE) :: sign = +1 - real(kind=RKIND) :: chargeValue(:) + real(kind=RKIND), allocatable :: chargeValue(:) type(CurrentSegments), pointer :: segment end type wire_charge_probe_output_t - type :: wire_current_probe_output_t + type, extends(abstract_time_probe_t) :: wire_current_probe_output_t integer(kind=SINGLE) :: sign = +1 type(current_values_t) :: currentValues(BuffObse) type(CurrentSegments), pointer :: segment @@ -137,7 +137,7 @@ module outputTypes type, extends(abstract_time_probe_t) :: bulk_current_probe_output_t type(cell_coordinate_t) :: auxCoords - real(kind=RKIND) :: valueForTime(:) + real(kind=RKIND), allocatable :: valueForTime(:) end type bulk_current_probe_output_t type, extends(abstract_frequency_probe_t) :: far_field_probe_output_t diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 82bec233..a3607c55 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -68,7 +68,7 @@ subroutine alloc_and_init_time_1D(array, n1, initVal) allocate (array(n1)) array = initVal - END subroutine alloc_and_init_int_1D + END subroutine alloc_and_init_time_1D subroutine alloc_and_init_int_1D(array, n1, initVal) integer(SINGLE), allocatable, intent(inout) :: array(:) @@ -151,6 +151,23 @@ subroutine alloc_and_init_complex_3D(array, n1, n2, n3, initVal) array = initVal END subroutine alloc_and_init_complex_3D + function getMediaIndex(field, i, j, k, CoordToMaterial) result(res) + integer, intent(in) :: field, i, j, k + type(media_matrices_t), pointer, intent(in) :: CoordToMaterial + + integer :: res + + select case (field) + case (iEx); res = CoordToMaterial%sggMiEx(i, j, k) + case (iEy); res = CoordToMaterial%sggMiEy(i, j, k) + case (iEz); res = CoordToMaterial%sggMiEz(i, j, k) + case (iHx); res = CoordToMaterial%sggMiHx(i, j, k) + case (iHy); res = CoordToMaterial%sggMiHy(i, j, k) + case (iHz); res = CoordToMaterial%sggMiHz(i, j, k) + end select + + end function + function get_probe_coords_extension(coordinates, mpidir) result(ext) type(cell_coordinate_t) :: coordinates integer(kind=SINGLE), intent(in) :: mpidir @@ -391,12 +408,12 @@ function get_field_component(fieldId, fieldReference) result(component) integer(kind=SINGLE), intent(in) :: fieldId real(kind=RKIND), pointer, dimension(:, :, :) :: component select case (fieldId) - case (iEx); component => fieldsReference%E%x - case (iEy); component => fieldsReference%E%y - case (iEz); component => fieldsReference%E%z - case (iHx); component => fieldsReference%H%x - case (iHy); component => fieldsReference%H%y - case (iHz); component => fieldsReference%H%z + case (iEx); component => fieldReference%E%x + case (iEy); component => fieldReference%E%y + case (iEz); component => fieldReference%E%z + case (iHx); component => fieldReference%H%x + case (iHy); component => fieldReference%H%y + case (iHz); component => fieldReference%H%z end select end function @@ -406,21 +423,21 @@ function get_field_reference(fieldId, fieldReference) result(field) type(field_data_t) :: field select case (fieldId) case (iBloqueJx, iBloqueJy, iBloqueJz) - field%x => fieldsReference%E%x - field%y => fieldsReference%E%y - field%z => fieldsReference%E%z + field%x => fieldReference%E%x + field%y => fieldReference%E%y + field%z => fieldReference%E%z - field%deltaX => fieldsReference%E%deltax - field%deltaY => fieldsReference%E%deltay - field%deltaZ => fieldsReference%E%deltaz + field%deltaX => fieldReference%E%deltax + field%deltaY => fieldReference%E%deltay + field%deltaZ => fieldReference%E%deltaz case (iBloqueMx, iBloqueMy, iBloqueMz) - field%x => fieldsReference%H%x - field%y => fieldsReference%H%y - field%z => fieldsReference%H%z + field%x => fieldReference%H%x + field%y => fieldReference%H%y + field%z => fieldReference%H%z - field%deltaX => fieldsReference%H%deltax - field%deltaY => fieldsReference%H%deltay - field%deltaZ => fieldsReference%H%deltaz + field%deltaX => fieldReference%H%deltax + field%deltaY => fieldReference%H%deltay + field%deltaZ => fieldReference%H%deltaz end select end function get_field_reference diff --git a/src_output/pointProbeOutput.F90 b/src_output/pointProbeOutput.F90 index 06069f14..4954f8ef 100644 --- a/src_output/pointProbeOutput.F90 +++ b/src_output/pointProbeOutput.F90 @@ -18,9 +18,9 @@ subroutine init_point_probe_output(this, coordinates, field, domain, outputTypeE integer(kind=SINGLE) :: i - this%coordinates = coordinates + this%mainCoords = coordinates - this%fieldComponent = field + this%component = field this%domain = domain this%path = get_output_path() @@ -46,7 +46,7 @@ subroutine init_point_probe_output(this, coordinates, field, domain, outputTypeE function get_output_path() result(outputPath) character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_coordinates_extension(this%coordinates, mpidir) + probeBoundsExtension = get_coordinates_extension(this%mainCoords, mpidir) prefixFieldExtension = get_prefix_extension(field, mpidir) outputPath = & trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) @@ -83,22 +83,22 @@ subroutine update_point_probe_output(this, step, field) integer(kind=SINGLE) :: iter if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then - this%serializedTimeSize = this%serializedTimeSize + 1 - this%timeStep(this%serializedTimeSize) = step - this%valueForTime(this%serializedTimeSize) = field(this%coordinates%x, this%coordinates%y, this%coordinates%z) + this%nTime = this%nTime + 1 + this%timeStep(this%nTime) = step + this%valueForTime(this%nTime) = field(this%mainCoords%x, this%mainCoords%y, this%mainCoords%z) end if if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - select case (this%fieldComponent) + select case(this%component) case (iEx, iEy, iEz) do iter = 1, this%nFreq this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%coordinates%x, this%coordinates%y, this%coordinates%z)*(this%auxExp_E(iter)**step) + this%valueForFreq(iter) + field(this%mainCoords%x, this%mainCoords%y, this%mainCoords%z)*(this%auxExp_E(iter)**step) end do case (iHx, iHy, iHz) do iter = 1, this%nFreq this%valueForFreq(iter) = & - this%valueForFreq(iter) + field(this%coordinates%x, this%coordinates%y, this%coordinates%z)*(this%auxExp_H(iter)**step) + this%valueForFreq(iter) + field(this%mainCoords%x, this%mainCoords%y, this%mainCoords%z)*(this%auxExp_H(iter)**step) end do end select @@ -121,7 +121,7 @@ subroutine flush_time_domain(this) integer :: i character(len=BUFSIZE) :: filename - if (this%serializedTimeSize <= 0) then + if (this%nTime <= 0) then print *, "No data to write." return end if @@ -129,7 +129,7 @@ subroutine flush_time_domain(this) filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") - do i = 1, this%serializedTimeSize + do i = 1, this%nTime write (this%fileUnitTime, '(F12.6,1X,F12.6)') this%timeStep(i), this%valueForTime(i) end do @@ -164,7 +164,7 @@ subroutine clear_time_data() this%timeStep = 0.0_RKIND_tiempo this%valueForTime = 0.0_RKIND - this%serializedTimeSize = 0 + this%nTime = 0 end subroutine clear_time_data end subroutine flush_point_probe_output diff --git a/src_output/volumicProbeOutput.F90 b/src_output/volumicProbeOutput.F90 deleted file mode 100644 index 06e85c4b..00000000 --- a/src_output/volumicProbeOutput.F90 +++ /dev/null @@ -1,305 +0,0 @@ -module mod_volumicProbeOutput - use FDETYPES - use mod_domain - use mod_outputUtils - implicit none - private - - !=========================== - ! Public interface summary - !=========================== - public :: init_volumic_probe_output - public :: update_volumic_probe_output - public :: flush_volumic_probe_output - !=========================== - - !=========================== - ! Private interface summary - !=========================== - private :: isRelevantCell - private :: isRelevantSurfaceCell - private :: updateComplexComponent - private :: count_relevant_geometries - !=========================== - -contains - - subroutine init_volumic_probe_output(this, lowerBound, upperBound, field, domain, geometryMedia, registeredMedia, sinpml_fullsize, outputTypeExtension, mpidir, timeInterval) - type(volumic_current_probe_t), intent(inout) :: this - type(cell_coordinate_t), intent(in) :: lowerBound, upperBound - integer(kind=SINGLE), intent(in) :: mpidir, field - character(len=BUFSIZE), intent(in) :: outputTypeExtension - - type(MediaData_t), pointer, dimension(:) :: registeredMedia - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize - - real(kind=RKIND_tiempo), intent(in) :: timeInterval - - type(domain_t), intent(in) :: domain - - integer(kind=SINGLE) :: i, relevantGeometriesCount - - this%lowerBound = lowerBound - this%upperBound = upperBound - this%fieldComponent = field - this%domain = domain - this%path = get_output_path() - - relevantGeometriesCount = count_relevant_geometries(this, geometryMedia, registeredMedia, sinpml_fullsize) - - if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then - allocate (this%timeStep(BuffObse)) - allocate (this%xValueForTime(BuffObse, relevantGeometriesCount)) - allocate (this%yValueForTime(BuffObse, relevantGeometriesCount)) - allocate (this%zValueForTime(BuffObse, relevantGeometriesCount)) - this%xValueForTime = 0.0_RKIND - this%yValueForTime = 0.0_RKIND - this%zValueForTime = 0.0_RKIND - end if - - if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - this%nFreq = this%nFreq - allocate (this%frequencySlice(this%nFreq)) - allocate (this%xValueForFreq(this%nFreq, relevantGeometriesCount)) - allocate (this%yValueForFreq(this%nFreq, relevantGeometriesCount)) - allocate (this%zValueForFreq(this%nFreq, relevantGeometriesCount)) - do i = 1, this%nFreq - call init_frequency_slice(this%frequencySlice, this%domain) - end do - this%xValueForFreq = (0.0_RKIND, 0.0_RKIND) - this%yValueForFreq = (0.0_RKIND, 0.0_RKIND) - this%zValueForFreq = (0.0_RKIND, 0.0_RKIND) - - allocate (this%auxExp_E(this%nFreq)) - allocate (this%auxExp_H(this%nFreq)) - do i = 1, this%nFreq - this%auxExp_E(i) = timeInterval*(1.0E0_RKIND, 0.0E0_RKIND)*Exp(mcpi2*this%frequencySlice(i)) !el dt deberia ser algun tipo de promedio - this%auxExp_H(i) = this%auxExp_E(i)*Exp(mcpi2*this%frequencySlice(i)*timeInterval*0.5_RKIND) - end do - end if - - contains - function get_output_path() result(outputPath) - character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension - character(len=BUFSIZE) :: outputPath - probeBoundsExtension = get_coordinates_extension(this%lowerBound, this%upperBound, 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_volumic_probe_output - - function count_relevant_geometries(this, geometryMedia, registeredMedia, sinpml_fullsize) result(n) - type(volumic_current_probe_t), intent(in) :: this - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize - integer(kind=SINGLE) :: i, j, k, field - integer(kind=SINGLE) :: n - - n = 0_SINGLE - do i = this%lowerBound%x, this%upperBound%x - do j = this%lowerBound%y, this%upperBound%y - do k = this%lowerBound%z, this%upperBound%z - do field = iEx, iEz - if (isRelevantCell(field, i, j, k, geometryMedia, registeredMedia, sinpml_fullsize)) then - n = n + 1 - end if - end do - do field = iHx, iHz - if (isRelevantSurfaceCell(field, i, j, k, this%fieldComponent, geometryMedia, registeredMedia, sinpml_fullsize)) then - n = n + 1 - end if - end do - end do - end do - end do - end function - - subroutine update_volumic_probe_output(this, step, geometryMedia, registeredMedia, sinpml_fullsize, fieldsReference) - type(volumic_current_probe_t), intent(inout) :: this - real(kind=RKIND_tiempo), intent(in) :: step - - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize - type(fields_reference_t), intent(in) :: fieldsReference - - integer(kind=SINGLE) :: Efield, Hfield, i, j, k, conta - integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2 - - i1 = this%lowerBound%x - j1 = this%lowerBound%y - k1 = this%lowerBound%z - - i2 = this%upperBound%x - j2 = this%upperBound%y - k2 = this%upperBound%z - - if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then - conta = 0 - this%serializedTimeSize = this%serializedTimeSize + 1 - do i = i1, i2 - do j = j1, j2 - do k = k1, k2 - do Efield = iEx, iEz - if (isRelevantCell(Efield, i, j, k, geometryMedia, registeredMedia, sinpml_fullsize)) then - conta = conta + 1 - call save_current(this, Efield, i, j, k, conta, fieldsReference) - end if - end do - do Hfield = iHx, iHz - if (isRelevantSurfaceCell(Hfield, i, j, k, this%fieldComponent, geometryMedia, registeredMedia, sinpml_fullsize)) then - conta = conta + 1 - call save_current_surfaces(this, Hfield, i, j, k, conta, fieldsReference) - end if - end do - end do - end do - end do - end if - - if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - conta = 0 - do i = i1, i2 - do j = j1, j2 - do k = k1, k2 - do Efield = iEx, iEz - if (isRelevantCell(Efield, i, j, k, geometryMedia, registeredMedia, sinpml_fullsize)) then - conta = conta + 1 - call update_current(this, Efield, i, j, k, conta, fieldsReference, step) - end if - end do - do Hfield = iHx, iHz - if (isRelevantSurfaceCell(Hfield, i, j, k, this%fieldComponent, geometryMedia, registeredMedia, sinpml_fullsize)) then - conta = conta + 1 - call update_current_surfaces(this, Hfield, i, j, k, conta, fieldsReference, step) - end if - end do - end do - end do - end do - end if - contains - subroutine save_current(this, Efield, i, j, k, conta, field_reference) - type(fields_reference_t), intent(in) :: field_reference - type(volumic_current_probe_t), intent(inout) :: this - integer(kind=SINGLE), intent(in) :: Efield, i, j, k, conta - - real(kind=RKIND) :: jdir - - jdir = computeJ(EField, i, j, k, field_reference) - this%xValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEx) - this%yValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEy) - this%zValueForTime(this%serializedTimeSize, conta) = merge(jdir, 0.0_RKIND, Efield == iEz) - end subroutine save_current - - subroutine save_current_surfaces(this, Hfield, i, j, k, conta, field_reference) - implicit none - type(fields_reference_t), intent(in) :: field_reference - type(volumic_current_probe_t), intent(inout) :: this - integer(kind=SINGLE), intent(in) :: Hfield, i, j, k, conta - - real(kind=RKIND) :: jdir1, jdir2 - jdir1 = computeJ1(HField, i, j, k, field_reference) - jdir2 = computeJ2(HField, i, j, k, field_reference) - - this%xValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHz), Hfield == iHx) - this%yValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHx), Hfield == iHy) - this%zValueForTime(this%serializedTimeSize, conta) = merge(0.0_RKIND, merge(jdir1, jdir2, HField == iHy), Hfield == iHz) - end subroutine save_current_surfaces - - subroutine update_current(this, Efield, i, j, k, conta, field_reference, step) - integer(kind=SINGLE), intent(in) :: Efield, i, j, k, conta - type(volumic_current_probe_t), intent(inout) :: this - type(fields_reference_t), intent(in) :: field_reference - real(kind=RKIND_tiempo), intent(in) :: step - - integer(kind=SINGLE) :: freqIdx - real(kind=RKIND) :: jdir - - jdir = computeJ(Efield, i, j, k, field_reference) - do freqIdx = 1, this%nFreq - call updateComplexComponent(iEx, EField, this%xValueForFreq(freqIdx, conta), jdir, this%auxExp_E(freqIdx)**step) - call updateComplexComponent(iEy, EField, this%yValueForFreq(freqIdx, conta), jdir, this%auxExp_E(freqIdx)**step) - call updateComplexComponent(iEz, EField, this%zValueForFreq(freqIdx, conta), jdir, this%auxExp_E(freqIdx)**step) - end do - end subroutine update_current - - subroutine update_current_surfaces(this, Hfield, i, j, k, conta, field_reference, step) - integer(kind=SINGLE), intent(in) :: Hfield, i, j, k, conta - type(volumic_current_probe_t), intent(inout) :: this - type(fields_reference_t), intent(in) :: field_reference - real(kind=RKIND_tiempo), intent(in) :: step - - integer(kind=SINGLE) :: freqIdx - real(kind=RKIND) :: jdir, jdir1, jdir2 - - jdir1 = computeJ1(HField, i, j, k, field_reference) - jdir2 = computeJ2(HField, i, j, k, field_reference) - do freqIdx = 1, this%nFreq - jdir = merge(jdir1, jdir2, HField == iHz) - call updateComplexComponent(iHx, Hfield, this%xValueForFreq(freqIdx, conta), jdir, this%auxExp_H(freqIdx)**step) - - jdir = merge(jdir1, jdir2, HField == iHx) - call updateComplexComponent(iHy, Hfield, this%yValueForFreq(freqIdx, conta), jdir, this%auxExp_H(freqIdx)**step) - - jdir = merge(jdir1, jdir2, HField == iHy) - call updateComplexComponent(iHz, Hfield, this%zValueForFreq(freqIdx, conta), jdir, this%auxExp_H(freqIdx)**step) - end do - end subroutine update_current_surfaces - - end subroutine update_volumic_probe_output - - subroutine flush_volumic_probe_output - !!TODO - end subroutine flush_volumic_probe_output - - logical function isRelevantCell(Efield, I, J, K, geometryMedia, registeredMedia, sinpml_fullsize) - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize - integer(kind=SINGLE), intent(in) :: Efield, I, J, K - isRelevantCell = .false. - - if (isWithinBounds(Efield, I, J, K, sinpml_fullsize)) then - if (isThinWire(Efield, I, J, K, geometryMedia, registeredMedia)) then - isRelevantCell = .true. - end if - if (.NOT. isMediaVacuum(Efield, I, J, K, geometryMedia)) then - if (.NOT. isSplitOrAdvanced(Efield, I, J, K, geometryMedia, registeredMedia)) then - isRelevantCell = .true. - end if - end if - end if - - end function - - logical function isRelevantSurfaceCell(field, i, j, k, outputType, geometryMedia, registeredMedia, sinpml_fullsize) - type(media_matrices_t), pointer, intent(in) :: geometryMedia - type(MediaData_t), pointer, dimension(:), intent(in) :: registeredMedia - type(limit_t), pointer, dimension(:), intent(in) :: sinpml_fullsize - integer(kind=SINGLE), intent(in) :: field, i, j, k, outputType - - isRelevantSurfaceCell = .false. - if (isWithinBounds(field, i, j, k, sinpml_fullsize)) then - isRelevantSurfaceCell = isPEC(field, i, j, k, geometryMedia, registeredMedia) - end if - - end function - - subroutine updateComplexComponent(direction, fieldIndex, valorComplex, jdir, auxExp) - integer, intent(in) :: direction, fieldIndex - complex(kind=CKIND), intent(inout) :: valorComplex - complex(kind=CKIND), intent(in) :: auxExp - real(kind=RKIND), intent(in) :: jdir - - complex(kind=CKIND) :: z_cplx = (0.0_RKIND, 0.0_RKIND) - - valorComplex = merge(valorComplex + auxExp*jdir, z_cplx, fieldIndex == direction) - end subroutine updateComplexComponent - -end module mod_volumicProbeOutput diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index 1a739cb6..92ba331e 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -55,9 +55,9 @@ subroutine init_wire_current_probe_output(this, coordinates, node, field, domain call find_segment() - this%coordinates = coordinates + this%mainCoords = coordinates - this%currentComponent = field + this%component = field this%domain = domain this%path = get_output_path() @@ -203,9 +203,9 @@ subroutine init_wire_charge_probe_output(this, coordinates, node, field, domain, call find_segment() - this%coordinates = coordinates + this%mainCoords = coordinates - this%chargeComponent = field + this%component = field this%domain = domain this%path = get_output_path() @@ -313,63 +313,63 @@ subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank, select case (trim(adjustl(wiresflavor))) case ('holland', 'transition') - this%serializedTimeSize = this%serializedTimeSize + 1 - this%timeStep(this%serializedTimeSize) = step + this%nTime = this%nTime + 1 + this%timeStep(this%nTime) = step SegmDumm => this%segment - this%currentValues(this%serializedTimeSize)%current = this%sign*SegmDumm%currentpast - this%currentValues(this%serializedTimeSize)%deltaVoltage = -SegmDumm%Efield_wire2main*SegmDumm%delta + this%currentValues(this%nTime)%current = this%sign*SegmDumm%currentpast + this%currentValues(this%nTime)%deltaVoltage = -SegmDumm%Efield_wire2main*SegmDumm%delta if (wirecrank) then - this%currentValues(this%serializedTimeSize)%plusVoltage = this%sign* & + this%currentValues(this%nTime)%plusVoltage = this%sign* & (((SegmDumm%ChargePlus%ChargePresent)))*SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) - this%currentValues(this%serializedTimeSize)%minusVoltage = this%sign* & + this%currentValues(this%nTime)%minusVoltage = this%sign* & (((SegmDumm%ChargeMinus%ChargePresent)))*SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) else - this%currentValues(this%serializedTimeSize)%plusVoltage = this%sign* & + this%currentValues(this%nTime)%plusVoltage = this%sign* & (((SegmDumm%ChargePlus%ChargePresent + SegmDumm%ChargePlus%ChargePast))/2.0_RKIND)* & SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) - this%currentValues(this%serializedTimeSize)%minusVoltage = this%sign* & + this%currentValues(this%nTime)%minusVoltage = this%sign* & (((SegmDumm%ChargeMinus%ChargePresent + SegmDumm%ChargeMinus%ChargePast))/2.0_RKIND)* & SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) end if - this%currentValues(this%serializedTimeSize)%voltageDiference = & - this%currentValues(this%serializedTimeSize)%plusVoltage - this%currentValues(this%serializedTimeSize)%minusVoltage + this%currentValues(this%nTime)%voltageDiference = & + this%currentValues(this%nTime)%plusVoltage - this%currentValues(this%nTime)%minusVoltage #ifdef CompileWithBerengerWires case ('berenger') - this%serializedTimeSize = this%serializedTimeSize + 1 - this%timeStep(this%serializedTimeSize) = step + this%nTime = this%nTime + 1 + this%timeStep(this%nTime) = step SegmDumm_Berenger => this%segmentBerenger - this%currentValues(this%serializedTimeSize)%current = this%sign*SegmDumm_Berenger%currentpast - this%currentValues(this%serializedTimeSize)%deltaVoltage = -SegmDumm_Berenger%field*SegmDumm_Berenger%dl + this%currentValues(this%nTime)%current = this%sign*SegmDumm_Berenger%currentpast + this%currentValues(this%nTime)%deltaVoltage = -SegmDumm_Berenger%field*SegmDumm_Berenger%dl - this%currentValues(this%serializedTimeSize)%plusVoltage = this%sign* & + this%currentValues(this%nTime)%plusVoltage = this%sign* & (((SegmDumm_Berenger%ChargePlus + SegmDumm_Berenger%ChargePlusPast))/2.0_RKIND)* & SegmDumm_Berenger%L*(InvMu(SegmDumm_Berenger%imed)*InvEps(SegmDumm_Berenger%imed)) - this%currentValues(this%serializedTimeSize)%minusVoltage = this%sign* & + this%currentValues(this%nTime)%minusVoltage = this%sign* & (((SegmDumm_Berenger%ChargeMinus + SegmDumm_Berenger%ChargeMinusPast))/2.0_RKIND)* & SegmDumm_Berenger%L*(InvMu(SegmDumm_Berenger%imed)*InvEps(SegmDumm_Berenger%imed)) - this%currentValues(this%serializedTimeSize)%voltageDiference = & - this%currentValues(this%serializedTimeSize)%plusVoltage - this%currentValues(this%serializedTimeSize)%minusVoltage + this%currentValues(this%nTime)%voltageDiference = & + this%currentValues(this%nTime)%plusVoltage - this%currentValues(this%nTime)%minusVoltage #endif #ifdef CompileWithSlantedWires case ('slanted', 'semistructured') - this%serializedTimeSize = this%serializedTimeSize + 1 - this%timeStep(this%serializedTimeSize) = step + this%nTime = this%nTime + 1 + this%timeStep(this%nTime) = step SegmDumm_Slanted => this%segmentSlanted - this%currentValues(this%serializedTimeSize)%current = SegmDumm_Slanted%Currentpast !ojo: slanted ya los orienta bien y no hay que multiplicar por valorsigno - this%currentValues(this%serializedTimeSize)%deltaVoltage = -SegmDumm_Slanted%field*SegmDumm_Slanted%dl - this%currentValues(this%serializedTimeSize)%plusVoltage = & + this%currentValues(this%nTime)%current = SegmDumm_Slanted%Currentpast !ojo: slanted ya los orienta bien y no hay que multiplicar por valorsigno + this%currentValues(this%nTime)%deltaVoltage = -SegmDumm_Slanted%field*SegmDumm_Slanted%dl + this%currentValues(this%nTime)%plusVoltage = & (((SegmDumm_Slanted%Voltage(iPlus)%ptr%Voltage + SegmDumm_Slanted%Voltage(iPlus)%ptr%VoltagePast))/2.0_RKIND) - this%currentValues(this%serializedTimeSize)%minusVoltage = & + this%currentValues(this%nTime)%minusVoltage = & (((SegmDumm_Slanted%Voltage(iMinus)%ptr%Voltage + SegmDumm_Slanted%Voltage(iMinus)%ptr%VoltagePast))/2.0_RKIND) - this%currentValues(this%serializedTimeSize)%voltageDiference = & - this%currentValues(this%serializedTimeSize)%plusVoltage - this%currentValues(this%serializedTimeSize)%minusVoltage + this%currentValues(this%nTime)%voltageDiference = & + this%currentValues(this%nTime)%plusVoltage - this%currentValues(this%nTime)%minusVoltage #endif end select @@ -380,10 +380,10 @@ subroutine update_wire_charge_probe_output(this, step) real(kind=RKIND_tiempo), intent(in) :: step type(CurrentSegments), pointer :: segmDumm - this%serializedTimeSize = this%serializedTimeSize + 1 - this%timeStep(this%serializedTimeSize) = step + this%nTime = this%nTime + 1 + this%timeStep(this%nTime) = step SegmDumm => this%segment - this%chargeValue(this%serializedTimeSize) = SegmDumm%ChargeMinus%ChargePresent + this%chargeValue(this%nTime) = SegmDumm%ChargeMinus%ChargePresent end subroutine update_wire_charge_probe_output subroutine flush_wire_current_probe_output(this) @@ -394,7 +394,7 @@ subroutine flush_wire_current_probe_output(this) filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") - do i = 1, this%serializedTimeSize + do i = 1, this%nTime write (this%fileUnitTime, fmt) this%timeStep(i), & this%currentValues%current, & this%currentValues%deltaVoltage, & @@ -415,7 +415,7 @@ subroutine clear_time_data() this%currentValues%minusVoltage = 0.0_RKIND this%currentValues%voltageDiference = 0.0_RKIND - this%serializedTimeSize = 0 + this%nTime = 0 end subroutine clear_time_data end subroutine flush_wire_current_probe_output @@ -427,7 +427,7 @@ subroutine flush_wire_charge_probe_output(this) filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") - do i = 1, this%serializedTimeSize + do i = 1, this%nTime write (this%fileUnitTime, fmt) this%timeStep(i), & this%chargeValue end do @@ -439,7 +439,7 @@ subroutine clear_time_data() this%chargeValue = 0.0_RKIND - this%serializedTimeSize = 0 + this%nTime = 0 end subroutine clear_time_data end subroutine flush_wire_charge_probe_output end module mod_wireProbeOutput diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 2df5bbc6..3c700ca2 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -998,8 +998,7 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) - type(Obses_t) :: movieObservable - type(cell_coordinate_t) :: lowerBoundMovieProbe, upperBoundMovieProbe + type(Obses_t) :: frequencySliceObservable type(fields_reference_t) :: fields type(dummyFields_t), target :: dummyFields @@ -1017,14 +1016,6 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) err = 1 - !--- Probe bounds --- - lowerBoundMovieProbe%x = 2 - lowerBoundMovieProbe%y = 2 - lowerBoundMovieProbe%z = 2 - upperBoundMovieProbe%x = 5 - upperBoundMovieProbe%y = 5 - upperBoundMovieProbe%z = 5 - !--- Setup SGG --- call sgg_init(dummysgg) call init_time_array(timeArray, nTimeSteps, dt) @@ -1041,8 +1032,14 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0,0,0,6,6,6)) - movieObservable = create_movie_observation(2,2,2,5,5,5) - call sgg_add_observation(dummysgg, movieObservable) + movieCurrentObservable = create_movie_observation(2,2,2,5,5,5, iCur) + call sgg_add_observation(dummysgg, movieCurrentObservable) + + movieElectricXObservable = create_movie_observation(2,2,2,5,5,5, iExC) + call sgg_add_observation(dummysgg, movieElectricXObservable) + + movieMagneticYObservable = create_movie_observation(2,2,2,5,5,5, iHyC) + call sgg_add_observation(dummysgg, movieMagneticYObservable) call create_geometry_media(media, 0,8,0,8,0,8) call assing_material_id_to_media_matrix_coordinate(media,iEy,3,3,3,simulationMaterials(0)%Id) @@ -1068,15 +1065,16 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) outputs(1)%movieProbe%serializedTimeSize = 1 outputs(1)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo outputs(1)%movieProbe%xValueForTime(1,:) = 0.0_RKIND - outputs(1)%movieProbe%yValueForTime(1,:) = [0.1_RKIND,0.2_RKIND,0.3_RKIND,0.4_RKIND] + outputs(1)%movieProbe%yValueForTime(1,:) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] outputs(1)%movieProbe%zValueForTime(1,:) = 0.0_RKIND + !--- Dummy second update --- - outputs(1)%movieProbe%serializedTimeSize = 2 - outputs(1)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo - outputs(1)%movieProbe%xValueForTime(2,:) = 0.0_RKIND - outputs(1)%movieProbe%yValueForTime(2,:) = [0.11_RKIND,0.22_RKIND,0.33_RKIND,0.44_RKIND] - outputs(1)%movieProbe%zValueForTime(2,:) = 0.0_RKIND + outputs(iOutput)%movieProbe%serializedTimeSize = 2 + outputs(iOutput)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo + outputs(iOutput)%movieProbe%xValueForTime(2,:) = 0.0_RKIND + outputs(iOutput)%movieProbe%yValueForTime(2,:) = [0.11_RKIND,0.22_RKIND,0.33_RKIND,0.44_RKIND] + outputs(iOutput)%movieProbe%zValueForTime(2,:) = 0.0_RKIND call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) From af9d651703a3b16990ddcd008679d964034feaea Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 8 Jan 2026 10:46:58 +0100 Subject: [PATCH 48/67] Fix update for frequency slices --- src_main_pub/fdetypes.F90 | 2 + src_output/frequencySliceProbeOutput.F90 | 225 ++++++++++++----------- src_output/movieProbeOutput.F90 | 142 +++++++------- src_output/output.F90 | 4 +- src_output/outputUtils.F90 | 4 +- 5 files changed, 202 insertions(+), 175 deletions(-) diff --git a/src_main_pub/fdetypes.F90 b/src_main_pub/fdetypes.F90 index 94ef58c7..26cf7b51 100755 --- a/src_main_pub/fdetypes.F90 +++ b/src_main_pub/fdetypes.F90 @@ -186,6 +186,8 @@ module FDETYPES integer (kind=4), parameter :: VOLUMIC_Y_MEASURE(3) = [iCury, iEyC, iHyC] integer (kind=4), parameter :: VOLUMIC_Z_MEASURE(3) = [iCurz, iEzC, iHzC] + integer (kind=4), parameter :: MAGNETIC_FIELD_DIRECTION(3) = [iEx, iEy, iEz] + integer (kind=4), parameter :: ELECTRIC_FIELD_DIRECTION(3) = [iHx, iHy, iHz] integer (kind=4), parameter :: CURRENT_MEASURE(4) = [iCur, iCurx, iCury, iCurz] integer (kind=4), parameter :: ELECTRIC_FIELD_MEASURE(4) = [iMEC, iExC, iEyC, iEzC] integer (kind=4), parameter :: MAGNETIC_FIELD_MEASURE(4) = [iMHC, iHxC, iHyC, iHzC] diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index 8c57f4d8..e3427d53 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -17,12 +17,24 @@ module mod_frequencySliceProbeOutput !=========================== ! Private interface summary !=========================== - private :: get_measurements_coords - private :: save_current_data - private :: write_vtu_frequency_slice + private :: save_field + private :: save_field_module + private :: save_field_component + private :: save_current + private :: save_current_module + private :: save_current_component private :: update_pvd + private :: write_vtu_frequency_slice !=========================== + abstract interface + logical function logical_func(component, i, j, k, problemInfo) + import :: problem_info_t + type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: component, i, j, k + end function logical_func + end interface + contains subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeInterval, field, domain, outputTypeExtension, control, problemInfo) @@ -107,9 +119,9 @@ subroutine update_frequency_slice_probe_output(this, step, fieldsReference, cont else if (any(VOLUMIC_X_MEASURE == request)) then select case (request) - case (iCurX); call save_current_component(this%xValueForFreq, fieldsReference, problemInfo, iEx, this%auxExp_E, this%nFreq, step) - case (iExC); call save_field_component(this%xValueForFreq, fieldsReference%E%x, step, problemInfo, iEx) - case (iHxC); call save_field_component(this%xValueForFreq, fieldsReference%H%x, step, problemInfo, iHx) + case (iCurX); call save_current_component(this, this%xValueForFreq, fieldsReference, problemInfo, iEx, this%auxExp_E, this%nFreq, step) + case (iExC); call save_field_component(this, this%xValueForFreq, fieldsReference%E%x, step, problemInfo, iEx) + case (iHxC); call save_field_component(this, this%xValueForFreq, fieldsReference%H%x, step, problemInfo, iHx) case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select @@ -178,10 +190,10 @@ subroutine save_current_component(this, currentData, fieldsReference, problemInf end do end subroutine - subroutine save_current(valorComplex, direction, coordIdx, i, j, k, fieldsReference, auxExp, nFreq, step) + subroutine save_current(valorComplex, direction, coordIdx, i, j, k, fieldsReference, auxExponential, nFreq, step) integer, intent(in) :: direction - complex(kind=CKIND), intent(inout) :: valorComplex(:,:) - complex(kind=CKIND), intent(in) :: auxExp + complex(kind=CKIND), intent(inout) :: valorComplex(:, :) + complex(kind=CKIND), intent(in) :: auxExponential(:) integer, intent(in) :: i, j, k, coordIdx, nFreq type(fields_reference_t), intent(in) :: fieldsReference real(kind=RKIND_tiempo), intent(in) :: step @@ -193,20 +205,22 @@ subroutine save_current(valorComplex, direction, coordIdx, i, j, k, fieldsRefere jdir = computej(direction, i, j, k, fieldsReference) do iter = 1, nFreq - valorComplex(i, coordIdx) = valorComplex(i, coordIdx) + (auxExp(i)**step)*jdir + valorComplex(i, coordIdx) = valorComplex(i, coordIdx) + (auxExponential(i)**step)*jdir end do end subroutine - subroutine save_field_module(this, field, simTime, request, problemInfo) + subroutine save_field_module(this, fieldInfo, simTime, request, problemInfo) type(frequency_slice_probe_output_t), intent(inout) :: this - type(field_data_t), pointer :: field + type(field_data_t), intent(in) :: fieldInfo real(kind=RKIND_tiempo), intent(in) :: simTime type(problem_info_t), intent(in) :: problemInfo integer, intent(in) :: request + complex(kind=CKIND), dimension(this%nFreq) :: auxExponential integer :: i, j, k, coordIdx - this%timeStep(this%nTime) = simTime + if (iMHC == request) auxExponential = this%auxExp_H**simTime + if (iMEC == request) auxExponential = this%auxExp_E**simTime coordIdx = 0 do i = this%mainCoords%x, this%auxCoords%x @@ -214,9 +228,9 @@ subroutine save_field_module(this, field, simTime, request, problemInfo) do k = this%mainCoords%z, this%auxCoords%z if (isValidPointForField(request, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_field(this%xValueForFreq, this%nTime, coordIdx, field%x(i, j, k)) - call save_field(this%yValueForFreq, this%nTime, coordIdx, field%y(i, j, k)) - call save_field(this%zValueForFreq, this%nTime, coordIdx, field%z(i, j, k)) + call save_field(this%xValueForFreq, auxExponential, fieldInfo%x(i, j, k), this%nFreq, coordIdx) + call save_field(this%yValueForFreq, auxExponential, fieldInfo%y(i, j, k), this%nFreq, coordIdx) + call save_field(this%zValueForFreq, auxExponential, fieldInfo%z(i, j, k), this%nFreq, coordIdx) end if end do end do @@ -227,31 +241,41 @@ subroutine save_field_module(this, field, simTime, request, problemInfo) subroutine save_field_component(this, fieldData, fieldComponent, simTime, problemInfo, fieldDir) type(frequency_slice_probe_output_t), intent(inout) :: this complex(kind=CKIND), intent(inout) :: fieldData(:, :) - type(field_data_t), intent(in) :: fieldComponent(:, :, :) + real(kind=RKIND), intent(in) :: fieldComponent(:, :, :) real(kind=RKIND_tiempo), intent(in) :: simTime type(problem_info_t), intent(in) :: problemInfo integer, intent(in) :: fieldDir + complex(kind=CKIND), dimension(this%nFreq) :: auxExponential integer :: i, j, k, coordIdx + if (any(MAGNETIC_FIELD_DIRECTION == fieldDir)) auxExponential = this%auxExp_H**simTime + if (any(ELECTRIC_FIELD_DIRECTION == fieldDir)) auxExponential = this%auxExp_E**simTime + coordIdx = 0 do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y do k = this%mainCoords%z, this%auxCoords%z if (isValidPointForField(fieldDir, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_field(fieldData, timeIdx, coordIdx, fieldComponent(i, j, k)) + call save_field(fieldData, auxExponential, fieldComponent(i, j, k), this%nFreq, coordIdx) end if end do end do end do end subroutine - subroutine save_field(fieldData, timeIdx, coordIdx, fieldValue) - real(kind=RKIND), intent(inout) :: fieldData(:, :) - integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx - real(kind=RKIND), intent(in) :: fieldValue - fieldData(timeIdx, coordIdx) = fieldValue + subroutine save_field(valorComplex, auxExp, fieldValue, nFreq, coordIdx) + complex(kind=CKIND), intent(inout) :: valorComplex(:, :) + complex(kind=CKIND), intent(in) :: auxExp(:) + real(KIND=RKIND), intent(in) :: fieldValue + integer(KIND=SINGLE), intent(in) :: nFreq, coordIdx + + integer :: freq + + do freq = 1, nFreq + valorComplex = valorComplex(freq, coordIdx) + auxExp(freq)*fieldValue + end do end subroutine subroutine flush_frequency_slice_probe_output(this) @@ -259,7 +283,7 @@ subroutine flush_frequency_slice_probe_output(this) integer :: status, i do i = 1, this%nFreq - call update_pvd(this, i, this%PDVUnit) + call update_pvd(this, i, this%fileUnitFreq) end do end subroutine flush_frequency_slice_probe_output @@ -275,20 +299,13 @@ subroutine write_vtu_frequency_slice(this, freq, filename) type(vtk_file) :: vtkOutput integer :: ierr, npts, i real(kind=RKIND), allocatable :: x(:), y(:), z(:) - complex(kind=CKIND), allocatable :: Componentx(:), Componenty(:), Componentz(:) + real(kind=RKIND), allocatable :: Componentx(:), Componenty(:), Componentz(:) logical :: writeX, writeY, writeZ !================= Determine the measure type ================= - select case (this%component) - case (CURRENT_MEASURE) - requestName = 'Current' - case (ELECTRIC_FIELD_MEASURE) - requestName = 'Electric' - case (MAGNETIC_FIELD_MEASURE) - requestName = 'Magnetic' - case default - requestName = 'Unknown' - end select + if (any(CURRENT_MEASURE == this%component)) requestName = 'Current' + if (any(ELECTRIC_FIELD_MEASURE == this%component)) requestName = 'Electric' + if (any(MAGNETIC_FIELD_MEASURE == this%component)) requestName = 'Magnetic' !================= Determine which components to write ================= writeX = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_X_MEASURE == this%component) @@ -311,21 +328,21 @@ subroutine write_vtu_frequency_slice(this, freq, filename) if (writeX) then allocate (Componentx(npts)) do i = 1, npts - Componentx(i) = this%xValueForFreq(freq, i) + Componentx(i) = abs(this%xValueForFreq(freq, i)) end do end if if (writeY) then allocate (Componenty(npts)) do i = 1, npts - Componenty(i) = this%yValueForFreq(freq, i) + Componenty(i) = abs(this%yValueForFreq(freq, i)) end do end if if (writeZ) then allocate (Componentz(npts)) do i = 1, npts - Componentz(i) = this%zValueForFreq(freq, i) + Componentz(i) = abs(this%zValueForFreq(freq, i)) end do end if @@ -384,6 +401,7 @@ subroutine count_required_coords(this, problemInfo) type(problem_info_t), intent(in) :: problemInfo procedure(logical_func), pointer :: checker => null() ! Pointer to logical function + integer :: i, j, k integer :: component, count select case (this%component) case (iCur) @@ -432,73 +450,72 @@ subroutine count_required_coords(this, problemInfo) end do end do end do - end do this%nPoints = count - end subroutine + end subroutine - logical function isValidPointForCurrent(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - select case (request) - case (iCur) - isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) - case (iEx, iEy, iEz) - isValidPointForCurrent = componentCurrentRequest(request, i, j, k, problemInfo) - case default - isValidPointForCurrent = .false. - end select - end function + logical function isValidPointForCurrent(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t), intent(in) :: problemInfo + select case (request) + case (iCur) + isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz) + isValidPointForCurrent = componentCurrentRequest(request, i, j, k, problemInfo) + case default + isValidPointForCurrent = .false. + end select + end function - logical function isValidPointForField(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - select case (request) - case (iMEC) - isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) - case (iMHC) - isValidPointForField = volumicMagneticRequest(request, i, j, k, problemInfo) - case (iEx, iEy, iEz, iHx, iHy, iHz) - isValidPointForField = componentFieldRequest(request, i, j, k, problemInfo) - case default - isValidPointForField = .false. - end select - end function - - logical function volumicCurrentRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) & - .or. componentCurrentRequest(iEy, i, j, k, problemInfo) & - .or. componentCurrentRequest(iEz, i, j, k, problemInfo) - end function - logical function volumicElectricRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - volumicCurrentRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & - .or. componentFieldRequest(iEy, i, j, k, problemInfo) & - .or. componentFieldRequest(iEz, i, j, k, problemInfo) - end function - logical function volumicMagneticRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - volumicCurrentRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & - .or. componentFieldRequest(iHy, i, j, k, problemInfo) & - .or. componentFieldRequest(iHz, i, j, k, problemInfo) - end function - logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, fieldDir - type(problem_info_t) :: problemInfo - componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) - if (componentCurrentRequest) then - componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) & - .or. isThinWire(fieldDir, i, j, k, problemInfo) - end if - end function - logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, fieldDir - type(problem_info_t) :: problemInfo - componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) - end function - - end module mod_frequencySliceProbeOutput + logical function isValidPointForField(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t), intent(in) :: problemInfo + select case (request) + case (iMEC) + isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) + case (iMHC) + isValidPointForField = volumicMagneticRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz, iHx, iHy, iHz) + isValidPointForField = componentFieldRequest(request, i, j, k, problemInfo) + case default + isValidPointForField = .false. + end select + end function + + logical function volumicCurrentRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t), intent(in) :: problemInfo + volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) & + .or. componentCurrentRequest(iEy, i, j, k, problemInfo) & + .or. componentCurrentRequest(iEz, i, j, k, problemInfo) + end function + logical function volumicElectricRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t), intent(in) :: problemInfo + volumicElectricRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & + .or. componentFieldRequest(iEy, i, j, k, problemInfo) & + .or. componentFieldRequest(iEz, i, j, k, problemInfo) + end function + logical function volumicMagneticRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t), intent(in) :: problemInfo + volumicMagneticRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & + .or. componentFieldRequest(iHy, i, j, k, problemInfo) & + .or. componentFieldRequest(iHz, i, j, k, problemInfo) + end function + logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, fieldDir + type(problem_info_t), intent(in) :: problemInfo + componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) + if (componentCurrentRequest) then + componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) & + .or. isThinWire(fieldDir, i, j, k, problemInfo) + end if + end function + logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, fieldDir + type(problem_info_t), intent(in) :: problemInfo + componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) + end function + +end module mod_frequencySliceProbeOutput diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 03c8fece..77e66d0f 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -40,6 +40,14 @@ module mod_movieProbeOutput private :: componentFieldRequest !=========================== + abstract interface + logical function logical_func(component, i, j, k, problemInfo) + import :: problem_info_t + type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: component, i, j, k + end function logical_func + end interface + contains subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, control, problemInfo, outputTypeExtension) @@ -228,7 +236,7 @@ subroutine save_field_module(this, field, request, simTime, problemInfo) subroutine save_field_component(this, fieldData, fieldComponent, simTime, problemInfo, fieldDir) type(movie_probe_output_t), intent(inout) :: this real(kind=RKIND), intent(inout) :: fieldData(:, :) - type(field_data_t), intent(in) :: fieldComponent(:, :, :) + real(kind=RKIND), intent(in) :: fieldComponent(:, :, :) real(kind=RKIND_tiempo), intent(in) :: simTime type(problem_info_t), intent(in) :: problemInfo integer, intent(in) :: fieldDir @@ -395,7 +403,7 @@ subroutine count_required_coords(this, problemInfo) type(movie_probe_output_t), intent(inout) :: this type(problem_info_t), intent(in) :: problemInfo - integer :: i,j,k + integer :: i, j, k procedure(logical_func), pointer :: checker => null() ! Pointer to logical function integer :: component, count @@ -449,70 +457,70 @@ subroutine count_required_coords(this, problemInfo) this%nPoints = count - end subroutine + end subroutine - logical function isValidPointForCurrent(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - select case (request) - case (iCur) - isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) - case (iEx, iEy, iEz) - isValidPointForCurrent = componentCurrentRequest(request, i, j, k, problemInfo) - case default - isValidPointForCurrent = .false. - end select - end function + logical function isValidPointForCurrent(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + select case (request) + case (iCur) + isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz) + isValidPointForCurrent = componentCurrentRequest(request, i, j, k, problemInfo) + case default + isValidPointForCurrent = .false. + end select + end function - logical function isValidPointForField(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - select case (request) - case (iMEC) - isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) - case (iMHC) - isValidPointForField = volumicMagneticRequest(request, i, j, k, problemInfo) - case (iEx, iEy, iEz, iHx, iHy, iHz) - isValidPointForField = componentFieldRequest(request, i, j, k, problemInfo) - case default - isValidPointForField = .false. - end select - end function - - logical function volumicCurrentRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) & - .or. componentCurrentRequest(iEy, i, j, k, problemInfo) & - .or. componentCurrentRequest(iEz, i, j, k, problemInfo) - end function - logical function volumicElectricRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - volumicElectricRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & - .or. componentFieldRequest(iEy, i, j, k, problemInfo) & - .or. componentFieldRequest(iEz, i, j, k, problemInfo) - end function - logical function volumicMagneticRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo - volumicMagneticRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & - .or. componentFieldRequest(iHy, i, j, k, problemInfo) & - .or. componentFieldRequest(iHz, i, j, k, problemInfo) - end function - logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, fieldDir - type(problem_info_t) :: problemInfo - componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) - if (componentCurrentRequest) then - componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) & - .or. isThinWire(fieldDir, i, j, k, problemInfo) - end if - end function - logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, fieldDir - type(problem_info_t) :: problemInfo - componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) - end function - - end module mod_movieProbeOutput + logical function isValidPointForField(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t) :: problemInfo + select case (request) + case (iMEC) + isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) + case (iMHC) + isValidPointForField = volumicMagneticRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz, iHx, iHy, iHz) + isValidPointForField = componentFieldRequest(request, i, j, k, problemInfo) + case default + isValidPointForField = .false. + end select + end function + + logical function volumicCurrentRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t), intent(in) :: problemInfo + volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) & + .or. componentCurrentRequest(iEy, i, j, k, problemInfo) & + .or. componentCurrentRequest(iEz, i, j, k, problemInfo) + end function + logical function volumicElectricRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t), intent(in) :: problemInfo + volumicElectricRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & + .or. componentFieldRequest(iEy, i, j, k, problemInfo) & + .or. componentFieldRequest(iEz, i, j, k, problemInfo) + end function + logical function volumicMagneticRequest(request, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, request + type(problem_info_t), intent(in) :: problemInfo + volumicMagneticRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & + .or. componentFieldRequest(iHy, i, j, k, problemInfo) & + .or. componentFieldRequest(iHz, i, j, k, problemInfo) + end function + logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, fieldDir + type(problem_info_t), intent(in) :: problemInfo + componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) + if (componentCurrentRequest) then + componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) & + .or. isThinWire(fieldDir, i, j, k, problemInfo) + end if + end function + logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) + integer, intent(in) :: i, j, k, fieldDir + type(problem_info_t), intent(in) :: problemInfo + componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) + end function + +end module mod_movieProbeOutput diff --git a/src_output/output.F90 b/src_output/output.F90 index d6eb55fc..4a2535fe 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -6,7 +6,6 @@ module output use mod_pointProbeOutput use mod_wireProbeOutput use mod_bulkProbeOutput - use mod_volumicProbeOutput use mod_movieProbeOutput use mod_frequencySliceProbeOutput use mod_farFieldOutput @@ -396,8 +395,9 @@ subroutine close_outputs() case (BULK_PROBE_ID) case (VOLUMIC_CURRENT_PROBE_ID) case (MOVIE_PROBE_ID) - call close_pvd(outputs(i)%movieProbe%PDVUnit) + call close_pvd(outputs(i)%movieProbe%fileUnitTime) case (FREQUENCY_SLICE_PROBE_ID) + call close_pvd(outputs(i)%frequencySliceProbe%fileUnitFreq) end select end do end subroutine diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index a3607c55..3d5886a4 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -62,9 +62,9 @@ module mod_outputUtils contains subroutine alloc_and_init_time_1D(array, n1, initVal) - integer(RKIND_tiempo), allocatable, intent(inout) :: array(:) + real(RKIND_tiempo), allocatable, intent(inout) :: array(:) integer, intent(IN) :: n1 - integer(RKIND_tiempo), intent(IN) :: initVal + real(RKIND_tiempo), intent(IN) :: initVal allocate (array(n1)) array = initVal From 8cb65f21e261200537f949ffad58ee11fe15d06b Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 8 Jan 2026 12:41:40 +0100 Subject: [PATCH 49/67] Disable eliminate unnecesary points. Update output calls --- src_output/farFieldProbeOutput.F90 | 13 +- src_output/output.F90 | 286 ++++++++++++++--------------- src_output/outputUtils.F90 | 1 + src_output/wireProbeOutput.F90 | 9 +- 4 files changed, 153 insertions(+), 156 deletions(-) diff --git a/src_output/farFieldProbeOutput.F90 b/src_output/farFieldProbeOutput.F90 index f9b76dc2..6556ebd4 100644 --- a/src_output/farFieldProbeOutput.F90 +++ b/src_output/farFieldProbeOutput.F90 @@ -15,7 +15,7 @@ module mod_farFieldOutput !=========================== contains - subroutine init_farField_probe_output(this, sgg, lowerBound, upperBound, field, domain, sphericRange, control, outputTypeExtension, fileNormalize, eps0, mu0, geometricMedia, SINPML_fullsize, bounds) + 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), intent(in) :: sgg @@ -23,11 +23,9 @@ subroutine init_farField_probe_output(this, sgg, lowerBound, upperBound, field, integer(kind=SINGLE), intent(in) :: field type(spheric_domain_t), intent(in) :: sphericRange type(sim_control_t), intent(in) :: control - type(media_matrices_t), intent(in) :: geometricMedia - type(limit_t), dimension(:), intent(in) :: SINPML_fullsize character(len=*), intent(in) :: fileNormalize, outputTypeExtension + type(problem_info_t), intent(in) :: problemInfo real(kind=RKIND), intent(in) :: mu0, eps0 - type(bounds_t), intent(in) :: bounds if (domain%domainType /= TIME_DOMAIN) call StopOnError(0, 0, "Unexpected domain type for farField probe") @@ -38,8 +36,9 @@ subroutine init_farField_probe_output(this, sgg, lowerBound, upperBound, field, this%fileUnitFreq = 2025 !Dummy unit for now call InitFarField(sgg, & - geometricMedia%sggMiEx,geometricMedia%sggMiEy,geometricMedia%sggMiEz,geometricMedia%sggMiHx,geometricMedia%sggMiHy,geometricMedia%sggMiHz, & - control%layoutnumber, control%size, bounds, control%resume, & + problemInfo%geometryToMaterialData%sggMiEx, problemInfo%geometryToMaterialData%sggMiEy, problemInfo%geometryToMaterialData%sggMiEz, & + problemInfo%geometryToMaterialData%sggMiHx, problemInfo%geometryToMaterialData%sggMiHy, problemInfo%geometryToMaterialData%sggMiHz, & + control%layoutnumber, control%size, problemInfo%simulationBounds, control%resume, & this%fileUnitFreq, this%path, & lowerBound%x, upperBound%x, & lowerBound%y, upperBound%y, & @@ -47,7 +46,7 @@ subroutine init_farField_probe_output(this, sgg, lowerBound, upperBound, field, domain%fstart, domain%fstop, domain%fstep, & sphericRange%phiStart, sphericRange%phiStop, sphericRange%phiStep, & sphericRange%thetaStart, sphericRange%thetaStop, sphericRange%thetaStep, & - fileNormalize, SINPML_fullsize, & + fileNormalize, problemInfo%problemDimension, & control%facesNF2FF, control%NF2FFDecim, & #ifdef CompileWithMPI output(ii)%item(i)%MPISubComm, output(ii)%item(i)%MPIRoot, & diff --git a/src_output/output.F90 b/src_output/output.F90 index 4a2535fe..c93b0503 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -45,7 +45,7 @@ module output REAL(KIND=RKIND), save :: eps0, mu0 REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu type(solver_output_t), pointer, dimension(:), save :: outputs - type(problem_info_t), save :: problemInfo + type(problem_info_t), save, target :: problemInfo interface init_solver_output module procedure & @@ -53,7 +53,6 @@ module output init_wire_current_probe_output, & init_wire_charge_probe_output, & init_bulk_probe_output, & - init_volumic_probe_output, & init_movie_probe_output, & init_frequency_slice_probe_output, & init_farField_probe_output @@ -73,7 +72,6 @@ module output update_wire_current_probe_output, & update_wire_charge_probe_output, & update_bulk_probe_output, & - update_volumic_probe_output, & update_movie_probe_output, & update_frequency_slice_probe_output, & update_farField_probe_output @@ -106,9 +104,9 @@ function GetProblemInfo() result(r) subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observationsExists, wiresExists) type(SGGFDTDINFO), intent(in) :: sgg - type(media_matrices_t), intent(in) :: media - type(limit_t), dimension(:), intent(in) :: SINPML_fullsize - type(bounds_t) :: bounds + type(media_matrices_t), target, intent(in) :: media + type(limit_t), dimension(:), target, intent(in) :: SINPML_fullsize + type(bounds_t), target :: bounds type(sim_control_t), intent(in) :: control logical, intent(inout) :: wiresExists logical, intent(out) :: observationsExists @@ -139,12 +137,12 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio InvEps(0:sgg%NumMedia - 1) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia - 1)%Epr) InvMu(0:sgg%NumMedia - 1) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia - 1)%Mur) - do ii = 1, sgg%NumberRequest - do i = 1, sgg%Observation(ii)%nP - call eliminate_unnecesary_observation_points(sgg%Observation(ii)%P(i), output(ii)%item(i), & - sgg%Sweep, sgg%SINPMLSweep, sgg%Observation(ii)%P(1)%ZI, sgg%Observation(ii)%P(1)%ZE, control%layoutnumber, control%size) - end do - end do + !do ii = 1, sgg%NumberRequest + !do i = 1, sgg%Observation(ii)%nP + ! call eliminate_unnecesary_observation_points(sgg%Observation(ii)%P(i), output(ii)%item(i), & + ! sgg%Sweep, sgg%SINPMLSweep, sgg%Observation(ii)%P(1)%ZI, sgg%Observation(ii)%P(1)%ZE, control%layoutnumber, control%size) + !end do + !end do do ii = 1, sgg%NumberRequest do i = 1, sgg%Observation(ii)%nP @@ -167,7 +165,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = POINT_PROBE_ID allocate (outputs(outputCount)%pointProbe) - call init_solver_output(outputs(outputCount)%pointProbe, lowerBound, outputRequestType, domain, outputTypeExtension, control, sgg%dt) + call init_solver_output(outputs(outputCount)%pointProbe, lowerBound, outputRequestType, domain, outputTypeExtension, control%mpidir, sgg%dt) call create_empty_files(outputs(outputCount)%pointProbe) case (iJx, iJy, iJz) if (wiresExists) then @@ -175,7 +173,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = WIRE_CURRENT_PROBE_ID allocate (outputs(outputCount)%wireCurrentProbe) - call init_solver_output(outputs(outputCount)%wireCurrentProbe, lowerBound, NODE, outputRequestType, domain, outputTypeExtension, control, problemInfo) + call init_solver_output(outputs(outputCount)%wireCurrentProbe, lowerBound, NODE, outputRequestType, domain, problemInfo%materialList, outputTypeExtension, control%mpidir, control%wiresflavor) call create_empty_files(outputs(outputCount)%wireCurrentProbe) end if @@ -184,7 +182,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = WIRE_CHARGE_PROBE_ID allocate (outputs(outputCount)%wireChargeProbe) - call init_solver_output(outputs(outputCount)%wireChargeProbe, lowerBound, NODE, outputRequestType, domain, outputTypeExtension, control) + call init_solver_output(outputs(outputCount)%wireChargeProbe, lowerBound, NODE, outputRequestType, domain, outputTypeExtension, control%mpidir, control%wiresflavor) call create_empty_files(outputs(outputCount)%wireChargeProbe) case (iBloqueJx, iBloqueJy, iBloqueJz, iBloqueMx, iBloqueMy, iBloqueMz) @@ -192,11 +190,11 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = BULK_PROBE_ID allocate (outputs(outputCount)%bulkCurrentProbe) - call init_solver_output(outputs(outputCount)%bulkCurrentProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control) + call init_solver_output(outputs(outputCount)%bulkCurrentProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control%mpidir) call create_empty_files(outputs(outputCount)%bulkCurrentProbe) !! call adjust_computation_range --- Required due to issues in mpi region edges - case (iCur, iMEC, iMHC, iCurX, iCurY, iCurZ, iExC, iEyC, iEyC, iHxC, iHyC, iHyC) + case (iCur, iMEC, iMHC, iCurX, iCurY, iCurZ, iExC, iEyC, iEzC, iHxC, iHyC, iHzC) call adjust_bound_range() if (domain%domainType == TIME_DOMAIN) then @@ -204,8 +202,8 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputCount = outputCount + 1 outputs(outputCount)%outputID = MOVIE_PROBE_ID allocate (outputs(outputCount)%movieProbe) - call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control, problemInfo) - call create_pvd(outputs(outputCount)%movieProbe%path, outputs(outputCount)%movieProbe%PDVUnit) + call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, control, problemInfo, outputTypeExtension) + call create_pvd(outputs(outputCount)%movieProbe%path, outputs(outputCount)%movieProbe%fileUnitTime) else if (domain%domainType == FREQUENCY_DOMAIN) then @@ -213,7 +211,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = FREQUENCY_SLICE_PROBE_ID allocate (outputs(outputCount)%frequencySliceProbe) call init_solver_output(outputs(outputCount)%frequencySliceProbe, lowerBound, upperBound, sgg%dt, outputRequestType, domain, outputTypeExtension, control, problemInfo) - call create_pvd(outputs(outputCount)%frequencySliceProbe%path, outputs(outputCount)%frequencySliceProbe%PDVUnit) + call create_pvd(outputs(outputCount)%frequencySliceProbe%path, outputs(outputCount)%frequencySliceProbe%fileUnitFreq) end if case (farfield) @@ -235,14 +233,14 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio subroutine adjust_bound_range() select case (outputRequestType) case (iExC, iEyC, iHzC, iMhC) - lowerBound%z = max(sgg%Sweep(fieldo(field, 'Z'))%ZI, sgg%observation(ii)%P(i)%ZI) - upperBound%z = min(sgg%Sweep(fieldo(field, 'Z'))%ZE - 1, sgg%observation(ii)%P(i)%ZE) + lowerBound%z = max(sgg%Sweep(fieldo(outputRequestType, 'Z'))%ZI, sgg%observation(ii)%P(i)%ZI) + upperBound%z = min(sgg%Sweep(fieldo(outputRequestType, 'Z'))%ZE - 1, sgg%observation(ii)%P(i)%ZE) case (iEzC, iHxC, iHyC, iMeC) - lowerBound%z = max(sgg%Sweep(fieldo(field, 'Z'))%ZI, sgg%observation(ii)%P(i)%ZI) - upperbound%z = min(sgg%Sweep(fieldo(field, 'Z'))%ZE, sgg%observation(ii)%P(i)%ZE) + lowerBound%z = max(sgg%Sweep(fieldo(outputRequestType, 'Z'))%ZI, sgg%observation(ii)%P(i)%ZI) + upperbound%z = min(sgg%Sweep(fieldo(outputRequestType, 'Z'))%ZE, sgg%observation(ii)%P(i)%ZE) case (iCur, iCurX, iCurY, iCurZ) - lowerBound%z = max(sgg%Sweep(fieldo(field, 'X'))%ZI, sgg%observation(ii)%P(i)%ZI) !ojo estaba sweep(iEz) para ser conservador...puede dar problemas!! 03/07/15 - upperbound%z = min(sgg%Sweep(fieldo(field, 'X'))%ZE, sgg%observation(ii)%P(i)%ZE) !ojo estaba sweep(iEz) para ser conservador...puede dar problemas!! 03/07/15 + lowerBound%z = max(sgg%Sweep(fieldo(outputRequestType, 'X'))%ZI, sgg%observation(ii)%P(i)%ZI) !ojo estaba sweep(iEz) para ser conservador...puede dar problemas!! 03/07/15 + upperbound%z = min(sgg%Sweep(fieldo(outputRequestType, 'X'))%ZE, sgg%observation(ii)%P(i)%ZE) !ojo estaba sweep(iEz) para ser conservador...puede dar problemas!! 03/07/15 end select end subroutine function preprocess_domain(observation, timeArray, simulationTimeStep, finalStepIndex) result(newDomain) @@ -330,21 +328,21 @@ subroutine update_outputs(control, discreteTimeArray, timeIndx, fieldsReference) do i = 1, size(outputs) select case (outputs(i)%outputID) case (POINT_PROBE_ID) - fieldComponent => get_field_component(outputs(i)%pointProbe%fieldComponent, fieldsReference) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos + fieldComponent => get_field_component(outputs(i)%pointProbe%component, fieldsReference) !Cada componente requiere de valores deiferentes pero estos valores no se como conseguirlos call update_solver_output(outputs(i)%pointProbe, discreteTime, fieldComponent) case (WIRE_CURRENT_PROBE_ID) - call update_solver_output(outputs(i)%wireCurrentProbe, discreteTime, contorl, InvEps, InvMu) + call update_solver_output(outputs(i)%wireCurrentProbe, discreteTime, control, InvEps, InvMu) case (WIRE_CHARGE_PROBE_ID) call update_solver_output(outputs(i)%wireChargeProbe, discreteTime) case (BULK_PROBE_ID) - fieldReference = get_field_reference(outputs(i)%bulkCurrentProbe%fieldComponent, fieldsReference) + fieldReference = get_field_reference(outputs(i)%bulkCurrentProbe%component, fieldsReference) call update_solver_output(outputs(i)%bulkCurrentProbe, discreteTime, fieldReference) case (MOVIE_PROBE_ID) - call update_solver_output(outputs(i)%movieProbe, discreteTime, problemInfo, fieldsReference) + call update_solver_output(outputs(i)%movieProbe, discreteTime, fieldsReference, control, problemInfo) case (FREQUENCY_SLICE_PROBE_ID) - call update_solver_output(outputs(i)%frequencySliceProbe, discreteTime, problemInfo, fieldsReference) + call update_solver_output(outputs(i)%frequencySliceProbe, discreteTime, fieldsReference, control, problemInfo) case (FAR_FIELD_PROBE_ID) - call update_solver_output(outputs(i)%farFieldOutput, timeIndx, problemInfo, fieldsReference) + call update_solver_output(outputs(i)%farFieldOutput, timeIndx, problemInfo%simulationBounds, fieldsReference) case default call stoponerror(0, 0, 'Output update not implemented') end select @@ -436,117 +434,117 @@ function get_required_output_count(sgg) result(count) return end function - subroutine eliminate_unnecessary_observation_points(observation_probe, output_item, sweep, SINPMLSweep, ZI, ZE, layoutnumber, size) - type(item_t), intent(inout) :: output_item - type(observable_t), intent(inout) :: observation_probe - type(XYZlimit_t), dimension(1:6), intent(in) :: sweep, SINPMLSweep - integer(kind=4), intent(in) :: ZI, ZE, layoutnumber, size - integer(kind=4) :: field - - ! Initialize output_item trancos - output_item%Xtrancos = observation_probe%Xtrancos - output_item%Ytrancos = observation_probe%Ytrancos - output_item%Ztrancos = observation_probe%Ztrancos - - output_item%XItrancos = ceiling(real(observation_probe%XI)/real(output_item%Xtrancos)) - output_item%YItrancos = ceiling(real(observation_probe%YI)/real(output_item%Ytrancos)) - output_item%ZItrancos = ceiling(real(observation_probe%ZI)/real(output_item%Ztrancos)) - - output_item%XEtrancos = int(observation_probe%XE/output_item%Xtrancos) - output_item%YEtrancos = int(observation_probe%YE/output_item%Ytrancos) - output_item%ZEtrancos = int(observation_probe%ZE/output_item%Ztrancos) - -#ifdef CompileWithMPI - output_item%MPISubComm = -1 -#endif - - field = observation_probe%What - - select case (field) - case (iBloqueJx, iBloqueJy, iBloqueMx, iBloqueMy, iExC, iEyC, iHzC, iMhC, iEzC, iHxC, iHyC, iMeC) - call eliminate_observation_block(observation_probe, output_item, sweep, field, layoutnumber, size) - case (iEx, iVx, iEy, iVy, iHz, iBloqueMz, iJx, iJy, iQx, iQy) - call eliminate_observation_range(observation_probe, sweep, field, layoutnumber, size, lower_inclusive=.false.) - case (iEz, iVz, iJz, iQz, iBloqueJz, iHx, iHy) - call eliminate_observation_range(observation_probe, sweep, field, layoutnumber, size, lower_inclusive=.true.) - case (iCur, iCurX, iCurY, iCurZ, mapvtk) - call eliminate_observation_current(observation_probe, output_item, sweep, field, layoutnumber, size) - case (FarField) - call eliminate_observation_farfield(observation_probe, output_item, SINPMLSweep, ZI, ZE, layoutnumber, size) - end select - end subroutine - -! Generic subroutine for block observations - subroutine eliminate_observation_block(obs, out, sweep, field, layoutnumber, size) - type(observable_t), intent(inout) :: obs - type(item_t), intent(inout) :: out - type(XYZlimit_t), dimension(1:6), intent(in) :: sweep - integer, intent(in) :: field, layoutnumber, size - - call eliminate_observation_range_generic(obs, out, sweep(fieldo(field, 'Z'))%ZI, & - sweep(fieldo(field, 'Z'))%ZE, layoutnumber, size) - end subroutine - -! Generic Z-range check with optional inclusive lower bound - subroutine eliminate_observation_range(obs, sweep, field, layoutnumber, size, lower_inclusive) - type(observable_t), intent(inout) :: obs - type(XYZlimit_t), dimension(1:6), intent(in) :: sweep - integer, intent(in) :: field, layoutnumber, size - logical, intent(in) :: lower_inclusive - - if (lower_inclusive) then - if ((obs%ZI > sweep(fieldo(field, 'Z'))%ZE) .or. (obs%ZI < sweep(fieldo(field, 'Z'))%ZI)) obs%What = nothing - else - if ((obs%ZI >= sweep(fieldo(field,'Z'))%ZE) .and. (layoutnumber /= size-1) .or. (obs%ZI < sweep(fieldo(field,'Z'))%ZI)) obs%What = nothing - end if - end subroutine - -! Generic subroutine for currents - subroutine eliminate_observation_current(obs, out, sweep, field, layoutnumber, size) - type(observable_t), intent(inout) :: obs - type(item_t), intent(inout) :: out - type(XYZlimit_t), dimension(1:6), intent(in) :: sweep - integer, intent(in) :: field, layoutnumber, size - - call eliminate_observation_range_generic(obs, out, sweep(fieldo(field, 'Z'))%ZI, sweep(fieldo(field, 'Z'))%ZE, layoutnumber, size) - if ((field == iCur .or. field == iCurX .or. field == iCurY .or. field == mapvtk)) then - obs%ZE = min(obs%ZE, sweep(iHx)%ZE) - end if - end subroutine - -! Far field specialized - subroutine eliminate_observation_farfield(obs, out, sweep, ZI, ZE, layoutnumber, size) - type(observable_t), intent(inout) :: obs - type(item_t), intent(inout) :: out - type(XYZlimit_t), dimension(1:6), intent(in) :: sweep - integer(kind=4), intent(in) :: ZI, ZE, layoutnumber, size - - call eliminate_observation_range_generic(obs, out, sweep(iHz)%ZI, sweep(iHz)%ZE, layoutnumber, size, ZI, ZE) - end subroutine - -! The ultimate generic routine for MPI and Z-limits - subroutine eliminate_observation_range_generic(obs, out, Z_lower, Z_upper, layoutnumber, size, Zstart, Zend) - type(observable_t), intent(inout) :: obs - type(item_t), intent(inout) :: out - integer, intent(in) :: Z_lower, Z_upper, layoutnumber, size - integer, optional, intent(in) :: Zstart, Zend - - integer :: zi_local, ze_local - zi_local = merge(Zstart, obs%ZI, present(Zstart)) - ze_local = merge(Zend, obs%ZE, present(Zend)) - - if ((zi_local > Z_upper) .or. (ze_local < Z_lower)) then - obs%What = nothing -#ifdef CompileWithMPI - out%MPISubComm = -1 - else - out%MPISubComm = 1 - end if - out%MPIRoot = 0 - if ((obs%ZI >= Z_lower) .and. (obs%ZI <= Z_upper)) out%MPIRoot = layoutnumber - call MPIinitSubcomm(layoutnumber, size, out%MPISubComm, out%MPIRoot, out%MPIGroupIndex) -#endif - end if - end subroutine +! subroutine eliminate_unnecessary_observation_points(observation_probe, output_item, sweep, SINPMLSweep, ZI, ZE, layoutnumber, size) +! type(item_t), intent(inout) :: output_item +! type(observable_t), intent(inout) :: observation_probe +! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep, SINPMLSweep +! integer(kind=4), intent(in) :: ZI, ZE, layoutnumber, size +! integer(kind=4) :: field +! +! ! Initialize output_item trancos +! output_item%Xtrancos = observation_probe%Xtrancos +! output_item%Ytrancos = observation_probe%Ytrancos +! output_item%Ztrancos = observation_probe%Ztrancos +! +! output_item%XItrancos = ceiling(real(observation_probe%XI)/real(output_item%Xtrancos)) +! output_item%YItrancos = ceiling(real(observation_probe%YI)/real(output_item%Ytrancos)) +! output_item%ZItrancos = ceiling(real(observation_probe%ZI)/real(output_item%Ztrancos)) +! +! output_item%XEtrancos = int(observation_probe%XE/output_item%Xtrancos) +! output_item%YEtrancos = int(observation_probe%YE/output_item%Ytrancos) +! output_item%ZEtrancos = int(observation_probe%ZE/output_item%Ztrancos) +! +!#ifdef CompileWithMPI +! output_item%MPISubComm = -1 +!#endif +! +! field = observation_probe%What +! +! select case (field) +! case (iBloqueJx, iBloqueJy, iBloqueMx, iBloqueMy, iExC, iEyC, iHzC, iMhC, iEzC, iHxC, iHyC, iMeC) +! call eliminate_observation_block(observation_probe, output_item, sweep, field, layoutnumber, size) +! case (iEx, iVx, iEy, iVy, iHz, iBloqueMz, iJx, iJy, iQx, iQy) +! call eliminate_observation_range(observation_probe, sweep, field, layoutnumber, size, lower_inclusive=.false.) +! case (iEz, iVz, iJz, iQz, iBloqueJz, iHx, iHy) +! call eliminate_observation_range(observation_probe, sweep, field, layoutnumber, size, lower_inclusive=.true.) +! case (iCur, iCurX, iCurY, iCurZ, mapvtk) +! call eliminate_observation_current(observation_probe, output_item, sweep, field, layoutnumber, size) +! case (FarField) +! call eliminate_observation_farfield(observation_probe, output_item, SINPMLSweep, ZI, ZE, layoutnumber, size) +! end select +! end subroutine +! +!! Generic subroutine for block observations +! subroutine eliminate_observation_block(obs, out, sweep, field, layoutnumber, size) +! type(observable_t), intent(inout) :: obs +! type(item_t), intent(inout) :: out +! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep +! integer, intent(in) :: field, layoutnumber, size +! +! call eliminate_observation_range_generic(obs, out, sweep(fieldo(field, 'Z'))%ZI, & +! sweep(fieldo(field, 'Z'))%ZE, layoutnumber, size) +! end subroutine +! +!! Generic Z-range check with optional inclusive lower bound +! subroutine eliminate_observation_range(obs, sweep, field, layoutnumber, size, lower_inclusive) +! type(observable_t), intent(inout) :: obs +! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep +! integer, intent(in) :: field, layoutnumber, size +! logical, intent(in) :: lower_inclusive +! +! if (lower_inclusive) then +! if ((obs%ZI > sweep(fieldo(field, 'Z'))%ZE) .or. (obs%ZI < sweep(fieldo(field, 'Z'))%ZI)) obs%What = nothing +! else +! if ((obs%ZI >= sweep(fieldo(field,'Z'))%ZE) .and. (layoutnumber /= size-1) .or. (obs%ZI < sweep(fieldo(field,'Z'))%ZI)) obs%What = nothing +! end if +! end subroutine +! +!! Generic subroutine for currents +! subroutine eliminate_observation_current(obs, out, sweep, field, layoutnumber, size) +! type(observable_t), intent(inout) :: obs +! type(item_t), intent(inout) :: out +! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep +! integer, intent(in) :: field, layoutnumber, size +! +! call eliminate_observation_range_generic(obs, out, sweep(fieldo(field, 'Z'))%ZI, sweep(fieldo(field, 'Z'))%ZE, layoutnumber, size) +! if ((field == iCur .or. field == iCurX .or. field == iCurY .or. field == mapvtk)) then +! obs%ZE = min(obs%ZE, sweep(iHx)%ZE) +! end if +! end subroutine +! +!! Far field specialized +! subroutine eliminate_observation_farfield(obs, out, sweep, ZI, ZE, layoutnumber, size) +! type(observable_t), intent(inout) :: obs +! type(item_t), intent(inout) :: out +! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep +! integer(kind=4), intent(in) :: ZI, ZE, layoutnumber, size +! +! call eliminate_observation_range_generic(obs, out, sweep(iHz)%ZI, sweep(iHz)%ZE, layoutnumber, size, ZI, ZE) +! end subroutine +! +!! The ultimate generic routine for MPI and Z-limits +! subroutine eliminate_observation_range_generic(obs, out, Z_lower, Z_upper, layoutnumber, size, Zstart, Zend) +! type(observable_t), intent(inout) :: obs +! type(item_t), intent(inout) :: out +! integer, intent(in) :: Z_lower, Z_upper, layoutnumber, size +! integer, optional, intent(in) :: Zstart, Zend +! +! integer :: zi_local, ze_local +! zi_local = merge(Zstart, obs%ZI, present(Zstart)) +! ze_local = merge(Zend, obs%ZE, present(Zend)) +! +! if ((zi_local > Z_upper) .or. (ze_local < Z_lower)) then +! obs%What = nothing +!#ifdef CompileWithMPI +! out%MPISubComm = -1 +! else +! out%MPISubComm = 1 +! end if +! out%MPIRoot = 0 +! if ((obs%ZI >= Z_lower) .and. (obs%ZI <= Z_upper)) out%MPIRoot = layoutnumber +! call MPIinitSubcomm(layoutnumber, size, out%MPISubComm, out%MPIRoot, out%MPIGroupIndex) +!#endif +! end if +! end subroutine end module output diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 3d5886a4..c46978aa 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -31,6 +31,7 @@ module mod_outputUtils public :: computeJ1 public :: computeJ2 public :: alloc_and_init + public :: fieldo !=========================== !=========================== diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index 92ba331e..6cb9a4f0 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -296,11 +296,10 @@ subroutine create_wire_charge_probe_output(this) call create_or_clear_file(file_time, this%fileUnitTime, err) end subroutine create_wire_charge_probe_output - subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank, InvEps, InvMu) + subroutine update_wire_current_probe_output(this, step, control, InvEps, InvMu) type(wire_current_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step - character(len=*), intent(in) :: wiresflavor - logical, intent(in) :: wirecrank + type(sim_control_t), intent(in) :: control real(KIND=RKIND), pointer, dimension(:), intent(in) :: InvEps, InvMu type(CurrentSegments), pointer :: segmDumm @@ -311,7 +310,7 @@ subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank, class(Segment), pointer :: segmDumm_Slanted #endif - select case (trim(adjustl(wiresflavor))) + select case (trim(adjustl(control%wiresflavor))) case ('holland', 'transition') this%nTime = this%nTime + 1 this%timeStep(this%nTime) = step @@ -320,7 +319,7 @@ subroutine update_wire_current_probe_output(this, step, wiresflavor, wirecrank, this%currentValues(this%nTime)%current = this%sign*SegmDumm%currentpast this%currentValues(this%nTime)%deltaVoltage = -SegmDumm%Efield_wire2main*SegmDumm%delta - if (wirecrank) then + if (control%wirecrank) then this%currentValues(this%nTime)%plusVoltage = this%sign* & (((SegmDumm%ChargePlus%ChargePresent)))*SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) this%currentValues(this%nTime)%minusVoltage = this%sign* & From e7cbc1b0e802e3b4b9e399b734e0ef0c82611d48 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 9 Jan 2026 11:23:53 +0100 Subject: [PATCH 50/67] Adjust test to reduce argument inputs for init, update and flush --- CMakeLists.txt | 1 - src_main_pub/timestepping.F90 | 2 +- src_output/CMakeLists.txt | 1 - src_output/frequencySliceProbeOutput.F90 | 2 + src_output/movieProbeOutput.F90 | 21 +- src_output/outputTypes.F90 | 6 +- src_output/pointProbeOutput.F90 | 6 +- test/output/output_tests.h | 2 + test/output/test_output.F90 | 497 ++++++++++++----------- test/output/test_output_utils.F90 | 12 +- test/utils/assertion_tools.F90 | 11 + 11 files changed, 310 insertions(+), 251 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index bda25379..5f604766 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -197,7 +197,6 @@ if (SEMBA_FDTD_ENABLE_TEST) add_subdirectory(external/googletest/) add_subdirectory(test) endif() - add_subdirectory(src_output) if(SEMBA_FDTD_COMPONENTS_LIB) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 85dc88cf..930d46ff 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -2051,7 +2051,7 @@ subroutine updateAndFlush() integer(kind=4) :: mindum IF (this%thereAre%Observation) then #ifdef CompileWithNewOutputModule - call update_outputs(this%media, this%sgg%Med, this%sinPML_fullsize,this%control, this%sgg%tiempo, this%n + 1, fieldReference, this%bounds) + call update_outputs(this%control, this%sgg%tiempo, this%n + 1, fieldReference) if (this%n>=this%ini_save+BuffObse) then mindum=min(this%control%finaltimestep,this%ini_save+BuffObse) call FlushObservationFiles(this%sgg,this%ini_save,mindum,this%control%layoutnumber,this%control%size, dxe, dye, dze, dxh, dyh, dzh,this%bounds,this%control%singlefilewrite,this%control%facesNF2FF,.FALSE.) !no se flushean los farfields ahora diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index 4b65e041..9bfe1c5c 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -13,6 +13,5 @@ add_library(fdtd-output target_link_libraries(fdtd-output semba-types semba-components - semba-utils VTKFortran::VTKFortran ) \ No newline at end of file diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index e3427d53..833760f0 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -56,11 +56,13 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI this%path = get_output_path() this%nFreq = domain%fnum + call alloc_and_init(this%frequencySlice, this%nFreq, 0.0_RKIND) do i = 1, this%nFreq call init_frequency_slice(this%frequencySlice, this%domain) end do call count_required_coords(this, problemInfo) + call alloc_and_init(this%coords, 3, this%nPoints, 0_SINGLE) if (any(VOLUMIC_M_MEASURE == this%component)) then call alloc_and_init(this%xValueForFreq, this%nFreq, this%nPoints, (0.0_CKIND, 0.0_CKIND)) diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 77e66d0f..cd62f8ae 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -70,6 +70,7 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, call count_required_coords(this, problemInfo) call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) + call alloc_and_init(this%coords, 3, this%nPoints, 0_SINGLE) if (any(VOLUMIC_M_MEASURE == this%component)) then call alloc_and_init(this%xValueForTime, BuffObse, this%nPoints, 0.0_RKIND) @@ -279,10 +280,18 @@ subroutine flush_movie_probe_output(this) subroutine clear_memory_data() this%nTime = 0 this%timeStep = 0.0_RKIND - this%xValueForTime = 0.0_RKIND - this%yValueForTime = 0.0_RKIND - this%zValueForTime = 0.0_RKIND - end subroutine clear_memory_data + if (any(VOLUMIC_M_MEASURE==this%component)) then + this%xValueForTime = 0.0_RKIND + this%yValueForTime = 0.0_RKIND + this%zValueForTime = 0.0_RKIND + else if (any(VOLUMIC_X_MEASURE==this%component)) then + this%xValueForTime = 0.0_RKIND + else if (any(VOLUMIC_Y_MEASURE==this%component)) then + this%yValueForTime = 0.0_RKIND + else if (any(VOLUMIC_Z_MEASURE==this%component)) then + this%zValueForTime = 0.0_RKIND + end if + end subroutine clear_memory_data end subroutine flush_movie_probe_output @@ -341,14 +350,14 @@ subroutine write_vtu_timestep(this, stepIndex, filename) if (writeY) then allocate (Componenty(npts)) do i = 1, npts - Componenty(i) = this%xValueForTime(stepIndex, i) + Componenty(i) = this%yValueForTime(stepIndex, i) end do end if if (writeZ) then allocate (Componentz(npts)) do i = 1, npts - Componentz(i) = this%xValueForTime(stepIndex, i) + Componentz(i) = this%zValueForTime(stepIndex, i) end do end if diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 7e8e3dc9..e53a2bcc 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -90,20 +90,20 @@ module outputTypes type, extends(abstract_probe_t) :: abstract_time_probe_t integer(kind=SINGLE) :: fileUnitTime - integer(kind=SINGLE) :: nTime + integer(kind=SINGLE) :: nTime = 0_SINGLE real(kind=RKIND_tiempo), allocatable :: timeStep(:) end type abstract_time_probe_t type, extends(abstract_probe_t) :: abstract_frequency_probe_t integer(kind=SINGLE) :: fileUnitFreq - integer(kind=SINGLE) :: nFreq + integer(kind=SINGLE) :: nFreq = 0_SINGLE real(kind=RKIND), allocatable :: frequencySlice(:) complex(kind=CKIND), allocatable :: auxExp_E(:), auxExp_H(:) end type abstract_frequency_probe_t type, extends(abstract_probe_t) :: abstract_time_frequency_probe_t integer(kind=SINGLE) :: fileUnitTime, fileUnitFreq - integer(kind=SINGLE) :: nTime, nFreq + integer(kind=SINGLE) :: nTime = 0_SINGLE, nFreq = 0_SINGLE real(kind=RKIND_tiempo), allocatable :: timeStep(:) real(kind=RKIND), allocatable :: frequencySlice(:) complex(kind=CKIND), allocatable :: auxExp_E(:), auxExp_H(:) diff --git a/src_output/pointProbeOutput.F90 b/src_output/pointProbeOutput.F90 index 4954f8ef..f9f17014 100644 --- a/src_output/pointProbeOutput.F90 +++ b/src_output/pointProbeOutput.F90 @@ -25,10 +25,14 @@ subroutine init_point_probe_output(this, coordinates, field, domain, outputTypeE this%domain = domain this%path = get_output_path() + if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + call alloc_and_init(this%timeStep, BUFSIZE, 0.0_RKIND_tiempo) + call alloc_and_init(this%valueForTime, BUFSIZE, 0.0_RKIND) + end if if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then this%nFreq = this%domain%fnum allocate (this%frequencySlice(this%domain%fnum)) - allocate (this%valueForFreq(this%domain%fnum)) + call alloc_and_init(this%valueForFreq, this%domain%fnum, (0.0_CKIND, 0.0_CKIND)) do i = 1, this%nFreq call init_frequency_slice(this%frequencySlice, this%domain) end do diff --git a/test/output/output_tests.h b/test/output/output_tests.h index 2cb64766..ae51f836 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -10,6 +10,7 @@ extern "C" int test_update_movie_probe(); extern "C" int test_flush_movie_probe(); extern "C" int test_init_frequency_slice_probe(); extern "C" int test_update_frequency_slice_probe(); +extern "C" int test_flush_frequency_slice_probe(); TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe()); } @@ -22,4 +23,5 @@ TEST(output, test_update_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_upda TEST(output, test_flush_movie_probe_data) {EXPECT_EQ(0, test_flush_movie_probe()); } TEST(output, test_init_frequency_slice) {EXPECT_EQ(0, test_init_frequency_slice_probe()); } TEST(output, test_update_frequency_slice) {EXPECT_EQ(0, test_update_frequency_slice_probe()); } +TEST(output, test_flush_frequency_slice) {EXPECT_EQ(0, test_flush_frequency_slice_probe()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 3c700ca2..56da17b7 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -39,20 +39,19 @@ integer function test_init_point_probe() bind(c) result(err) call init_outputs(sgg, media, sinpml, bounds, control, outputRequested, hasWires) outputs => GetOutputs() + test_err = test_err + assert_true(outputRequested, 'Valid probes not found') test_err = test_err + assert_integer_equal(outputs(1)%outputID, POINT_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%pointProbe%columnas, 2, 'Unexpected number of columns') test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, & - 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') + 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') call close_outputs() - deallocate(sgg%Observation, outputs) + deallocate (sgg%Observation, outputs) err = test_err end function - - integer function test_update_point_probe() bind(c) result(err) use FDETYPES use FDETYPES_TOOLS @@ -112,16 +111,16 @@ integer function test_update_point_probe() bind(c) result(err) fields%H%deltaY => dummyFields%dyh fields%H%deltaZ => dummyFields%dzh - dummyFields%Ex(4,4,4) = 5.0_RKIND - call update_outputs(media, materialsPtr, sinpml, control, sgg%tiempo, 1_SINGLE, fields, bounds) + dummyFields%Ex(4, 4, 4) = 5.0_RKIND + call update_outputs(control, sgg%tiempo, 1_SINGLE, fields) outputs => GetOutputs() test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(1), 0.0_RKIND_tiempo, 1e-5_RKIND_tiempo, 'Unexpected timestep 1') test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(1), 5.0_RKIND, 1e-5_RKIND, 'Unexpected field 1') - dummyFields%Ex(4,4,4) = -4.0_RKIND - call update_outputs(media, materialsPtr, sinpml, control, sgg%tiempo, 2_SINGLE, fields, bounds) + dummyFields%Ex(4, 4, 4) = -4.0_RKIND + call update_outputs(control, sgg%tiempo, 2_SINGLE, fields) test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(2), 0.1_RKIND_tiempo, 1e-5_RKIND_tiempo, 'Unexpected timestep 2') test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(2), -4.0_RKIND, 1e-5_RKIND, 'Unexpected field 2') @@ -152,8 +151,8 @@ integer function test_flush_point_probe() bind(c) result(err) test_extension = 'tmp_cases/flush_point_probe' domain = domain_t( & - 0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, & - 10.0_RKIND, 100.0_RKIND, 10, .false.) + 0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, & + 10.0_RKIND, 100.0_RKIND, 10, .false.) coordinates%x = 2 coordinates%y = 2 @@ -165,14 +164,14 @@ integer function test_flush_point_probe() bind(c) result(err) n = 10 do i = 1, n - probe%timeStep(i) = real(i) - probe%valueForTime(i) = 10.0 * i - probe%frequencySlice(i) = 0.1 * i - probe%valueForFreq(i) = 0.2 * i + probe%timeStep(i) = real(i) + probe%valueForTime(i) = 10.0*i + probe%frequencySlice(i) = 0.1*i + probe%valueForFreq(i) = 0.2*i end do - probe%serializedTimeSize = n - probe%nFreq = n + probe%nTime = n + probe%nFreq = n file_time = trim(adjustl(probe%path))//'_'// & trim(adjustl(timeExtension))//'_'// & @@ -188,8 +187,8 @@ integer function test_flush_point_probe() bind(c) result(err) test_err = test_err + assert_written_output_file(file_freq) test_err = test_err + assert_integer_equal( & - probe%serializedTimeSize, 0, & - 'ERROR: clear_time_data did not reset serializedTimeSize!') + probe%nTime, 0, & + 'ERROR: clear_time_data did not reset serializedTimeSize!') if (.not. all(probe%timeStep == 0.0) .or. & .not. all(probe%valueForTime == 0.0)) then @@ -205,7 +204,6 @@ integer function test_flush_point_probe() bind(c) result(err) err = test_err end function test_flush_point_probe - integer function test_multiple_flush_point_probe() bind(c) result(err) use output use mod_pointProbeOutput @@ -230,8 +228,8 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) test_extension = 'tmp_cases/multiple_flush_point_probe' domain = domain_t( & - 0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, & - 10.0_RKIND, 100.0_RKIND, 10, .false.) + 0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, & + 10.0_RKIND, 100.0_RKIND, 10, .false.) coordinates%x = 2 coordinates%y = 2 @@ -254,36 +252,36 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) allocate (expectedFreq(n, 2)) do i = 1, n - probe%timeStep(i) = real(i) - probe%valueForTime(i) = 10.0 * i - probe%frequencySlice(i) = 0.1 * i - probe%valueForFreq(i) = 0.2 * i + probe%timeStep(i) = real(i) + probe%valueForTime(i) = 10.0*i + probe%frequencySlice(i) = 0.1*i + probe%valueForFreq(i) = 0.2*i expectedTime(i, 1) = real(i) - expectedTime(i, 2) = 10.0 * i + expectedTime(i, 2) = 10.0*i - expectedFreq(i, 1) = 0.1 * i - expectedFreq(i, 2) = 0.2 * i + expectedFreq(i, 1) = 0.1*i + expectedFreq(i, 2) = 0.2*i end do - probe%serializedTimeSize = n - probe%nFreq = n + probe%nTime = n + probe%nFreq = n call flush_point_probe_output(probe) do i = 1, n - probe%timeStep(i) = real(i + 10) - probe%valueForTime(i) = 10.0 * (i + 10) - probe%valueForFreq(i) = -0.5 * i + probe%timeStep(i) = real(i + 10) + probe%valueForTime(i) = 10.0*(i + 10) + probe%valueForFreq(i) = -0.5*i expectedTime(i + n, 1) = real(i + 10) - expectedTime(i + n, 2) = 10.0 * (i + 10) + expectedTime(i + n, 2) = 10.0*(i + 10) - expectedFreq(i, 1) = 0.1 * i - expectedFreq(i, 2) = -0.5 * i + expectedFreq(i, 1) = 0.1*i + expectedFreq(i, 2) = -0.5*i end do - probe%serializedTimeSize = n + probe%nTime = n call flush_point_probe_output(probe) @@ -298,90 +296,89 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) err = test_err end function test_multiple_flush_point_probe - integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err) - use output - use mod_testOutputUtils - use FDETYPES_TOOLS - use mod_sggMethods - use mod_assertionTools - - type(SGGFDTDINFO) :: dummysgg - type(sim_control_t) :: dummyControl - type(bounds_t) :: dummyBound - type(solver_output_t), pointer :: outputs(:) - - type(media_matrices_t), target :: media - type(media_matrices_t), pointer :: mediaPtr - - type(MediaData_t), allocatable, target :: simulationMaterials(:) - type(MediaData_t), pointer :: simulationMaterialsPtr(:) - type(MediaData_t) :: thinWireSimulationMaterial - - type(limit_t), target :: sinpml_fullsize(6) - type(limit_t), pointer :: sinpml_fullsizePtr(:) - - type(Obses_t) :: volumicProbeObservable - - real(kind=RKIND_tiempo), pointer :: timeArray(:) - real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo - integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE - - integer(kind=RKIND) :: iter - integer(kind=SINGLE) :: mpidir = 3 - logical :: ThereAreWires = .false. - logical :: outputRequested - integer(kind=SINGLE) :: test_err = 0 - - err = 1 - - call sgg_init(dummysgg) - call init_time_array(timeArray, nTimeSteps, dt) - call sgg_set_tiempo(dummysgg, timeArray) - call sgg_set_dt(dummysgg, dt) - - do iter = 1, 6 - sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) - end do - sinpml_fullsizePtr => sinpml_fullsize - - call init_simulation_material_list(simulationMaterials) - - thinWireSimulationMaterial = create_thinWire_simulation_material(size(simulationMaterials)) - call add_simulation_material(simulationMaterials, thinWireSimulationMaterial) - - simulationMaterialsPtr => simulationMaterials - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) - call sgg_set_Med(dummysgg, simulationMaterialsPtr) - - call create_geometry_media(media, 0, 8, 0, 8, 0, 8) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 1, 1, 1, simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iHz, 1, 1, 1, simulationMaterials(2)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iEx, 2, 2, 2, thinWireSimulationMaterial%Id) - mediaPtr => media - - volumicProbeObservable = create_volumic_probe_observation(4, 4, 4, 6, 6, 6) - call sgg_add_observation(dummysgg, volumicProbeObservable) - - dummyControl = create_control_flags(mpidir=mpidir, nEntradaRoot='entradaRoot', wiresflavor='holland') - - call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & - outputRequested, ThereAreWires) - - outputs => GetOutputs() - - test_err = test_err + assert_integer_equal(outputs(1)%outputID, & - VOLUMIC_CURRENT_PROBE_ID, 'Unexpected probe id') - - test_err = test_err + assert_integer_equal(outputs(1)%volumicCurrentProbe%columnas, & - 4, 'Unexpected number of columns') - - test_err = test_err + assert_string_equal(outputs(1)%volumicCurrentProbe%path, & - 'entradaRoot_volumicProbe_BCX_4_4_4__6_6_6', 'Unexpected path') - - call close_outputs() - - err = test_err +! use output +! use mod_testOutputUtils +! use FDETYPES_TOOLS +! use mod_sggMethods +! use mod_assertionTools +! +! type(SGGFDTDINFO) :: dummysgg +! type(sim_control_t) :: dummyControl +! type(bounds_t) :: dummyBound +! type(solver_output_t), pointer :: outputs(:) +! +! type(media_matrices_t), target :: media +! type(media_matrices_t), pointer :: mediaPtr +! +! type(MediaData_t), allocatable, target :: simulationMaterials(:) +! type(MediaData_t), pointer :: simulationMaterialsPtr(:) +! type(MediaData_t) :: thinWireSimulationMaterial +! +! type(limit_t), target :: sinpml_fullsize(6) +! type(limit_t), pointer :: sinpml_fullsizePtr(:) +! +! type(Obses_t) :: volumicProbeObservable +! +! real(kind=RKIND_tiempo), pointer :: timeArray(:) +! real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo +! integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE +! +! integer(kind=RKIND) :: iter +! integer(kind=SINGLE) :: mpidir = 3 +! logical :: ThereAreWires = .false. +! logical :: outputRequested +! integer(kind=SINGLE) :: test_err = 0 +! +! err = 1 +! +! call sgg_init(dummysgg) +! call init_time_array(timeArray, nTimeSteps, dt) +! call sgg_set_tiempo(dummysgg, timeArray) +! call sgg_set_dt(dummysgg, dt) +! +! do iter = 1, 6 +! sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) +! end do +! sinpml_fullsizePtr => sinpml_fullsize +! +! call init_simulation_material_list(simulationMaterials) +! +! thinWireSimulationMaterial = create_thinWire_simulation_material(size(simulationMaterials)) +! call add_simulation_material(simulationMaterials, thinWireSimulationMaterial) +! +! simulationMaterialsPtr => simulationMaterials +! call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) +! call sgg_set_Med(dummysgg, simulationMaterialsPtr) +! +! call create_geometry_media(media, 0, 8, 0, 8, 0, 8) +! call assing_material_id_to_media_matrix_coordinate(media, iEy, 1, 1, 1, simulationMaterials(0)%Id) +! call assing_material_id_to_media_matrix_coordinate(media, iHz, 1, 1, 1, simulationMaterials(2)%Id) +! call assing_material_id_to_media_matrix_coordinate(media, iEx, 2, 2, 2, thinWireSimulationMaterial%Id) +! mediaPtr => media +! +! volumicProbeObservable = create_volumic_probe_observation(4, 4, 4, 6, 6, 6) +! call sgg_add_observation(dummysgg, volumicProbeObservable) +! +! dummyControl = create_control_flags(mpidir=mpidir, nEntradaRoot='entradaRoot', wiresflavor='holland') +! +! call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & +! outputRequested, ThereAreWires) +! +! outputs => GetOutputs() +! +! test_err = test_err + assert_integer_equal(outputs(1)%outputID, & +! VOLUMIC_CURRENT_PROBE_ID, 'Unexpected probe id') +! +! test_err = test_err + assert_integer_equal(outputs(1)%volumicCurrentProbe%columnas, & +! 4, 'Unexpected number of columns') +! +! test_err = test_err + assert_string_equal(outputs(1)%volumicCurrentProbe%path, & +! 'entradaRoot_volumicProbe_BCX_4_4_4__6_6_6', 'Unexpected path') +! +! call close_outputs() +! +! err = test_err end function integer function test_init_movie_probe() bind(c) result(err) @@ -442,7 +439,7 @@ integer function test_init_movie_probe() bind(c) result(err) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) + movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, movieObservable) call create_geometry_media(media, 0, 8, 0, 8, 0, 8) @@ -467,27 +464,26 @@ integer function test_init_movie_probe() bind(c) result(err) outputs => GetOutputs() test_err = test_err + assert_integer_equal(outputs(1)%outputID, & - MOVIE_PROBE_ID, 'Unexpected probe id') + MOVIE_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, & - 4, 'Unexpected number of columns') + 4, 'Unexpected number of columns') - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nMeasuredElements, & - expectedNumMeasurments, 'Unexpected number of measurements') + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nPoints, & + expectedNumMeasurments, 'Unexpected number of measurements') test_err = test_err + assert_integer_equal( & - size(outputs(1)%movieProbe%xValueForTime), & - expectedNumMeasurments * BuffObse, 'Unexpected allocation size') + size(outputs(1)%movieProbe%xValueForTime), & + expectedNumMeasurments*BuffObse, 'Unexpected allocation size') test_err = test_err + assert_integer_equal( & - size(outputs(1)%movieProbe%timeStep), BuffObse, 'Unexpected timestep buffer size') + size(outputs(1)%movieProbe%timeStep), BuffObse, 'Unexpected timestep buffer size') call close_outputs() err = test_err end function - integer function test_update_movie_probe() bind(c) result(err) use output use outputTypes @@ -545,7 +541,7 @@ integer function test_update_movie_probe() bind(c) result(err) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) + movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, movieObservable) call create_geometry_media(media, 0, 8, 0, 8, 0, 8) @@ -589,43 +585,41 @@ integer function test_update_movie_probe() bind(c) result(err) dummyFields%Hy(3, 3, 3) = 5.0_RKIND dummyFields%Hz(3, 3, 3) = 4.0_RKIND - call update_outputs(mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, & - dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) + call update_outputs(dummyControl, dummysgg%tiempo, 1_SINGLE, fields) test_err = test_err + assert_integer_equal(outputs(1)%outputID, & - MOVIE_PROBE_ID, 'Unexpected probe id') + MOVIE_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, & - 4, 'Unexpected number of columns') + 4, 'Unexpected number of columns') - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nMeasuredElements, & - expectedNumMeasurments, 'Unexpected number of measurements') + test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nPoints, & + expectedNumMeasurments, 'Unexpected number of measurements') test_err = test_err + assert_integer_equal( & - size(outputs(1)%movieProbe%xValueForTime), & - expectedNumMeasurments * BuffObse, 'Unexpected allocation size') + size(outputs(1)%movieProbe%xValueForTime), & + expectedNumMeasurments*BuffObse, 'Unexpected allocation size') - test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1,1), & - 0.2_RKIND, 1e-5_RKIND, 'Value error') + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 1), & + 0.2_RKIND, 1e-5_RKIND, 'Value error') - test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1,2), & - 0.0_RKIND, 1e-5_RKIND, 'Value error') + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 2), & + 0.0_RKIND, 1e-5_RKIND, 'Value error') - test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1,3), & - 0.2_RKIND, 1e-5_RKIND, 'Value error') + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 3), & + 0.2_RKIND, 1e-5_RKIND, 'Value error') - test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1,4), & - 0.0_RKIND, 1e-5_RKIND, 'Value error') + test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 4), & + 0.0_RKIND, 1e-5_RKIND, 'Value error') test_err = test_err + assert_integer_equal( & - size(outputs(1)%movieProbe%timeStep), BuffObse, 'Unexpected timestep buffer size') + size(outputs(1)%movieProbe%timeStep), BuffObse, 'Unexpected timestep buffer size') call close_outputs() err = test_err end function - integer function test_flush_movie_probe() bind(c) result(err) use output use outputTypes @@ -648,7 +642,9 @@ integer function test_flush_movie_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) - type(Obses_t) :: movieObservable + type(Obses_t) :: movieCurrentObservable + type(Obses_t) :: movieElectricXObservable + type(Obses_t) :: movieMagneticYObservable type(fields_reference_t) :: fields real(kind=RKIND_tiempo), pointer :: timeArray(:) @@ -682,8 +678,14 @@ integer function test_flush_movie_probe() bind(c) result(err) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5) - call sgg_add_observation(dummysgg, movieObservable) + movieCurrentObservable = create_movie_observation(2, 2, 2, 5, 5, 5, iCur) + call sgg_add_observation(dummysgg, movieCurrentObservable) + + movieElectricXObservable = create_movie_observation(2, 2, 2, 5, 5, 5, iExC) + call sgg_add_observation(dummysgg, movieElectricXObservable) + + movieMagneticYObservable = create_movie_observation(2, 2, 2, 5, 5, 5, iHyC) + call sgg_add_observation(dummysgg, movieMagneticYObservable) call create_geometry_media(media, 0, 8, 0, 8, 0, 8) @@ -707,21 +709,52 @@ integer function test_flush_movie_probe() bind(c) result(err) outputs => GetOutputs() - outputs(1)%movieProbe%serializedTimeSize = 2 - + !--- Dummy first update --- + !movieCurrentObservable + outputs(1)%movieProbe%nTime = 1 outputs(1)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo - outputs(1)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo + outputs(1)%movieProbe%xValueForTime(1, :) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] + outputs(1)%movieProbe%yValueForTime(1, :) = [0.3_RKIND, 0.4_RKIND, 0.5_RKIND, 0.6_RKIND] + outputs(1)%movieProbe%zValueForTime(1, :) = [0.7_RKIND, 0.8_RKIND, 0.9_RKIND, 1.0_RKIND] + + !movieElectricXObservable + outputs(2)%movieProbe%nTime = 1 + outputs(2)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo + outputs(2)%movieProbe%xValueForTime(1, :) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] - outputs(1)%movieProbe%yValueForTime(1,:) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] - outputs(1)%movieProbe%yValueForTime(2,:) = [0.11_RKIND, 0.22_RKIND, 0.33_RKIND, 0.44_RKIND] + !movieMagneticYObservable + outputs(3)%movieProbe%nTime = 1 + outputs(3)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo + outputs(3)%movieProbe%yValueForTime(1, :) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] + + !--- Dummy second update --- + !movieCurrentObservable + outputs(1)%movieProbe%nTime = 2 + outputs(1)%movieProbe%timeStep(2) = 0.5_RKIND_tiempo + outputs(1)%movieProbe%xValueForTime(2, :) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] + outputs(1)%movieProbe%yValueForTime(2, :) = [0.3_RKIND, 0.4_RKIND, 0.5_RKIND, 0.6_RKIND] + outputs(1)%movieProbe%zValueForTime(2, :) = [0.7_RKIND, 0.8_RKIND, 0.9_RKIND, 1.0_RKIND] + + !movieElectricXObservable + outputs(2)%movieProbe%nTime = 2 + outputs(2)%movieProbe%timeStep(2) = 0.5_RKIND_tiempo + outputs(2)%movieProbe%xValueForTime(2, :) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] + + !movieMagneticYObservable + outputs(3)%movieProbe%nTime = 2 + outputs(3)%movieProbe%timeStep(2) = 0.5_RKIND_tiempo + outputs(3)%movieProbe%yValueForTime(2, :) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) - expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts0001.vtu' - test_err = test_err + assert_file_exists(expectedPath) + ! --- Assert file existance + do outputIdx = 1, 3 + expectedPath = trim(adjustl(outputs(outputIdx)%movieProbe%path))//'_ts0001.vtu' + test_err = test_err + assert_file_exists(expectedPath) - expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts0002.vtu' - test_err = test_err + assert_file_exists(expectedPath) + expectedPath = trim(adjustl(outputs(outputIdx)%movieProbe%path))//'_ts0002.vtu' + test_err = test_err + assert_file_exists(expectedPath) + end do call close_outputs() @@ -731,7 +764,6 @@ integer function test_flush_movie_probe() bind(c) result(err) err = test_err end function - integer function test_init_frequency_slice_probe() bind(c) result(err) use output use outputTypes @@ -788,7 +820,7 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5) + frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, frequencySliceObservation) expectedTotalFrequnecies = 6_SINGLE @@ -816,28 +848,27 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) outputs => GetOutputs() test_err = test_err + assert_integer_equal(outputs(1)%outputID, & - FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') + FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, & - 4, 'Unexpected number of columns') + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nFreq, & + 6, 'Unexpected number of frequencies') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nMeasuredElements, & - expectedNumMeasurments, 'Unexpected number of measurements') + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nPoints, & + expectedNumMeasurments, 'Unexpected number of measurements') test_err = test_err + assert_integer_equal( & - size(outputs(1)%frequencySliceProbe%xValueForFreq), & - expectedNumMeasurments * expectedTotalFrequnecies, 'Unexpected allocation size') + size(outputs(1)%frequencySliceProbe%xValueForFreq), & + expectedNumMeasurments*expectedTotalFrequnecies, 'Unexpected allocation size') test_err = test_err + assert_integer_equal( & - size(outputs(1)%frequencySliceProbe%frequencySlice), & - expectedTotalFrequnecies, 'Unexpected frequency count') + size(outputs(1)%frequencySliceProbe%frequencySlice), & + expectedTotalFrequnecies, 'Unexpected frequency count') call close_outputs() err = test_err end function - integer function test_update_frequency_slice_probe() bind(c) result(err) use output use outputTypes @@ -895,7 +926,7 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) call sgg_set_NumPlaneWaves(dummysgg, 1) call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5) + frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, frequencySliceObservation) call create_geometry_media(media, 0, 8, 0, 8, 0, 8) @@ -935,47 +966,42 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) fields%H%deltaY => dummyFields%dyh fields%H%deltaZ => dummyFields%dzh - dummyFields%Hx(3,3,3) = 2.0_RKIND - dummyFields%Hy(3,3,3) = 5.0_RKIND - dummyFields%Hz(3,3,3) = 4.0_RKIND + dummyFields%Hx(3, 3, 3) = 2.0_RKIND + dummyFields%Hy(3, 3, 3) = 5.0_RKIND + dummyFields%Hz(3, 3, 3) = 4.0_RKIND - call update_outputs(mediaPtr, simulationMaterialsPtr, sinpml_fullsizePtr, & - dummyControl, dummysgg%tiempo, 1_SINGLE, fields, dummyBound) + call update_outputs(dummyControl, dummysgg%tiempo, 1_SINGLE, fields) test_err = test_err + assert_integer_equal(outputs(1)%outputID, & - FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') + FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, & - 4, 'Unexpected number of columns') + 4, 'Unexpected number of columns') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nMeasuredElements, & - expectedNumMeasurments, 'Unexpected number of measurements') + test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nPoints, & + expectedNumMeasurments, 'Unexpected number of measurements') test_err = test_err + assert_integer_equal( & - size(outputs(1)%frequencySliceProbe%frequencySlice), & - expectedNumMeasurments * BuffObse, 'Unexpected allocation size') + size(outputs(1)%frequencySliceProbe%frequencySlice), & + expectedNumMeasurments*BuffObse, 'Unexpected allocation size') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,1), & - (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 1), & + (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,2), & - (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 2), & + (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,3), & - (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 3), & + (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,4), & - (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') - - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3,5), & - (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 4), & + (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') call close_outputs() err = test_err end function - integer function test_flush_frequency_slice_probe() bind(c) result(err) use output use outputTypes @@ -998,7 +1024,9 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) - type(Obses_t) :: frequencySliceObservable + type(Obses_t) :: frequencySliceCurrentObservable + type(Obses_t) :: frequencySliceElectricXObservable + type(Obses_t) :: frequencySliceMagneticHObservable type(fields_reference_t) :: fields type(dummyFields_t), target :: dummyFields @@ -1006,6 +1034,7 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: expectedNumFrequencies integer(kind=SINGLE) :: mpidir = 3 integer(kind=SINGLE) :: iter integer(kind=SINGLE) :: test_err = 0 @@ -1013,6 +1042,7 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) logical :: outputRequested character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' character(len=BUFSIZE) :: expectedPath + character(len=3) :: freqIdName err = 1 @@ -1027,31 +1057,33 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) call sgg_set_Med(dummysgg, simulationMaterialsPtr) - call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0,0,0,6,6,6)) - call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1,1,1,5,5,5)) + call sgg_set_Sweep(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + call sgg_set_SINPMLSweep(dummysgg, create_xyz_limit_array(1, 1, 1, 5, 5, 5)) call sgg_set_NumPlaneWaves(dummysgg, 1) - call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0,0,0,6,6,6)) + call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) - movieCurrentObservable = create_movie_observation(2,2,2,5,5,5, iCur) - call sgg_add_observation(dummysgg, movieCurrentObservable) + frequencySliceCurrentObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) + call sgg_add_observation(dummysgg, frequencySliceCurrentObservable) - movieElectricXObservable = create_movie_observation(2,2,2,5,5,5, iExC) - call sgg_add_observation(dummysgg, movieElectricXObservable) + frequencySliceElectricXObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iExC) + call sgg_add_observation(dummysgg, frequencySliceElectricXObservable) - movieMagneticYObservable = create_movie_observation(2,2,2,5,5,5, iHyC) - call sgg_add_observation(dummysgg, movieMagneticYObservable) + frequencySliceMagneticHObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iHyC) + call sgg_add_observation(dummysgg, frequencySliceMagneticHObservable) - call create_geometry_media(media, 0,8,0,8,0,8) - call assing_material_id_to_media_matrix_coordinate(media,iEy,3,3,3,simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media,iEy,4,3,3,simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media,iEy,4,4,3,simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media,iEy,3,4,3,simulationMaterials(0)%Id) + call create_geometry_media(media, 0, 8, 0, 8, 0, 8) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + expectedNumFrequencies = 6_SINGLE expectedNumMeasurments = 4_SINGLE + mediaPtr => media do iter = 1, 6 - sinpml_fullsize(iter) = create_limit_t(0,8,0,8,0,8,10,10,10) + sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) end do sinpml_fullsizePtr => sinpml_fullsize @@ -1061,33 +1093,34 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) outputRequested, ThereAreWires) outputs => GetOutputs() - !--- Dummy first update --- - outputs(1)%movieProbe%serializedTimeSize = 1 - outputs(1)%movieProbe%timeStep(1) = 0.5_RKIND_tiempo - outputs(1)%movieProbe%xValueForTime(1,:) = 0.0_RKIND - outputs(1)%movieProbe%yValueForTime(1,:) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] - outputs(1)%movieProbe%zValueForTime(1,:) = 0.0_RKIND - - - !--- Dummy second update --- - outputs(iOutput)%movieProbe%serializedTimeSize = 2 - outputs(iOutput)%movieProbe%timeStep(2) = 1.0_RKIND_tiempo - outputs(iOutput)%movieProbe%xValueForTime(2,:) = 0.0_RKIND - outputs(iOutput)%movieProbe%yValueForTime(2,:) = [0.11_RKIND,0.22_RKIND,0.33_RKIND,0.44_RKIND] - outputs(iOutput)%movieProbe%zValueForTime(2,:) = 0.0_RKIND + !--- Dummy update --- + !frequencySliceObservable + do freq = 1, expectedNumFrequencies + outputs(1)%frequencySliceProbe%xvalueForFreq(freq, :) = [(0.1_RKIND, 0.1_RKIND), (0.2_RKIND, 0.2_RKIND), (0.3_RKIND, 0.3_RKIND), (0.4_RKIND, 0.4_RKIND)] + outputs(1)%frequencySliceProbe%yvalueForFreq(freq, :) = [(0.5_RKIND, 0.5_RKIND), (0.6_RKIND, 0.6_RKIND), (0.7_RKIND, 0.7_RKIND), (0.8_RKIND, 0.8_RKIND)] + outputs(1)%frequencySliceProbe%zvalueForFreq(freq, :) = [(0.9_RKIND, 0.9_RKIND), (1.0_RKIND, 1.0_RKIND), (1.1_RKIND, 1.1_RKIND), (1.2_RKIND, 1.2_RKIND)] + end do + !frequencySliceXObservable + do freq = 1, expectedNumFrequencies + outputs(2)%frequencySliceProbe%xvalueForFreq(freq, :) = [(0.1_RKIND, 0.1_RKIND), (0.2_RKIND, 0.2_RKIND), (0.3_RKIND, 0.3_RKIND), (0.4_RKIND, 0.4_RKIND)] + end do + !frequencySliceYObservable + do freq = 1, expectedNumFrequencies + outputs(3)%frequencySliceProbe%yvalueForFreq(freq, :) = [(0.1_RKIND, 0.1_RKIND), (0.2_RKIND, 0.2_RKIND), (0.3_RKIND, 0.3_RKIND), (0.4_RKIND, 0.4_RKIND)] + end do call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) !--- Assert generated files --- - expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0001'//'.vtu' - test_err = test_err + assert_file_exists(expectedPath) - - expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'_ts'//'0002'//'.vtu' - test_err = test_err + assert_file_exists(expectedPath) + do iter = 1, expectedNumFrequencies + write(freqIdName, '(i3)') iter + expectedPath = trim(adjustl(outputs(1)%frequencySliceProbe%path))//'_fq'//'000'//trim(adjustl(freqIdName))//'.vtu' + test_err = test_err + assert_file_exists(expectedPath) + end do call close_outputs() - expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'.pvd' + expectedPath = trim(adjustl(outputs(1)%frequencySliceProbe%path))//'.pvd' test_err = test_err + assert_file_exists(expectedPath) err = test_err diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index f138dfc0..9e79798f 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -59,29 +59,29 @@ function create_volumic_probe_observation(xi, yi, zi, xe, ye, ze) result(obs) call set_observation(obs, P, 'volumicProbe', domain, 'DummyFileNormalize') end function create_volumic_probe_observation - function create_movie_observation(xi, yi, zi, xe, ye, ze) result(observation) - integer, intent(in) :: xi, yi, zi, xe, ye, ze + function create_movie_observation(xi, yi, zi, xe, ye, ze, request) result(observation) + integer, intent(in) :: xi, yi, zi, xe, ye, ze, request type(Obses_t) :: observation type(observable_t), dimension(:), allocatable :: P type(observation_domain_t) :: domain allocate (P(1)) - P(1) = create_observable(xi, yi, zi, xe, ye, ze, iCur) + P(1) = create_observable(xi, yi, zi, xe, ye, ze, request) call initialize_observation_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) call set_observation(observation, P, 'movieProbe', domain, 'DummyFileNormalize') end function create_movie_observation - function create_frequency_slice_observation(xi, yi, zi, xe, ye, ze) result(observation) - integer, intent(in) :: xi, yi, zi, xe, ye, ze + function create_frequency_slice_observation(xi, yi, zi, xe, ye, ze, request) result(observation) + integer, intent(in) :: xi, yi, zi, xe, ye, ze, request type(Obses_t) :: observation type(observable_t), dimension(:), allocatable :: P type(observation_domain_t) :: domain allocate (P(1)) - P(1) = create_observable(xi, yi, zi, xe, ye, ze, iCur) + P(1) = create_observable(xi, yi, zi, xe, ye, ze, request) call initialize_observation_frequency_domain(domain, 0.0_RKIND, 100.0_RKIND, 20.0_RKIND) call set_observation(observation, P, 'frequency_sliceProbe', domain, 'DummyFileNormalize') diff --git a/test/utils/assertion_tools.F90 b/test/utils/assertion_tools.F90 index 5b2b81f0..0d83461a 100644 --- a/test/utils/assertion_tools.F90 +++ b/test/utils/assertion_tools.F90 @@ -3,6 +3,17 @@ module mod_assertionTools implicit none contains + function assert_true(boolean, errorMessage) result(err) + logical, intent(in) :: boolean + character(*), intent(in) :: errorMessage + integer :: err + if (boolean) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function function assert_integer_equal(val, expected, errorMessage) result(err) integer, intent(in) :: val From ea96d5603cb6b48c109f6916fdf3d000a6e501ce Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 9 Jan 2026 14:10:46 +0100 Subject: [PATCH 51/67] Added test utils for array assertion and gradient creation --- test/output/test_output_utils.F90 | 48 ++++ test/utils/CMakeLists.txt | 1 + test/utils/array_assertion_tools.F90 | 337 +++++++++++++++++++++++++++ test/utils/assertion_tools.F90 | 55 ++--- 4 files changed, 414 insertions(+), 27 deletions(-) create mode 100644 test/utils/array_assertion_tools.F90 diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index 9e79798f..8a175874 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -14,6 +14,7 @@ module mod_testOutputUtils public :: create_movie_observation public :: create_frequency_slice_observation public :: create_dummy_fields + public :: fillGradient !=========================== !=========================== @@ -123,4 +124,51 @@ subroutine create_dummy_fields(this, lower, upper, delta) this%dze = delta end subroutine create_dummy_fields + subroutine fillGradient(dummyFields, direction, minVal, maxVal) + !-------------------------------------------- + ! Fills dummyFields%Hx, Hy, Hz with a linear gradient + ! along the specified direction (1=x, 2=y, 3=z) + !-------------------------------------------- + implicit none + type(dummyFields_t), intent(inout) :: dummyFields + integer, intent(in) :: direction ! 1=x, 2=y, 3=z + real(RKIND), intent(in) :: minVal, maxVal + + integer :: i, j, k + integer :: nx, ny, nz + real(RKIND) :: factor + + ! Get array sizes + nx = size(dummyFields%Hx, 1) + ny = size(dummyFields%Hx, 2) + nz = size(dummyFields%Hx, 3) + + select case (direction) + case (1) ! x-direction + do i = 1, nx + factor = real(i - 1, RKIND)/real(nx - 1, RKIND) + dummyFields%Hx(i, :, :) = minVal + factor*(maxVal - minVal) + dummyFields%Hy(i, :, :) = minVal + factor*(maxVal - minVal) + dummyFields%Hz(i, :, :) = minVal + factor*(maxVal - minVal) + end do + case (2) ! y-direction + do j = 1, ny + factor = real(j - 1, RKIND)/real(ny - 1, RKIND) + dummyFields%Hx(:, j, :) = minVal + factor*(maxVal - minVal) + dummyFields%Hy(:, j, :) = minVal + factor*(maxVal - minVal) + dummyFields%Hz(:, j, :) = minVal + factor*(maxVal - minVal) + end do + case (3) ! z-direction + do k = 1, nz + factor = real(k - 1, RKIND)/real(nz - 1, RKIND) + dummyFields%Hx(:, :, k) = minVal + factor*(maxVal - minVal) + dummyFields%Hy(:, :, k) = minVal + factor*(maxVal - minVal) + dummyFields%Hz(:, :, k) = minVal + factor*(maxVal - minVal) + end do + case default + print *, "Error: direction must be 1, 2, or 3." + end select + + end subroutine fillGradient + end module mod_testOutputUtils diff --git a/test/utils/CMakeLists.txt b/test/utils/CMakeLists.txt index 35608666..5e070429 100644 --- a/test/utils/CMakeLists.txt +++ b/test/utils/CMakeLists.txt @@ -4,6 +4,7 @@ add_library( test_utils_fortran "fdetypes_tools.F90" "assertion_tools.F90" + "array_assertion_tools.F90" "sgg_setters.F90" ) diff --git a/test/utils/array_assertion_tools.F90 b/test/utils/array_assertion_tools.F90 new file mode 100644 index 00000000..59092d04 --- /dev/null +++ b/test/utils/array_assertion_tools.F90 @@ -0,0 +1,337 @@ +module mod_arrayAssertionTools + use FDETYPES + implicit none + real(RKIND), parameter :: tol = 1.0e-12_RKIND + private + !----------------------------- + ! Public assertion procedures + !----------------------------- + public :: assert_arrays_equal + public :: assert_array_value + + !--------------------------------------- + ! GENERIC INTERFACES + !--------------------------------------- + interface assert_arrays_equal + module procedure & + assert_arrays_equal_int1, assert_arrays_equal_int2, assert_arrays_equal_int3, & + assert_arrays_equal_real1, assert_arrays_equal_real2, assert_arrays_equal_real3, & + assert_arrays_equal_complex1, assert_arrays_equal_complex2, assert_arrays_equal_complex3 + end interface + + interface assert_array_value + module procedure & + assert_array_value_int1, assert_array_value_int2, assert_array_value_int3, & + assert_array_value_real1, assert_array_value_real2, assert_array_value_real3, & + assert_array_value_complex1, assert_array_value_complex2, assert_array_value_complex3 + end interface + +contains + + !--------------------------------------- + ! 1D Integer arrays + !--------------------------------------- + integer function assert_arrays_equal_int1(A, B, errorMessage) + integer, intent(in) :: A(:), B(:) + character(*), intent(in), optional :: errorMessage + + if (any(shape(A) /= shape(B))) then + assert_arrays_equal_int1 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + return + end if + + if (all(A == B)) then + assert_arrays_equal_int1 = 0 + else + assert_arrays_equal_int1 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + integer function assert_array_value_int1(A, val, errorMessage) + integer, intent(in) :: A(:) + integer, intent(in) :: val + character(*), intent(in), optional :: errorMessage + + if (all(A == val)) then + assert_array_value_int1 = 0 + else + assert_array_value_int1 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + !--------------------------------------- + ! 2D Integer arrays + !--------------------------------------- + integer function assert_arrays_equal_int2(A, B, errorMessage) + integer, intent(in) :: A(:, :), B(:, :) + character(*), intent(in), optional :: errorMessage + + if (any(shape(A) /= shape(B))) then + assert_arrays_equal_int2 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + return + end if + + if (all(A == B)) then + assert_arrays_equal_int2 = 0 + else + assert_arrays_equal_int2 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + integer function assert_array_value_int2(A, val, errorMessage) + integer, intent(in) :: A(:, :) + integer, intent(in) :: val + character(*), intent(in), optional :: errorMessage + + if (all(A == val)) then + assert_array_value_int2 = 0 + else + assert_array_value_int2 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + !--------------------------------------- + ! 3D Integer arrays + !--------------------------------------- + integer function assert_arrays_equal_int3(A, B, errorMessage) + integer, intent(in) :: A(:, :, :), B(:, :, :) + character(*), intent(in), optional :: errorMessage + + if (any(shape(A) /= shape(B))) then + assert_arrays_equal_int3 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + return + end if + + if (all(A == B)) then + assert_arrays_equal_int3 = 0 + else + assert_arrays_equal_int3 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + integer function assert_array_value_int3(A, val, errorMessage) + integer, intent(in) :: A(:, :, :) + integer, intent(in) :: val + character(*), intent(in), optional :: errorMessage + + if (all(A == val)) then + assert_array_value_int3 = 0 + else + assert_array_value_int3 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + !--------------------------------------- + ! REAL arrays (1D, 2D, 3D) + !--------------------------------------- + integer function assert_arrays_equal_real1(A, B, errorMessage) + real(RKIND), intent(in) :: A(:), B(:) + character(*), intent(in), optional :: errorMessage + + if (any(shape(A) /= shape(B))) then + assert_arrays_equal_real1 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + return + end if + + if (all(abs(A - B) < tol)) then + assert_arrays_equal_real1 = 0 + else + assert_arrays_equal_real1 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + integer function assert_array_value_real1(A, val, errorMessage) + real(RKIND), intent(in) :: A(:) + real(RKIND), intent(in) :: val + character(*), intent(in), optional :: errorMessage + + if (all(abs(A - val) < tol)) then + assert_array_value_real1 = 0 + else + assert_array_value_real1 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + !--------------------------------------- + ! REAL 2D + !--------------------------------------- + integer function assert_arrays_equal_real2(A, B, errorMessage) + real(RKIND), intent(in) :: A(:, :), B(:, :) + character(*), intent(in), optional :: errorMessage + + if (any(shape(A) /= shape(B))) then + assert_arrays_equal_real2 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + return + end if + + if (all(abs(A - B) < tol)) then + assert_arrays_equal_real2 = 0 + else + assert_arrays_equal_real2 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + integer function assert_array_value_real2(A, val, errorMessage) + real(RKIND), intent(in) :: A(:, :) + real(RKIND), intent(in) :: val + character(*), intent(in), optional :: errorMessage + + if (all(abs(A - val) < tol)) then + assert_array_value_real2 = 0 + else + assert_array_value_real2 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + !--------------------------------------- + ! REAL 3D + !--------------------------------------- + integer function assert_arrays_equal_real3(A, B, errorMessage) + real(RKIND), intent(in) :: A(:, :, :), B(:, :, :) + character(*), intent(in), optional :: errorMessage + + if (any(shape(A) /= shape(B))) then + assert_arrays_equal_real3 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + return + end if + + if (all(abs(A - B) < tol)) then + assert_arrays_equal_real3 = 0 + else + assert_arrays_equal_real3 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + integer function assert_array_value_real3(A, val, errorMessage) + real(RKIND), intent(in) :: A(:, :, :) + real(RKIND), intent(in) :: val + character(*), intent(in), optional :: errorMessage + + if (all(abs(A - val) < tol)) then + assert_array_value_real3 = 0 + else + assert_array_value_real3 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + !--------------------------------------- + ! COMPLEX 1D arrays + !--------------------------------------- + integer function assert_arrays_equal_complex1(A, B, errorMessage) + complex(CKIND), intent(in) :: A(:), B(:) + character(*), intent(in), optional :: errorMessage + + if (any(shape(A) /= shape(B))) then + assert_arrays_equal_complex1 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + return + end if + + if (all(abs(A - B) < tol)) then + assert_arrays_equal_complex1 = 0 + else + assert_arrays_equal_complex1 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + integer function assert_array_value_complex1(A, val, errorMessage) + complex(CKIND), intent(in) :: A(:) + complex(CKIND), intent(in) :: val + character(*), intent(in), optional :: errorMessage + + if (all(abs(A - val) < tol)) then + assert_array_value_complex1 = 0 + else + assert_array_value_complex1 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + +!--------------------------------------- +! COMPLEX 2D arrays +!--------------------------------------- + integer function assert_arrays_equal_complex2(A, B, errorMessage) + complex(CKIND), intent(in) :: A(:, :), B(:, :) + character(*), intent(in), optional :: errorMessage + + if (any(shape(A) /= shape(B))) then + assert_arrays_equal_complex2 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + return + end if + + if (all(abs(A - B) < tol)) then + assert_arrays_equal_complex2 = 0 + else + assert_arrays_equal_complex2 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + integer function assert_array_value_complex2(A, val, errorMessage) + complex(CKIND), intent(in) :: A(:, :) + complex(CKIND), intent(in) :: val + character(*), intent(in), optional :: errorMessage + + if (all(abs(A - val) < tol)) then + assert_array_value_complex2 = 0 + else + assert_array_value_complex2 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + +!--------------------------------------- +! COMPLEX 3D arrays +!--------------------------------------- + integer function assert_arrays_equal_complex3(A, B, errorMessage) + complex(CKIND), intent(in) :: A(:, :, :), B(:, :, :) + character(*), intent(in), optional :: errorMessage + + if (any(shape(A) /= shape(B))) then + assert_arrays_equal_complex3 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + return + end if + + if (all(abs(A - B) < tol)) then + assert_arrays_equal_complex3 = 0 + else + assert_arrays_equal_complex3 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + + integer function assert_array_value_complex3(A, val, errorMessage) + complex(CKIND), intent(in) :: A(:, :, :) + complex(CKIND), intent(in) :: val + character(*), intent(in), optional :: errorMessage + + if (all(abs(A - val) < tol)) then + assert_array_value_complex3 = 0 + else + assert_array_value_complex3 = 1 + if (present(errorMessage)) print *, 'ASSERTION FAILED: ', trim(errorMessage) + end if + end function + +end module mod_arrayAssertionTools diff --git a/test/utils/assertion_tools.F90 b/test/utils/assertion_tools.F90 index 0d83461a..0d80eed9 100644 --- a/test/utils/assertion_tools.F90 +++ b/test/utils/assertion_tools.F90 @@ -1,20 +1,21 @@ module mod_assertionTools - use FDETYPES - implicit none - + use FDETYPES + use mod_arrayAssertionTools + implicit none + contains function assert_true(boolean, errorMessage) result(err) logical, intent(in) :: boolean character(*), intent(in) :: errorMessage integer :: err - if (boolean) then + if (boolean) then err = 0 else err = 1 print *, 'ASSERTION FAILED: ', trim(errorMessage) end if end function - function assert_integer_equal(val, expected, errorMessage) result(err) + function assert_integer_equal(val, expected, errorMessage) result(err) integer, intent(in) :: val integer, intent(in) :: expected @@ -30,7 +31,7 @@ function assert_integer_equal(val, expected, errorMessage) result(err) end if end function assert_integer_equal - function assert_real_equal(val, expected, tolerance, errorMessage) result(err) + function assert_real_equal(val, expected, tolerance, errorMessage) result(err) real(kind=rkind), intent(in) :: val real(kind=rkind), intent(in) :: expected @@ -64,23 +65,23 @@ function assert_real_time_equal(val, expected, tolerance, errorMessage) result(e end if end function assert_real_time_equal -function assert_complex_equal(val, expected, tolerance, errorMessage) result(err) - complex(kind=CKIND), intent(in) :: val, expected - real (kind=RKIND), intent(in) :: tolerance - character(len=*), intent(in) :: errorMessage - integer :: err - - if (abs(val - expected) <= tolerance) then - err = 0 - else - err = 1 - print *, 'ASSERTION FAILED: ', trim(errorMessage) - print *, ' Value: ', val - print *, ' Expected: ', expected - print *, ' Delta: ', abs(val - expected) - print *, ' Tolerance:', tolerance - end if -end function assert_complex_equal + function assert_complex_equal(val, expected, tolerance, errorMessage) result(err) + complex(kind=CKIND), intent(in) :: val, expected + real(kind=RKIND), intent(in) :: tolerance + character(len=*), intent(in) :: errorMessage + integer :: err + + if (abs(val - expected) <= tolerance) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED: ', trim(errorMessage) + print *, ' Value: ', val + print *, ' Expected: ', expected + print *, ' Delta: ', abs(val - expected) + print *, ' Tolerance:', tolerance + end if + end function assert_complex_equal function assert_string_equal(val, expected, errorMessage) result(err) @@ -151,8 +152,8 @@ integer function assert_file_exists(fileName) result(err) character(len=*), intent(in) :: filename integer :: unit, ios err = 0 - open(newunit=unit, file=filename, status='old', iostat=ios) - close(unit) - if (ios/=0) err = 1 + open (newunit=unit, file=filename, status='old', iostat=ios) + close (unit) + if (ios /= 0) err = 1 end function -end module mod_assertionTools \ No newline at end of file +end module mod_assertionTools From f9b62c9a1ac56555e7799a5e6bf56bd5314a809d Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 9 Jan 2026 14:10:59 +0100 Subject: [PATCH 52/67] Fix errors on volumic rprobe tests --- src_output/frequencySliceProbeOutput.F90 | 2 +- src_output/movieProbeOutput.F90 | 81 ++++++++++++++++++------ src_output/pointProbeOutput.F90 | 2 +- test/output/test_output.F90 | 78 +++++++++-------------- 4 files changed, 94 insertions(+), 69 deletions(-) diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index 833760f0..c5d331ee 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -207,7 +207,7 @@ subroutine save_current(valorComplex, direction, coordIdx, i, j, k, fieldsRefere jdir = computej(direction, i, j, k, fieldsReference) do iter = 1, nFreq - valorComplex(i, coordIdx) = valorComplex(i, coordIdx) + (auxExponential(i)**step)*jdir + valorComplex(iter, coordIdx) = valorComplex(iter, coordIdx) + (auxExponential(iter)**step)*jdir end do end subroutine diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index cd62f8ae..7bd9f164 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -67,10 +67,9 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, this%domain = domain this%path = get_output_path() - call count_required_coords(this, problemInfo) + call find_and_store_important_coords(this, problemInfo) call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) - call alloc_and_init(this%coords, 3, this%nPoints, 0_SINGLE) if (any(VOLUMIC_M_MEASURE == this%component)) then call alloc_and_init(this%xValueForTime, BuffObse, this%nPoints, 0.0_RKIND) @@ -280,18 +279,18 @@ subroutine flush_movie_probe_output(this) subroutine clear_memory_data() this%nTime = 0 this%timeStep = 0.0_RKIND - if (any(VOLUMIC_M_MEASURE==this%component)) then + if (any(VOLUMIC_M_MEASURE == this%component)) then this%xValueForTime = 0.0_RKIND this%yValueForTime = 0.0_RKIND this%zValueForTime = 0.0_RKIND - else if (any(VOLUMIC_X_MEASURE==this%component)) then - this%xValueForTime = 0.0_RKIND - else if (any(VOLUMIC_Y_MEASURE==this%component)) then + else if (any(VOLUMIC_X_MEASURE == this%component)) then + this%xValueForTime = 0.0_RKIND + else if (any(VOLUMIC_Y_MEASURE == this%component)) then this%yValueForTime = 0.0_RKIND - else if (any(VOLUMIC_Z_MEASURE==this%component)) then + else if (any(VOLUMIC_Z_MEASURE == this%component)) then this%zValueForTime = 0.0_RKIND end if - end subroutine clear_memory_data + end subroutine clear_memory_data end subroutine flush_movie_probe_output @@ -408,6 +407,15 @@ subroutine update_pvd(this, stepIndex, unitPVD) '" group="" part="0" file="'//trim(filename)//'"/>' end subroutine update_pvd + subroutine find_and_store_important_coords(this, problemInfo) + type(movie_probe_output_t), intent(inout) :: this + type(problem_info_t), intent(in) :: problemInfo + + call count_required_coords(this, problemInfo) + call alloc_and_init(this%coords, 3, this%nPoints, 0_SINGLE) + call store_required_coords(this, problemInfo) + end subroutine + subroutine count_required_coords(this, problemInfo) type(movie_probe_output_t), intent(inout) :: this type(problem_info_t), intent(in) :: problemInfo @@ -416,6 +424,51 @@ subroutine count_required_coords(this, problemInfo) procedure(logical_func), pointer :: checker => null() ! Pointer to logical function integer :: component, count + call get_checker_and_component(this, checker, component) + + count = 0 + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (checker(component, i, j, k, problemInfo)) count = count + 1 + end do + end do + end do + + this%nPoints = count + + end subroutine + + subroutine store_required_coords(this, problemInfo) + type(movie_probe_output_t), intent(inout) :: this + type(problem_info_t), intent(in) :: problemInfo + + integer :: i, j, k + + procedure(logical_func), pointer :: checker => null() ! Pointer to logical function + integer :: component, count + call get_checker_and_component(this, checker, component) + + count = 0 + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (checker(component, i, j, k, problemInfo)) then + count = count + 1 + this%coords(1, count) = i + this%coords(2, count) = j + this%coords(3, count) = k + end if + end do + end do + end do + end subroutine + + subroutine get_checker_and_component(this, checker, component) + type(movie_probe_output_t), intent(in) :: this + procedure(logical_func), pointer, intent(out) :: checker + integer, intent(out) :: component + select case (this%component) case (iCur) checker => volumicCurrentRequest @@ -454,18 +507,6 @@ subroutine count_required_coords(this, problemInfo) checker => componentFieldRequest component = iHz end select - - count = 0 - do i = this%mainCoords%x, this%auxCoords%x - do j = this%mainCoords%y, this%auxCoords%y - do k = this%mainCoords%z, this%auxCoords%z - if (checker(component, i, j, k, problemInfo)) count = count + 1 - end do - end do - end do - - this%nPoints = count - end subroutine logical function isValidPointForCurrent(request, i, j, k, problemInfo) diff --git a/src_output/pointProbeOutput.F90 b/src_output/pointProbeOutput.F90 index f9f17014..6dfe2859 100644 --- a/src_output/pointProbeOutput.F90 +++ b/src_output/pointProbeOutput.F90 @@ -158,7 +158,7 @@ subroutine flush_frequency_domain(this) open (unit=this%fileUnitFreq, file=filename, status="replace", action="write") do i = 1, this%nFreq - write (this%fileUnitFreq, '(F12.6,1X,F12.6)') this%frequencySlice(i), this%valueForFreq(i) + write (this%fileUnitFreq, '(F12.6,1X,F12.6,1X,F12.6)') this%frequencySlice(i), real(this%valueForFreq(i)), aimag(this%valueForFreq(i)) end do close (this%fileUnitFreq) diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 56da17b7..c6814bd9 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -42,7 +42,6 @@ integer function test_init_point_probe() bind(c) result(err) test_err = test_err + assert_true(outputRequested, 'Valid probes not found') test_err = test_err + assert_integer_equal(outputs(1)%outputID, POINT_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_integer_equal(outputs(1)%pointProbe%columnas, 2, 'Unexpected number of columns') test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, & 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') @@ -466,9 +465,6 @@ integer function test_init_movie_probe() bind(c) result(err) test_err = test_err + assert_integer_equal(outputs(1)%outputID, & MOVIE_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, & - 4, 'Unexpected number of columns') - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nPoints, & expectedNumMeasurments, 'Unexpected number of measurements') @@ -587,19 +583,6 @@ integer function test_update_movie_probe() bind(c) result(err) call update_outputs(dummyControl, dummysgg%tiempo, 1_SINGLE, fields) - test_err = test_err + assert_integer_equal(outputs(1)%outputID, & - MOVIE_PROBE_ID, 'Unexpected probe id') - - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%columnas, & - 4, 'Unexpected number of columns') - - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nPoints, & - expectedNumMeasurments, 'Unexpected number of measurements') - - test_err = test_err + assert_integer_equal( & - size(outputs(1)%movieProbe%xValueForTime), & - expectedNumMeasurments*BuffObse, 'Unexpected allocation size') - test_err = test_err + assert_real_equal(outputs(1)%movieProbe%yValueForTime(1, 1), & 0.2_RKIND, 1e-5_RKIND, 'Value error') @@ -689,10 +672,21 @@ integer function test_flush_movie_probe() bind(c) result(err) call create_geometry_media(media, 0, 8, 0, 8, 0, 8) + call assing_material_id_to_media_matrix_coordinate(media, iEx, 3, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 3, 3, simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) - call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iHy, 3, 3, 3, simulationMaterials(0)%Id) + + call assing_material_id_to_media_matrix_coordinate(media, iEx, 3, 4, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iHy, 3, 4, 3, simulationMaterials(0)%Id) + + call assing_material_id_to_media_matrix_coordinate(media, iEx, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iHy, 4, 4, 3, simulationMaterials(0)%Id) + + call assing_material_id_to_media_matrix_coordinate(media, iEx, 4, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) + call assing_material_id_to_media_matrix_coordinate(media, iHy, 4, 3, 3, simulationMaterials(0)%Id) expectedNumMeasurments = 4_SINGLE mediaPtr => media @@ -730,20 +724,20 @@ integer function test_flush_movie_probe() bind(c) result(err) !--- Dummy second update --- !movieCurrentObservable outputs(1)%movieProbe%nTime = 2 - outputs(1)%movieProbe%timeStep(2) = 0.5_RKIND_tiempo - outputs(1)%movieProbe%xValueForTime(2, :) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] - outputs(1)%movieProbe%yValueForTime(2, :) = [0.3_RKIND, 0.4_RKIND, 0.5_RKIND, 0.6_RKIND] - outputs(1)%movieProbe%zValueForTime(2, :) = [0.7_RKIND, 0.8_RKIND, 0.9_RKIND, 1.0_RKIND] + outputs(1)%movieProbe%timeStep(2) = 0.75_RKIND_tiempo + outputs(1)%movieProbe%xValueForTime(2, :) = [1.1_RKIND, 1.2_RKIND, 1.3_RKIND, 1.4_RKIND] + outputs(1)%movieProbe%yValueForTime(2, :) = [1.3_RKIND, 1.4_RKIND, 1.5_RKIND, 1.6_RKIND] + outputs(1)%movieProbe%zValueForTime(2, :) = [1.7_RKIND, 1.8_RKIND, 1.9_RKIND, 2.0_RKIND] !movieElectricXObservable outputs(2)%movieProbe%nTime = 2 - outputs(2)%movieProbe%timeStep(2) = 0.5_RKIND_tiempo - outputs(2)%movieProbe%xValueForTime(2, :) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] + outputs(2)%movieProbe%timeStep(2) = 0.75_RKIND_tiempo + outputs(2)%movieProbe%xValueForTime(2, :) = [1.1_RKIND, 1.2_RKIND, 1.3_RKIND, 1.4_RKIND] !movieMagneticYObservable outputs(3)%movieProbe%nTime = 2 - outputs(3)%movieProbe%timeStep(2) = 0.5_RKIND_tiempo - outputs(3)%movieProbe%yValueForTime(2, :) = [0.1_RKIND, 0.2_RKIND, 0.3_RKIND, 0.4_RKIND] + outputs(3)%movieProbe%timeStep(2) = 0.75_RKIND_tiempo + outputs(3)%movieProbe%yValueForTime(2, :) = [1.1_RKIND, 1.2_RKIND, 1.3_RKIND, 1.4_RKIND] call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) @@ -901,6 +895,7 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) type(fields_reference_t) :: fields integer(kind=SINGLE) :: expectedNumMeasurments + integer(kind=SINGLE) :: expectedNumberFrequencies integer(kind=SINGLE) :: mpidir = 3 integer(kind=SINGLE) :: iter integer(kind=SINGLE) :: test_err = 0 @@ -935,7 +930,7 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 3, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 4, 4, 3, simulationMaterials(0)%Id) call assing_material_id_to_media_matrix_coordinate(media, iEy, 3, 4, 3, simulationMaterials(0)%Id) - + expectedNumberFrequencies = 6_SINGLE expectedNumMeasurments = 4_SINGLE mediaPtr => media @@ -966,37 +961,26 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) fields%H%deltaY => dummyFields%dyh fields%H%deltaZ => dummyFields%dzh - dummyFields%Hx(3, 3, 3) = 2.0_RKIND - dummyFields%Hy(3, 3, 3) = 5.0_RKIND - dummyFields%Hz(3, 3, 3) = 4.0_RKIND + call fillGradient(dummyFields, 1, 0.0_RKIND, 10.0_RKIND) - call update_outputs(dummyControl, dummysgg%tiempo, 1_SINGLE, fields) + call update_outputs(dummyControl, dummysgg%tiempo, 2_SINGLE, fields) test_err = test_err + assert_integer_equal(outputs(1)%outputID, & FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%columnas, & - 4, 'Unexpected number of columns') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nPoints, & expectedNumMeasurments, 'Unexpected number of measurements') test_err = test_err + assert_integer_equal( & size(outputs(1)%frequencySliceProbe%frequencySlice), & - expectedNumMeasurments*BuffObse, 'Unexpected allocation size') - - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 1), & - (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') - - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 2), & - (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') - - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 3), & - (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + expectedNumberFrequencies, 'Unexpected allocation size') - test_err = test_err + assert_complex_equal(outputs(1)%frequencySliceProbe%yValueForFreq(3, 4), & - (0.2_CKIND, 0.2_CKIND), 1e-5_RKIND, 'Value error') + !This test generates X Gradient for H. It is expected to detect none Current accros X axis and Opposite values for Y and Z + test_err = test_err + assert_array_value(outputs(1)%frequencySliceProbe%xValueForFreq, (0.0_CKIND , 0.0_CKIND), errormessage='Detected Current on X Axis for Hx gradient') + test_err = test_err + assert_arrays_equal(outputs(1)%frequencySliceProbe%yValueForFreq, & + -1.0_RKIND * outputs(1)%frequencySliceProbe%zValueForFreq, errormessage='Unequal values for Y and -Z') + call close_outputs() err = test_err From f55d13926142c0fa579c5481294ca22f178f889d Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 9 Jan 2026 17:01:00 +0100 Subject: [PATCH 53/67] Integrate flusher into main workflow --- src_main_pub/timestepping.F90 | 39 ++++++++++++++++++++++++---- src_output/domain.F90 | 12 ++++++--- src_output/movieProbeOutput.F90 | 1 - src_output/output.F90 | 46 ++++++++++++++++++++++++++++----- src_output/outputTypes.F90 | 2 +- 5 files changed, 83 insertions(+), 17 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 930d46ff..3a5489cb 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -2051,11 +2051,13 @@ subroutine updateAndFlush() integer(kind=4) :: mindum IF (this%thereAre%Observation) then #ifdef CompileWithNewOutputModule - call update_outputs(this%control, this%sgg%tiempo, this%n + 1, fieldReference) - if (this%n>=this%ini_save+BuffObse) then - mindum=min(this%control%finaltimestep,this%ini_save+BuffObse) - call FlushObservationFiles(this%sgg,this%ini_save,mindum,this%control%layoutnumber,this%control%size, dxe, dye, dze, dxh, dyh, dzh,this%bounds,this%control%singlefilewrite,this%control%facesNF2FF,.FALSE.) !no se flushean los farfields ahora - endif + if (this%n /= 0) then + call update_outputs(this%control, this%sgg%tiempo, this%n, fieldReference) + if (this%n>=this%ini_save+BuffObse) then + mindum=min(this%control%finaltimestep,this%ini_save+BuffObse) + call flush_outputs(this%sgg%tiempo, this%n, this%control, fieldReference, this%bounds, .FALSE.) + endif + end if #else call UpdateObservation(this%sgg,this%media,this%tag_numbers, this%n,this%ini_save, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh,this%control%wiresflavor,this%sinPML_fullsize,this%control%wirecrank, this%control%noconformalmapvtk,this%bounds) if (this%n>=this%ini_save+BuffObse) then @@ -2762,12 +2764,35 @@ subroutine solver_end(this) logical :: dummylog, somethingdone, newsomethingdone character(len=bufsize) :: dubuf +#ifdef CompileWithNewOutputModule + type(fields_reference_t) :: fieldReference +#endif + + #ifdef CompileWithMPI integer (kind=4) :: ierr #endif Ex => this%Ex; Ey => this%Ey; Ez => this%Ez; Hx => this%Hx; Hy => this%Hy; Hz => this%Hz; dxe => this%dxe; dye => this%dye; dze => this%dze; dxh => this%dxh; dyh => this%dyh; dzh => this%dzh +#ifdef CompileWithNewOutputModule + fieldReference%E%x => this%Ex + fieldReference%E%y => this%Ey + fieldReference%E%z => this%Ez + + fieldReference%E%deltax => this%dxe + fieldReference%E%deltay => this%dye + fieldReference%E%deltaz => this%dze + + fieldReference%H%x => this%Hx + fieldReference%H%y => this%Hy + fieldReference%H%z => this%Hz + + fieldReference%H%deltax => this%dxh + fieldReference%H%deltay => this%dyh + fieldReference%H%deltaz => this%dzh +#endif + #ifdef CompileWithProfiling call nvtxEndRange #endif @@ -2813,8 +2838,12 @@ subroutine solver_end(this) call print11(this%control%layoutnumber,dubuf) call print11(this%control%layoutnumber,SEPARADOR//separador//separador) if (this%thereAre%Observation) THEN +#ifdef CompileWithNewOutputModule + call flush_outputs(this%sgg%tiempo, this%n, this%control, fieldReference, this%bounds, .TRUE.) +#else call FlushObservationFiles(this%sgg,this%ini_save, this%n,this%control%layoutnumber, this%control%size, dxe, dye, dze, dxh, dyh, dzh,this%bounds,this%control%singlefilewrite,this%control%facesNF2FF,.TRUE.) call CloseObservationFiles(this%sgg,this%control%layoutnumber,this%control%size,this%control%singlefilewrite,this%initialtimestep,this%lastexecutedtime,this%control%resume) !dump the remaining to disk +#endif #ifdef CompileWithMTLN if (this%control%use_mtln_wires) then call FlushMTLNObservationFiles(this%control%nentradaroot, mtlnProblem = .false.) diff --git a/src_output/domain.F90 b/src_output/domain.F90 index 3a789592..d9799478 100644 --- a/src_output/domain.F90 +++ b/src_output/domain.F90 @@ -3,10 +3,11 @@ module mod_domain use outputTypes implicit none - + private + public :: domain_t interface domain_t - module procedure new_domain_time, new_domain_freq, new_domain_both + module procedure new_domain_time, new_domain_freq, new_domain_both, null_domain end interface domain_t contains @@ -56,8 +57,11 @@ function new_domain_both(tstart, tstop, tstep, fstart, fstop, fnum, logarithmicS new_domain%domainType = BOTH_DOMAIN - - end function new_domain_both + function null_domain() result(new_domain) + type(domain_t) :: new_domain + new_domain%domainType = UNDEFINED_DOMAIN + end function + end module mod_domain diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 7bd9f164..e3e15f07 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -250,7 +250,6 @@ subroutine save_field_component(this, fieldData, fieldComponent, simTime, proble do j = this%mainCoords%y, this%auxCoords%y do k = this%mainCoords%z, this%auxCoords%z if (isValidPointForField(fieldDir, i, j, k, problemInfo)) then - coordIdx = coordIdx + 1 coordIdx = coordIdx + 1 call save_field(fieldData, this%nTime, coordIdx, fieldComponent(i, j, k)) end if diff --git a/src_output/output.F90 b/src_output/output.F90 index c93b0503..ef46f167 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -33,7 +33,8 @@ module output private :: get_required_output_count !=========================== - integer(kind=SINGLE), parameter :: POINT_PROBE_ID = 0, & + integer(kind=SINGLE), parameter :: UNDEFINED_PROBE = -1, & + POINT_PROBE_ID = 0, & WIRE_CURRENT_PROBE_ID = 1, & WIRE_CHARGE_PROBE_ID = 2, & BULK_PROBE_ID = 3, & @@ -145,6 +146,8 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio !end do do ii = 1, sgg%NumberRequest + domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, control%finaltimestep) + if (domain%domainType == UNDEFINED_DOMAIN) cycle do i = 1, sgg%Observation(ii)%nP lowerBound%x = sgg%observation(ii)%P(i)%XI lowerBound%y = sgg%observation(ii)%P(i)%YI @@ -155,7 +158,6 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio upperBound%z = sgg%observation(ii)%P(i)%ZE NODE = sgg%observation(ii)%P(i)%NODE - domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, control%finaltimestep) outputTypeExtension = trim(adjustl(control%nEntradaRoot))//'_'//trim(adjustl(sgg%observation(ii)%outputrequest)) outputRequestType = sgg%observation(ii)%P(i)%what @@ -211,7 +213,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = FREQUENCY_SLICE_PROBE_ID allocate (outputs(outputCount)%frequencySliceProbe) call init_solver_output(outputs(outputCount)%frequencySliceProbe, lowerBound, upperBound, sgg%dt, outputRequestType, domain, outputTypeExtension, control, problemInfo) - call create_pvd(outputs(outputCount)%frequencySliceProbe%path, outputs(outputCount)%frequencySliceProbe%fileUnitFreq) + call create_pvd(outputs(outputCount)%frequencySliceProbe%path, outputs(outputCount)%frequencySliceProbe%fileUnitFreq) end if case (farfield) @@ -221,12 +223,17 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = FAR_FIELD_PROBE_ID allocate (outputs(outputCount)%farFieldOutput) call init_solver_output(outputs(outputCount)%farFieldOutput, sgg, lowerBound, upperBound, outputRequestType, domain, sphericRange, outputTypeExtension, sgg%Observation(ii)%FileNormalize, control, problemInfo, eps0, mu0) + case (mapvtk) + call stoponerror(0, 0, 'mapvtk type not implemented yet on new observations') case default call stoponerror(0, 0, 'OutputRequestType type not implemented yet on new observations') end select end do end do - + if (outputCount /= requestedOutputs) then + call remove_unused_outputs(outputs) + outputCount = size(outputs) + end if if (outputCount /= 0) observationsExists = .true. return contains @@ -285,7 +292,7 @@ function preprocess_domain(observation, timeArray, simulationTimeStep, finalStep newDomain%fnum = int((newDomain%fstop - newDomain%fstart)/newDomain%fstep, kind=SINGLE) else - call stoponerror(0, 0, 'No domain present') + newDomain = domain_t() end if return end function preprocess_domain @@ -383,6 +390,33 @@ subroutine flush_outputs(simulationTimeArray, simulationTimeIndex, control, fiel end do end subroutine flush_outputs + subroutine remove_unused_outputs(output_list) + implicit none + type(solver_output_t), pointer, intent(inout) :: output_list(:) + + type(solver_output_t), allocatable :: tmp(:) + integer :: i, n, k + + n = count(output_list%outputID /= UNDEFINED_PROBE) + + allocate (tmp(n)) + + ! Copy valid elements + k = 0 + do i = 1, size(output_list) + if (output_list(i)%outputID /= UNDEFINED_PROBE) then + k = k + 1 + tmp(k) = output_list(i) ! deep copy of all allocatable components + end if + end do + + ! Replace the saved pointer target safely + if (associated(output_list)) deallocate (output_list) + allocate (output_list(n)) + output_list = tmp + + end subroutine remove_unused_outputs + subroutine close_outputs() integer :: i do i = 1, size(outputs) @@ -547,4 +581,4 @@ function get_required_output_count(sgg) result(count) ! end if ! end subroutine - end module output +end module output diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index e53a2bcc..2c028a01 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -170,7 +170,7 @@ module outputTypes ! High-level aggregation types !===================================================== type :: solver_output_t - integer(kind=SINGLE) :: outputID + integer(kind=SINGLE) :: outputID = -1 type(point_probe_output_t), allocatable :: pointProbe type(wire_current_probe_output_t), allocatable :: wireCurrentProbe type(wire_charge_probe_output_t), allocatable :: wireChargeProbe From 219bdedce7936a1ceb6253ad238cc2aa51678439 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 12 Jan 2026 14:48:50 +0100 Subject: [PATCH 54/67] Fix allocation errors --- CMakeLists.txt | 2 +- src_main_pub/timestepping.F90 | 5 ++++- src_output/bulkProbeOutput.F90 | 11 +++++++---- src_output/farFieldProbeOutput.F90 | 2 +- src_output/outputUtils.F90 | 6 ++++-- src_output/wireProbeOutput.F90 | 6 ++++-- test/utils/fdetypes_tools.F90 | 6 +++--- 7 files changed, 24 insertions(+), 14 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5f604766..d92aeea0 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -16,7 +16,7 @@ option(SEMBA_FDTD_ENABLE_MPI "Use MPI" OFF) option(SEMBA_FDTD_ENABLE_HDF "Use HDF" ON) option(SEMBA_FDTD_ENABLE_MTLN "Use MTLN" ON) option(SEMBA_FDTD_ENABLE_SMBJSON "Use smbjson" ON) -option(SEMBA_FDTD_ENABLE_DOUBLE_PRECISION "Use double precision (CompileWithReal8)" OFF) +option(SEMBA_FDTD_ENABLE_DOUBLE_PRECISION "Use double precision (CompileWithReal8)" ON) option(SEMBA_FDTD_ENABLE_TEST "Compile tests" ON) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 3a5489cb..d97c4fd1 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -2864,6 +2864,9 @@ subroutine solver_end(this) call MPI_Barrier(SUBCOMM_MPI,ierr) #endif +#ifdef CompileWithNewOutputModule +#else + write(dubuf,'(a,i9)') 'INIT FINAL Postprocessing frequency domain probes, if any, at n= ',this%n call print11(this%control%layoutnumber,dubuf) write(dubuf,*) SEPARADOR//separador//separador @@ -2871,6 +2874,7 @@ subroutine solver_end(this) somethingdone=.false. at=this%n*this%sgg%dt if (this%thereAre%Observation) call PostProcess(this%control%layoutnumber,this%control%size,this%sgg,this%control%nentradaroot,at,somethingdone,this%control%niapapostprocess,this%control%forceresampled) +#endif #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) call MPI_AllReduce(somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) @@ -2896,7 +2900,6 @@ subroutine solver_end(this) somethingdone=.false. if (this%thereAre%Observation) call createvtk(this%control%layoutnumber,this%control%size,this%sgg,this%control%vtkindex,somethingdone,this%control%mpidir,this%media%sggMtag,this%control%dontwritevtk) - #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) call MPI_AllReduce(somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) diff --git a/src_output/bulkProbeOutput.F90 b/src_output/bulkProbeOutput.F90 index 1b65553d..5c958ade 100644 --- a/src_output/bulkProbeOutput.F90 +++ b/src_output/bulkProbeOutput.F90 @@ -23,6 +23,9 @@ subroutine init_bulk_probe_output(this, lowerBound, upperBound, field, domain, o 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) + contains function get_output_path() result(outputPath) @@ -69,10 +72,10 @@ subroutine update_bulk_probe_output(this, step, field) k2_m = this%auxCoords%z i1 = i1_m - j1 = i2_m - k1 = j1_m - i2 = j2_m - j2 = k1_m + j1 = j1_m + k1 = k1_m + i2 = i2_m + j2 = j2_m k2 = k2_m xF => field%x diff --git a/src_output/farFieldProbeOutput.F90 b/src_output/farFieldProbeOutput.F90 index 6556ebd4..aaa1a970 100644 --- a/src_output/farFieldProbeOutput.F90 +++ b/src_output/farFieldProbeOutput.F90 @@ -49,7 +49,7 @@ subroutine init_farField_probe_output(this, sgg, lowerBound, upperBound, field, fileNormalize, problemInfo%problemDimension, & control%facesNF2FF, control%NF2FFDecim, & #ifdef CompileWithMPI - output(ii)%item(i)%MPISubComm, output(ii)%item(i)%MPIRoot, & + 0, 0, & #endif eps0, mu0) diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index c46978aa..528f7a7e 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -49,7 +49,9 @@ module mod_outputUtils end interface get_coordinates_extension interface alloc_and_init +#ifndef CompileWithMPI procedure alloc_and_init_time_1D +#endif procedure alloc_and_init_int_1D procedure alloc_and_init_int_2D procedure alloc_and_init_int_3D @@ -187,7 +189,7 @@ function get_probe_coords_extension(coordinates, mpidir) result(ext) elseif (mpidir == 1) then ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) else - call stoponerror('Buggy error in mpidir. ') + call stoponerror(0,0,'Buggy error in mpidir. ') end if #else ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) @@ -221,7 +223,7 @@ function get_probe_bounds_coords_extension(lowerCoordinates, upperCoordinates, m ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj))//'__'// & trim(adjustl(chark2))//'_'//trim(adjustl(chari2))//'_'//trim(adjustl(charj2)) else - call stoponerror('Buggy error in mpidir. ') + call stoponerror(0,0,'Buggy error in mpidir. ') end if #else ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark))//'__'// & diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index 6cb9a4f0..43069e2d 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -62,6 +62,8 @@ subroutine init_wire_current_probe_output(this, coordinates, node, field, domain this%domain = domain this%path = get_output_path() + call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) + contains subroutine find_segment() integer(kind=SINGLE) :: n, iwi, iwj, node2 @@ -176,7 +178,7 @@ function get_probe_bounds_extension() result(ext) elseif (mpidir == 1) then ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) else - call stoponerror('Buggy error in mpidir. ') + call stoponerror(0,0,'Buggy error in mpidir. ') end if #else ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) @@ -261,7 +263,7 @@ function get_probe_bounds_extension() result(ext) elseif (mpidir == 1) then ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) else - call stoponerror('Buggy error in mpidir. ') + call stoponerror(0,0,'Buggy error in mpidir. ') end if #else ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index 4f4d311e..e2323a29 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -597,17 +597,17 @@ end function create_material function create_vacuum_material() result(mat) type(Material) :: mat - mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, 0.0, 1) + mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0_RKIND, 0.0_RKIND, 1) end function create_vacuum_material function create_pec_material() result(mat) type(Material) :: mat - mat = create_material(EPSILON_VACUUM, MU_VACUUM, SIGMA_PEC, 0.0, 0) + mat = create_material(EPSILON_VACUUM, MU_VACUUM, SIGMA_PEC, 0.0_RKIND, 0) end function create_pec_material function create_pmc_material() result(mat) type(Material) :: mat - mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0, SIGMA_PMC, 2) + mat = create_material(EPSILON_VACUUM, MU_VACUUM, 0.0_RKIND, SIGMA_PMC, 2) end function create_pmc_material function create_empty_materials() result(mats) From 15bcc26d5b84607e5a2f8d0c8eba32b90df029fb Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 13 Jan 2026 09:48:57 +0100 Subject: [PATCH 55/67] Added compilation flags forr newOutput module --- CMakeLists.txt | 11 ++++++++--- src_output/outputUtils.F90 | 12 ------------ test/CMakeLists.txt | 8 ++++++-- test/output/output_tests.h | 3 +++ 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index d92aeea0..b6f73bef 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -191,13 +191,18 @@ if (SEMBA_FDTD_ENABLE_MTLN) endif() endif() -add_subdirectory(external/VTKFortran) +if (SEMBA_FDTD_ENABLE_OUTPUT_MODULE) + add_subdirectory(external/VTKFortran) + add_subdirectory(src_output) + set(OUTPUT_LIBRARIES fdtd-output) +endif() if (SEMBA_FDTD_ENABLE_TEST) add_subdirectory(external/googletest/) add_subdirectory(test) endif() -add_subdirectory(src_output) + + if(SEMBA_FDTD_COMPONENTS_LIB) add_library(semba-components @@ -262,7 +267,7 @@ if(SEMBA_FDTD_MAIN_LIB) ) target_link_libraries(semba-main semba-outputs - fdtd-output + ${OUTPUT_LIBRARIES} ${SMBJSON_LIBRARIES} ${MTLN_LIBRARIES}) endif() diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 528f7a7e..b6244af6 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -49,9 +49,6 @@ module mod_outputUtils end interface get_coordinates_extension interface alloc_and_init -#ifndef CompileWithMPI - procedure alloc_and_init_time_1D -#endif procedure alloc_and_init_int_1D procedure alloc_and_init_int_2D procedure alloc_and_init_int_3D @@ -64,15 +61,6 @@ module mod_outputUtils end interface contains - subroutine alloc_and_init_time_1D(array, n1, initVal) - real(RKIND_tiempo), allocatable, intent(inout) :: array(:) - integer, intent(IN) :: n1 - real(RKIND_tiempo), intent(IN) :: initVal - - allocate (array(n1)) - array = initVal - END subroutine alloc_and_init_time_1D - subroutine alloc_and_init_int_1D(array, n1, initVal) integer(SINGLE), allocatable, intent(inout) :: array(:) integer, intent(IN) :: n1 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 14cd1575..c47f354a 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -23,8 +23,12 @@ if (SEMBA_FDTD_ENABLE_SMBJSON) set(ROTATE_TESTS_LIBRARY rotate_tests) add_subdirectory(vtk) set(VTK_TESTS_LIBRARY vtk_tests) - add_subdirectory(output) - set(OUPUT_TESTS_LIBRARY output_tests) + + if (SEMBA_FDTD_ENABLE_OUTPUT_MODULE) + add_subdirectory(output) + set(OUPUT_TESTS_LIBRARY output_tests) + endif() + if (NOT SEMBA_FDTD_ENABLE_MPI) #add_subdirectory(observation) #set(OBSERVATION_TESTS_LIBRARY observation_tests) diff --git a/test/output/output_tests.h b/test/output/output_tests.h index ae51f836..6fd12015 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -1,3 +1,5 @@ +#ifdef CompileWithNewOutputModule + #include extern "C" int test_init_point_probe(); @@ -25,3 +27,4 @@ TEST(output, test_init_frequency_slice) {EXPECT_EQ(0, test_init_frequency_sli TEST(output, test_update_frequency_slice) {EXPECT_EQ(0, test_update_frequency_slice_probe()); } TEST(output, test_flush_frequency_slice) {EXPECT_EQ(0, test_flush_frequency_slice_probe()); } +#endif \ No newline at end of file From 9d7cc6009f63be7edb3c16922abac16b39cb6fe0 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 13 Jan 2026 11:39:17 +0100 Subject: [PATCH 56/67] Commented subroutines cleanup --- src_output/output.F90 | 113 -------------------------------- src_output/pointProbeOutput.F90 | 11 ++++ test/output/output_tests.h | 2 - test/output/test_output.F90 | 87 +----------------------- 4 files changed, 13 insertions(+), 200 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index ef46f167..5ee90f32 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -468,117 +468,4 @@ function get_required_output_count(sgg) result(count) return end function -! subroutine eliminate_unnecessary_observation_points(observation_probe, output_item, sweep, SINPMLSweep, ZI, ZE, layoutnumber, size) -! type(item_t), intent(inout) :: output_item -! type(observable_t), intent(inout) :: observation_probe -! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep, SINPMLSweep -! integer(kind=4), intent(in) :: ZI, ZE, layoutnumber, size -! integer(kind=4) :: field -! -! ! Initialize output_item trancos -! output_item%Xtrancos = observation_probe%Xtrancos -! output_item%Ytrancos = observation_probe%Ytrancos -! output_item%Ztrancos = observation_probe%Ztrancos -! -! output_item%XItrancos = ceiling(real(observation_probe%XI)/real(output_item%Xtrancos)) -! output_item%YItrancos = ceiling(real(observation_probe%YI)/real(output_item%Ytrancos)) -! output_item%ZItrancos = ceiling(real(observation_probe%ZI)/real(output_item%Ztrancos)) -! -! output_item%XEtrancos = int(observation_probe%XE/output_item%Xtrancos) -! output_item%YEtrancos = int(observation_probe%YE/output_item%Ytrancos) -! output_item%ZEtrancos = int(observation_probe%ZE/output_item%Ztrancos) -! -!#ifdef CompileWithMPI -! output_item%MPISubComm = -1 -!#endif -! -! field = observation_probe%What -! -! select case (field) -! case (iBloqueJx, iBloqueJy, iBloqueMx, iBloqueMy, iExC, iEyC, iHzC, iMhC, iEzC, iHxC, iHyC, iMeC) -! call eliminate_observation_block(observation_probe, output_item, sweep, field, layoutnumber, size) -! case (iEx, iVx, iEy, iVy, iHz, iBloqueMz, iJx, iJy, iQx, iQy) -! call eliminate_observation_range(observation_probe, sweep, field, layoutnumber, size, lower_inclusive=.false.) -! case (iEz, iVz, iJz, iQz, iBloqueJz, iHx, iHy) -! call eliminate_observation_range(observation_probe, sweep, field, layoutnumber, size, lower_inclusive=.true.) -! case (iCur, iCurX, iCurY, iCurZ, mapvtk) -! call eliminate_observation_current(observation_probe, output_item, sweep, field, layoutnumber, size) -! case (FarField) -! call eliminate_observation_farfield(observation_probe, output_item, SINPMLSweep, ZI, ZE, layoutnumber, size) -! end select -! end subroutine -! -!! Generic subroutine for block observations -! subroutine eliminate_observation_block(obs, out, sweep, field, layoutnumber, size) -! type(observable_t), intent(inout) :: obs -! type(item_t), intent(inout) :: out -! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep -! integer, intent(in) :: field, layoutnumber, size -! -! call eliminate_observation_range_generic(obs, out, sweep(fieldo(field, 'Z'))%ZI, & -! sweep(fieldo(field, 'Z'))%ZE, layoutnumber, size) -! end subroutine -! -!! Generic Z-range check with optional inclusive lower bound -! subroutine eliminate_observation_range(obs, sweep, field, layoutnumber, size, lower_inclusive) -! type(observable_t), intent(inout) :: obs -! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep -! integer, intent(in) :: field, layoutnumber, size -! logical, intent(in) :: lower_inclusive -! -! if (lower_inclusive) then -! if ((obs%ZI > sweep(fieldo(field, 'Z'))%ZE) .or. (obs%ZI < sweep(fieldo(field, 'Z'))%ZI)) obs%What = nothing -! else -! if ((obs%ZI >= sweep(fieldo(field,'Z'))%ZE) .and. (layoutnumber /= size-1) .or. (obs%ZI < sweep(fieldo(field,'Z'))%ZI)) obs%What = nothing -! end if -! end subroutine -! -!! Generic subroutine for currents -! subroutine eliminate_observation_current(obs, out, sweep, field, layoutnumber, size) -! type(observable_t), intent(inout) :: obs -! type(item_t), intent(inout) :: out -! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep -! integer, intent(in) :: field, layoutnumber, size -! -! call eliminate_observation_range_generic(obs, out, sweep(fieldo(field, 'Z'))%ZI, sweep(fieldo(field, 'Z'))%ZE, layoutnumber, size) -! if ((field == iCur .or. field == iCurX .or. field == iCurY .or. field == mapvtk)) then -! obs%ZE = min(obs%ZE, sweep(iHx)%ZE) -! end if -! end subroutine -! -!! Far field specialized -! subroutine eliminate_observation_farfield(obs, out, sweep, ZI, ZE, layoutnumber, size) -! type(observable_t), intent(inout) :: obs -! type(item_t), intent(inout) :: out -! type(XYZlimit_t), dimension(1:6), intent(in) :: sweep -! integer(kind=4), intent(in) :: ZI, ZE, layoutnumber, size -! -! call eliminate_observation_range_generic(obs, out, sweep(iHz)%ZI, sweep(iHz)%ZE, layoutnumber, size, ZI, ZE) -! end subroutine -! -!! The ultimate generic routine for MPI and Z-limits -! subroutine eliminate_observation_range_generic(obs, out, Z_lower, Z_upper, layoutnumber, size, Zstart, Zend) -! type(observable_t), intent(inout) :: obs -! type(item_t), intent(inout) :: out -! integer, intent(in) :: Z_lower, Z_upper, layoutnumber, size -! integer, optional, intent(in) :: Zstart, Zend -! -! integer :: zi_local, ze_local -! zi_local = merge(Zstart, obs%ZI, present(Zstart)) -! ze_local = merge(Zend, obs%ZE, present(Zend)) -! -! if ((zi_local > Z_upper) .or. (ze_local < Z_lower)) then -! obs%What = nothing -!#ifdef CompileWithMPI -! out%MPISubComm = -1 -! else -! out%MPISubComm = 1 -! end if -! out%MPIRoot = 0 -! if ((obs%ZI >= Z_lower) .and. (obs%ZI <= Z_upper)) out%MPIRoot = layoutnumber -! call MPIinitSubcomm(layoutnumber, size, out%MPISubComm, out%MPIRoot, out%MPIGroupIndex) -!#endif -! end if -! end subroutine - end module output diff --git a/src_output/pointProbeOutput.F90 b/src_output/pointProbeOutput.F90 index 6dfe2859..33dd0183 100644 --- a/src_output/pointProbeOutput.F90 +++ b/src_output/pointProbeOutput.F90 @@ -6,6 +6,17 @@ module mod_pointProbeOutput implicit none + private + + !=========================== + ! Public interface summary + !=========================== + public :: init_point_probe_output + public :: create_point_probe_output_files + public :: update_point_probe_output + public :: flush_point_probe_output + !=========================== + contains subroutine init_point_probe_output(this, coordinates, field, domain, outputTypeExtension, mpidir, timeInterval) type(point_probe_output_t), intent(out) :: this diff --git a/test/output/output_tests.h b/test/output/output_tests.h index 6fd12015..8feeb501 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -6,7 +6,6 @@ extern "C" int test_init_point_probe(); extern "C" int test_update_point_probe(); extern "C" int test_flush_point_probe(); extern "C" int test_multiple_flush_point_probe(); -extern "C" int test_volumic_probe_count_relevant_surfaces(); extern "C" int test_init_movie_probe(); extern "C" int test_update_movie_probe(); extern "C" int test_flush_movie_probe(); @@ -19,7 +18,6 @@ TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe TEST(output, test_update_point_probe_info) {EXPECT_EQ(0, test_update_point_probe()); } TEST(output, test_flush_point_probe_info) {EXPECT_EQ(0, test_flush_point_probe()); } TEST(output, test_flush_multiple_point_probe_info) {EXPECT_EQ(0, test_multiple_flush_point_probe()); } -//TEST(output, test_volumic_probe_counter_relevant_surfaces) {EXPECT_EQ(0, test_volumic_probe_count_relevant_surfaces()); } TEST(output, test_init_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_init_movie_probe()); } TEST(output, test_update_movie_probe_for_pec_surface) {EXPECT_EQ(0, test_update_movie_probe()); } TEST(output, test_flush_movie_probe_data) {EXPECT_EQ(0, test_flush_movie_probe()); } diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index c6814bd9..51c6f7c9 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -131,6 +131,7 @@ integer function test_update_point_probe() bind(c) result(err) integer function test_flush_point_probe() bind(c) result(err) use output + use outputTypes use mod_pointProbeOutput use mod_domain use mod_testOutputUtils @@ -205,6 +206,7 @@ end function test_flush_point_probe integer function test_multiple_flush_point_probe() bind(c) result(err) use output + use outputTypes use mod_pointProbeOutput use mod_domain use mod_testOutputUtils @@ -295,91 +297,6 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) err = test_err end function test_multiple_flush_point_probe -integer function test_volumic_probe_count_relevant_surfaces() bind(c) result(err) -! use output -! use mod_testOutputUtils -! use FDETYPES_TOOLS -! use mod_sggMethods -! use mod_assertionTools -! -! type(SGGFDTDINFO) :: dummysgg -! type(sim_control_t) :: dummyControl -! type(bounds_t) :: dummyBound -! type(solver_output_t), pointer :: outputs(:) -! -! type(media_matrices_t), target :: media -! type(media_matrices_t), pointer :: mediaPtr -! -! type(MediaData_t), allocatable, target :: simulationMaterials(:) -! type(MediaData_t), pointer :: simulationMaterialsPtr(:) -! type(MediaData_t) :: thinWireSimulationMaterial -! -! type(limit_t), target :: sinpml_fullsize(6) -! type(limit_t), pointer :: sinpml_fullsizePtr(:) -! -! type(Obses_t) :: volumicProbeObservable -! -! real(kind=RKIND_tiempo), pointer :: timeArray(:) -! real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo -! integer(kind=SINGLE) :: nTimeSteps = 100_SINGLE -! -! integer(kind=RKIND) :: iter -! integer(kind=SINGLE) :: mpidir = 3 -! logical :: ThereAreWires = .false. -! logical :: outputRequested -! integer(kind=SINGLE) :: test_err = 0 -! -! err = 1 -! -! call sgg_init(dummysgg) -! call init_time_array(timeArray, nTimeSteps, dt) -! call sgg_set_tiempo(dummysgg, timeArray) -! call sgg_set_dt(dummysgg, dt) -! -! do iter = 1, 6 -! sinpml_fullsize(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) -! end do -! sinpml_fullsizePtr => sinpml_fullsize -! -! call init_simulation_material_list(simulationMaterials) -! -! thinWireSimulationMaterial = create_thinWire_simulation_material(size(simulationMaterials)) -! call add_simulation_material(simulationMaterials, thinWireSimulationMaterial) -! -! simulationMaterialsPtr => simulationMaterials -! call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) -! call sgg_set_Med(dummysgg, simulationMaterialsPtr) -! -! call create_geometry_media(media, 0, 8, 0, 8, 0, 8) -! call assing_material_id_to_media_matrix_coordinate(media, iEy, 1, 1, 1, simulationMaterials(0)%Id) -! call assing_material_id_to_media_matrix_coordinate(media, iHz, 1, 1, 1, simulationMaterials(2)%Id) -! call assing_material_id_to_media_matrix_coordinate(media, iEx, 2, 2, 2, thinWireSimulationMaterial%Id) -! mediaPtr => media -! -! volumicProbeObservable = create_volumic_probe_observation(4, 4, 4, 6, 6, 6) -! call sgg_add_observation(dummysgg, volumicProbeObservable) -! -! dummyControl = create_control_flags(mpidir=mpidir, nEntradaRoot='entradaRoot', wiresflavor='holland') -! -! call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & -! outputRequested, ThereAreWires) -! -! outputs => GetOutputs() -! -! test_err = test_err + assert_integer_equal(outputs(1)%outputID, & -! VOLUMIC_CURRENT_PROBE_ID, 'Unexpected probe id') -! -! test_err = test_err + assert_integer_equal(outputs(1)%volumicCurrentProbe%columnas, & -! 4, 'Unexpected number of columns') -! -! test_err = test_err + assert_string_equal(outputs(1)%volumicCurrentProbe%path, & -! 'entradaRoot_volumicProbe_BCX_4_4_4__6_6_6', 'Unexpected path') -! -! call close_outputs() -! -! err = test_err -end function - integer function test_init_movie_probe() bind(c) result(err) use output use outputTypes From 6e1b3196923e604e2171af63ff309b565e9ce3d0 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 13 Jan 2026 11:39:36 +0100 Subject: [PATCH 57/67] Wire probes refactor --- src_output/wireProbeOutput.F90 | 715 +++++++++++++++++---------------- 1 file changed, 371 insertions(+), 344 deletions(-) diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index 43069e2d..d52760f2 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -7,11 +7,10 @@ module mod_wireProbeOutput use HollandWires implicit none - private !=========================== - ! Public interface summary + ! Public interface !=========================== public :: init_wire_current_probe_output public :: init_wire_charge_probe_output @@ -23,424 +22,452 @@ module mod_wireProbeOutput public :: flush_wire_charge_probe_output !=========================== -contains - subroutine init_wire_current_probe_output(this, coordinates, node, field, domain, media, outputTypeExtension, mpidir, wiresflavor) - type(wire_current_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: node - integer(kind=SINGLE), intent(in) :: field, mpidir - character(len=BUFSIZE), intent(in) :: outputTypeExtension - character(len=*), intent(in) :: wiresflavor - type(domain_t), intent(in) :: domain - type(MediaData_t), dimension(:), intent(in) :: media - - type(cell_coordinate_t) :: coordinates + !=========================== + ! Private interface + !=========================== + private :: find_current_segment + private :: find_charge_segment + private :: build_output_path + private :: probe_bounds_extension + private :: clear_current_time_data + private :: clear_charge_time_data + private :: update_current_holland - type(Thinwires_t), pointer :: Hwireslocal #ifdef CompileWithBerengerWires - type(TWires), pointer :: Hwireslocal_Berenger -#endif -#ifdef CompileWithSlantedWires - type(WiresData), pointer :: Hwireslocal_Slanted + private :: update_current_berenger #endif - select case (trim(adjustl(wiresflavor))) - case ('holland', 'transition'); Hwireslocal => GetHwires() -#ifdef CompileWithBerengerWires - case ('berenger'); Hwireslocal_Berenger => GetHwires_Berenger() -#endif #ifdef CompileWithSlantedWires - case ('slanted', 'semistructured'); Hwireslocal_Slanted => GetHwires_Slanted() + private :: update_current_slanted #endif - end select + !=========================== - call find_segment() + contains + !====================================================================== + ! INITIALIZATION + !====================================================================== + subroutine init_wire_current_probe_output(this, coordinates, node, field, domain, media, & + outputTypeExtension, mpidir, wiresflavor) + type(wire_current_probe_output_t), intent(out) :: this + type(cell_coordinate_t), intent(in) :: coordinates + type(domain_t), intent(in) :: domain + type(MediaData_t), intent(in) :: media(:) + integer(kind=SINGLE), intent(in) :: node, field, mpidir + character(len=*), intent(in) :: outputTypeExtension, wiresflavor this%mainCoords = coordinates + this%component = field + this%domain = domain + this%sign = 1 + + call find_current_segment(this, node, field, media, wiresflavor) + this%path = build_output_path(outputTypeExtension, field, node, mpidir, coordinates) + call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) + + end subroutine init_wire_current_probe_output + + + subroutine init_wire_charge_probe_output(this, coordinates, node, field, domain, & + outputTypeExtension, mpidir, wiresflavor) + type(wire_charge_probe_output_t), intent(out) :: this + type(cell_coordinate_t), intent(in) :: coordinates + type(domain_t), intent(in) :: domain + integer(kind=SINGLE), intent(in) :: node, field, mpidir + character(len=*), intent(in) :: outputTypeExtension, wiresflavor + + this%mainCoords = coordinates this%component = field + this%domain = domain + this%sign = 1 - this%domain = domain - this%path = get_output_path() + call find_charge_segment(this, node, field, wiresflavor) + this%path = build_output_path(outputTypeExtension, field, node, mpidir, coordinates) call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) + call alloc_and_init(this%chargeValue, BuffObse, 0.0_RKIND) - contains - subroutine find_segment() - integer(kind=SINGLE) :: n, iwi, iwj, node2 - type(CurrentSegments), pointer :: currentSegment - logical :: found = .false. - character(len=BUFSIZE) :: buff - - select case (trim(adjustl(wiresflavor))) - case ('holland', 'transition') - this%segment => HWireslocal%NullSegment - do n = 1, HWireslocal%NumCurrentSegments - currentSegment => HWireslocal%CurrentSegment(n) - if ((currentSegment%origindex == node) .and. & - (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & - (currentSegment%tipofield*10 == field)) then - found = .true. - this%segment => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do + end subroutine init_wire_charge_probe_output + + !====================================================================== + ! FILE CREATION + !====================================================================== + subroutine create_wire_current_probe_output(this) + type(wire_current_probe_output_t), intent(inout) :: this + integer(kind=SINGLE) :: err + call create_or_clear_file(trim(this%path)//'_'//timeExtension//'_'//datFileExtension, & + this%fileUnitTime, err) + end subroutine + + subroutine create_wire_charge_probe_output(this) + type(wire_charge_probe_output_t), intent(inout) :: this + integer(kind=SINGLE) :: err + call create_or_clear_file(trim(this%path)//'_'//timeExtension//'_'//datFileExtension, & + this%fileUnitTime, err) + end subroutine + + !====================================================================== + ! UPDATE + !====================================================================== + subroutine update_wire_current_probe_output(this, step, control, InvEps, InvMu) + type(wire_current_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + type(sim_control_t), intent(in) :: control + real(kind=RKIND), intent(in) :: InvEps(:), InvMu(:) + + this%nTime = this%nTime + 1 + this%timeStep(this%nTime) = step + + select case (trim(control%wiresflavor)) + case ('holland','transition') + call update_current_holland(this, control, InvEps, InvMu) #ifdef CompileWithBerengerWires - case ('berenger') - do n = 1, Hwireslocal_Berenger%NumSegments - currentSegment => Hwireslocal_Berenger%Segments(n) - if (currentSegment%IndexSegment == node) then - found = .true. - this%segmentBerenger => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do -#endif -#ifdef CompileWithSlantedWires - case ('slanted', 'semistructured') - do n = 1, Hwireslocal_Slanted%NumSegments - currentSegment => Hwireslocal_Slanted%Segments(n) - if (currentSegment%ptr%Index == node) then - found = .true. - this%segmentSlanted => currentSegment%ptr - end if - end do + case ('berenger') + call update_current_berenger(this, InvEps, InvMu) #endif - end select - - if (.not. found) then - select case (trim(adjustl(wiresflavor))) - case ('holland', 'transition') - buscarabono: do iwi = 1, Hwireslocal%NumDifferentWires - do iwj = 1, media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%numsegmentos - if ((node == media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%origindex) .and. & - media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multirabo) then - node2 = media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multiraboDE - do n = 1, HWireslocal%NumCurrentSegments - currentSegment => HWireslocal%CurrentSegment(n) - if (currentSegment%origindex == node2) then - found = .true. - this%segment => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 - end if - end do - exit buscarabono - end if - end do - end do buscarabono #ifdef CompileWithSlantedWires - case ('slanted', 'semistructured') - do n = 1, Hwireslocal_Slanted%NumSegments - currentSegment => Hwireslocal_Slanted%Segments(n) - if (currentSegment%ptr%elotroindice == node) then - found = .true. - this%segmentSlanted => currentSegment%ptr - end if - end do + case ('slanted','semistructured') + call update_current_slanted(this) #endif - end select - end if + end select + end subroutine - if (.not. found) then - write (buff, '(a,4i7,a)') 'ERROR: WIRE probe ', node, iCoord, jCoord, kCoord, ' DOES NOT EXIST' - CALL WarnErrReport(buff, .true.) - end if - end subroutine find_segment - function get_output_path() result(outputPath) - character(len=BUFSIZE) :: outputPath - character(len=BUFSIZE) :: charNO - character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension, prefixNodeExtension + subroutine update_wire_charge_probe_output(this, step) + type(wire_charge_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step - write (charNO, '(i7)') node - prefixNodeExtension = 's'//trim(adjustl(charNO)) - probeBoundsExtension = get_probe_bounds_extension() - prefixFieldExtension = get_prefix_extension(field, mpidir) + this%nTime = this%nTime + 1 + this%timeStep(this%nTime) = step + this%chargeValue(this%nTime) = this%segment%ChargeMinus%ChargePresent + end subroutine - outputPath = & - trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_' & - //trim(adjustl(probeBoundsExtension))//'_'//trim(adjustl(prefixNodeExtension)) - return - end function get_output_path + !====================================================================== + ! FLUSH + !====================================================================== + subroutine flush_wire_current_probe_output(this) + type(wire_current_probe_output_t), intent(inout) :: this + integer :: i - function get_probe_bounds_extension() result(ext) - character(len=BUFSIZE) :: ext - character(len=BUFSIZE) :: chari, charj, chark + open(this%fileUnitTime, file=trim(this%path)//'_'//timeExtension//'_'//datFileExtension, & + status='old', position='append') - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord + do i = 1, this%nTime + write(this%fileUnitTime, fmt) this%timeStep(i), & + this%currentValues(i)%current, & + this%currentValues(i)%deltaVoltage, & + this%currentValues(i)%plusVoltage, & + this%currentValues(i)%minusVoltage, & + this%currentValues(i)%voltageDiference + end do + close(this%fileUnitTime) -#if CompileWithMPI - if (mpidir == 3) then - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) - elseif (mpidir == 2) then - ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) - elseif (mpidir == 1) then - ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) - else - call stoponerror(0,0,'Buggy error in mpidir. ') - end if -#else - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) -#endif + call clear_current_time_data(this) + end subroutine - return - end function get_probe_bounds_extension - end subroutine init_wire_current_probe_output + subroutine flush_wire_charge_probe_output(this) + type(wire_charge_probe_output_t), intent(inout) :: this + integer :: i - subroutine init_wire_charge_probe_output(this, coordinates, node, field, domain, outputTypeExtension, mpidir, wiresflavor) - type(wire_charge_probe_output_t), intent(out) :: this - integer(kind=SINGLE), intent(in) :: node - integer(kind=SINGLE), intent(in) :: field, mpidir - character(len=*), intent(in) :: outputTypeExtension, wiresflavor - type(domain_t), intent(in) :: domain - - type(Thinwires_t), pointer :: Hwireslocal - type(CurrentSegments), pointer :: currentSegment - type(cell_coordinate_t) :: coordinates - character(len=BUFSIZE) :: buff - integer(kind=SINGLE) :: n - if (trim(adjustl(wiresflavor)) == 'holland' .or. trim(adjustl(wiresflavor)) == 'transition') Hwireslocal => GetHwires() + open(this%fileUnitTime, file=trim(this%path)//'_'//timeExtension//'_'//datFileExtension, & + status='old', position='append') - call find_segment() + do i = 1, this%nTime + write(this%fileUnitTime, fmt) this%timeStep(i), this%chargeValue(i) + end do + close(this%fileUnitTime) - this%mainCoords = coordinates + call clear_charge_time_data(this) + end subroutine - this%component = field + subroutine find_current_segment(this, node, field, media, wiresflavor) + type(wire_current_probe_output_t), intent(inout) :: this + type(MediaData_t), intent(in) :: media(:) + integer(kind=SINGLE), intent(in) :: node, field + character(len=*), intent(in) :: wiresflavor + + type(Thinwires_t), pointer :: Hwireslocal + type(CurrentSegments), pointer :: seg +#ifdef CompileWithBerengerWires + type(TWires), pointer :: Hwireslocal_B +#endif +#ifdef CompileWithSlantedWires + type(WiresData), pointer :: Hwireslocal_S +#endif + + integer :: n, iwi, iwj, node2 + logical :: found + character(len=BUFSIZE) :: buff - this%domain = domain - this%path = get_output_path() + found = .false. + this%sign = 1 - contains - subroutine find_segment() - logical :: found = .false. - do n = 1, HWireslocal%NumCurrentSegments - currentSegment => HWireslocal%CurrentSegment(n) - if ((currentSegment%origindex == node) .and. & - (currentSegment%i == iCoord) .and. (currentSegment%j == jCoord) .and. (currentSegment%k == kCoord) .and. & - (currentSegment%tipofield*10000 == field)) then + select case (trim(adjustl(wiresflavor))) + case ('holland','transition') + Hwireslocal => GetHwires() + this%segment => Hwireslocal%NullSegment + + do n = 1, Hwireslocal%NumCurrentSegments + seg => Hwireslocal%CurrentSegment(n) + if (seg%origindex == node .and. & + seg%i == iCoord .and. seg%j == jCoord .and. seg%k == kCoord .and. & + seg%tipofield*10 == field) then found = .true. - this%segment => currentSegment - if (currentSegment%orientadoalreves) this%sign = -1 + this%segment => seg + if (seg%orientadoalreves) this%sign = -1 + exit end if end do - if (.not. found) then - write (buff, '(a,4i7,a)') 'ERROR: CHARGE probe ', node, iCoord, jCoord, kCoord, ' DOES NOT EXIST' - CALL WarnErrReport(buff, .true.) - end if - end subroutine find_segment - function get_output_path() result(outputPath) - character(len=BUFSIZE) :: outputPath - character(len=BUFSIZE) :: charNO - character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension, prefixNodeExtension +#ifdef CompileWithBerengerWires + case ('berenger') + Hwireslocal_B => GetHwires_Berenger() + do n = 1, Hwireslocal_B%NumSegments + if (Hwireslocal_B%Segments(n)%IndexSegment == node) then + found = .true. + this%segmentBerenger => Hwireslocal_B%Segments(n) + if (Hwireslocal_B%Segments(n)%orientadoalreves) this%sign = -1 + exit + end if + end do +#endif - write (charNO, '(i7)') node - prefixNodeExtension = 's'//trim(adjustl(charNO)) - probeBoundsExtension = get_probe_bounds_extension() - prefixFieldExtension = get_prefix_extension(field, mpidir) +#ifdef CompileWithSlantedWires + case ('slanted','semistructured') + Hwireslocal_S => GetHwires_Slanted() + do n = 1, Hwireslocal_S%NumSegments + if (Hwireslocal_S%Segments(n)%ptr%Index == node) then + found = .true. + this%segmentSlanted => Hwireslocal_S%Segments(n)%ptr + exit + end if + end do +#endif + end select + + ! --- multirabo fallback (Holland only) + if (.not. found .and. trim(adjustl(wiresflavor)) /= 'berenger') then + buscarabono: do iwi = 1, Hwireslocal%NumDifferentWires + do iwj = 1, media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%numsegmentos + if (node == media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%origindex .and. & + media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multirabo) then + + node2 = media(Hwireslocal%WireTipoMedio(iwi))%wire(1)%segm(iwj)%multiraboDE + do n = 1, Hwireslocal%NumCurrentSegments + seg => Hwireslocal%CurrentSegment(n) + if (seg%origindex == node2) then + found = .true. + this%segment => seg + if (seg%orientadoalreves) this%sign = -1 + exit buscarabono + end if + end do + end if + end do + end do buscarabono + end if + + if (.not. found) then + write(buff,'(a,4i7,a)') 'ERROR: WIRE probe ',node,iCoord,jCoord,kCoord,' DOES NOT EXIST' + call WarnErrReport(buff,.true.) + end if + end subroutine find_current_segment + + subroutine find_charge_segment(this, node, field, wiresflavor) + type(wire_charge_probe_output_t), intent(inout) :: this + integer(kind=SINGLE), intent(in) :: node, field + character(len=*), intent(in) :: wiresflavor + + type(Thinwires_t), pointer :: Hwireslocal + type(CurrentSegments), pointer :: seg + integer :: n + logical :: found + character(len=BUFSIZE) :: buff - outputPath = & - trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_' & - //trim(adjustl(probeBoundsExtension))//'_'//trim(adjustl(prefixNodeExtension)) + found = .false. + this%sign = 1 + + if (trim(adjustl(wiresflavor)) /= 'holland' .and. & + trim(adjustl(wiresflavor)) /= 'transition') then + call WarnErrReport('Charge probes only supported for holland wires', .true.) return - end function get_output_path + end if + + Hwireslocal => GetHwires() + + do n = 1, Hwireslocal%NumCurrentSegments + seg => Hwireslocal%CurrentSegment(n) + if (seg%origindex == node .and. & + seg%i == iCoord .and. seg%j == jCoord .and. seg%k == kCoord .and. & + seg%tipofield*10000 == field) then + found = .true. + this%segment => seg + if (seg%orientadoalreves) this%sign = -1 + exit + end if + end do - function get_probe_bounds_extension() result(ext) - character(len=BUFSIZE) :: ext - character(len=BUFSIZE) :: chari, charj, chark + if (.not. found) then + write(buff,'(a,4i7,a)') 'ERROR: CHARGE probe ',node,iCoord,jCoord,kCoord,' DOES NOT EXIST' + call WarnErrReport(buff,.true.) + end if + end subroutine find_charge_segment - write (chari, '(i7)') iCoord - write (charj, '(i7)') jCoord - write (chark, '(i7)') kCoord + function probe_bounds_extension(mpidir, coords) result(ext) + integer(kind=SINGLE), intent(in) :: mpidir + type(cell_coordinate_t), intent(in) :: coords + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: ci, cj, ck + + write(ci,'(i7)') coords%x + write(cj,'(i7)') coords%y + write(ck,'(i7)') coords%z #if CompileWithMPI - if (mpidir == 3) then - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) - elseif (mpidir == 2) then - ext = trim(adjustl(charj))//'_'//trim(adjustl(chark))//'_'//trim(adjustl(chari)) - elseif (mpidir == 1) then - ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) - else - call stoponerror(0,0,'Buggy error in mpidir. ') - end if + select case (mpidir) + case (3) + ext = trim(adjustl(ci))//'_'//trim(adjustl(cj))//'_'//trim(adjustl(ck)) + case (2) + ext = trim(adjustl(cj))//'_'//trim(adjustl(ck))//'_'//trim(adjustl(ci)) + case (1) + ext = trim(adjustl(ck))//'_'//trim(adjustl(ci))//'_'//trim(adjustl(cj)) + case default + call stoponerror(0,0,'Buggy error in mpidir.') + end select #else - ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) + ext = trim(adjustl(ci))//'_'//trim(adjustl(cj))//'_'//trim(adjustl(ck)) #endif + end function probe_bounds_extension - return - end function get_probe_bounds_extension + function build_output_path(outExt, field, node, mpidir, coords) result(path) + character(len=*), intent(in) :: outExt + integer(kind=SINGLE), intent(in) :: field, node, mpidir + type(cell_coordinate_t), intent(in) :: coords + character(len=BUFSIZE) :: path + character(len=BUFSIZE) :: nodeStr, fieldExt, boundsExt - end subroutine init_wire_charge_probe_output + write(nodeStr,'(i7)') node + fieldExt = get_prefix_extension(field, mpidir) + boundsExt = probe_bounds_extension(mpidir, coords) - subroutine create_wire_current_probe_output(this) + path = trim(outExt)//'_'//trim(fieldExt)//'_'// & + trim(boundsExt)//'_s'//trim(adjustl(nodeStr)) + end function build_output_path + + subroutine clear_current_time_data(this) type(wire_current_probe_output_t), intent(inout) :: this - character(len=BUFSIZE) :: file_time - integer(kind=SINGLE) :: err - err = 0 - file_time = trim(adjustl(this%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & - trim(adjustl(datFileExtension)) - call create_or_clear_file(file_time, this%fileUnitTime, err) - end subroutine create_wire_current_probe_output + this%timeStep = 0.0_RKIND_tiempo + this%currentValues%current = 0.0_RKIND + this%currentValues%deltaVoltage = 0.0_RKIND + this%currentValues%plusVoltage = 0.0_RKIND + this%currentValues%minusVoltage = 0.0_RKIND + this%currentValues%voltageDiference = 0.0_RKIND + this%nTime = 0 + end subroutine clear_current_time_data - subroutine create_wire_charge_probe_output(this) - character(len=BUFSIZE) :: file_time + subroutine clear_charge_time_data(this) type(wire_charge_probe_output_t), intent(inout) :: this - integer(kind=SINGLE) :: err - err = 0 - file_time = trim(adjustl(this%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & - trim(adjustl(datFileExtension)) - call create_or_clear_file(file_time, this%fileUnitTime, err) - end subroutine create_wire_charge_probe_output + this%timeStep = 0.0_RKIND_tiempo + this%chargeValue = 0.0_RKIND + this%nTime = 0 + end subroutine clear_charge_time_data - subroutine update_wire_current_probe_output(this, step, control, InvEps, InvMu) + subroutine update_current_holland(this, control, InvEps, InvMu) type(wire_current_probe_output_t), intent(inout) :: this - real(kind=RKIND_tiempo), intent(in) :: step type(sim_control_t), intent(in) :: control - real(KIND=RKIND), pointer, dimension(:), intent(in) :: InvEps, InvMu + real(kind=RKIND), intent(in) :: InvEps(:), InvMu(:) - type(CurrentSegments), pointer :: segmDumm -#ifdef CompileWithBerengerWires - type(TSegment), pointer :: segmDumm_Berenger -#endif -#ifdef CompileWithSlantedWires - class(Segment), pointer :: segmDumm_Slanted -#endif + type(CurrentSegments), pointer :: seg - select case (trim(adjustl(control%wiresflavor))) - case ('holland', 'transition') - this%nTime = this%nTime + 1 - this%timeStep(this%nTime) = step - SegmDumm => this%segment - - this%currentValues(this%nTime)%current = this%sign*SegmDumm%currentpast - this%currentValues(this%nTime)%deltaVoltage = -SegmDumm%Efield_wire2main*SegmDumm%delta - - if (control%wirecrank) then - this%currentValues(this%nTime)%plusVoltage = this%sign* & - (((SegmDumm%ChargePlus%ChargePresent)))*SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) - this%currentValues(this%nTime)%minusVoltage = this%sign* & - (((SegmDumm%ChargeMinus%ChargePresent)))*SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) - else - this%currentValues(this%nTime)%plusVoltage = this%sign* & - (((SegmDumm%ChargePlus%ChargePresent + SegmDumm%ChargePlus%ChargePast))/2.0_RKIND)* & - SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) - this%currentValues(this%nTime)%minusVoltage = this%sign* & - (((SegmDumm%ChargeMinus%ChargePresent + SegmDumm%ChargeMinus%ChargePast))/2.0_RKIND)* & - SegmDumm%Lind*(InvMu(SegmDumm%indexmed)*InvEps(SegmDumm%indexmed)) - end if + seg => this%segment - this%currentValues(this%nTime)%voltageDiference = & - this%currentValues(this%nTime)%plusVoltage - this%currentValues(this%nTime)%minusVoltage + this%currentValues(this%nTime)%current = & + this%sign * seg%currentpast -#ifdef CompileWithBerengerWires - case ('berenger') - this%nTime = this%nTime + 1 - this%timeStep(this%nTime) = step - SegmDumm_Berenger => this%segmentBerenger - - this%currentValues(this%nTime)%current = this%sign*SegmDumm_Berenger%currentpast - this%currentValues(this%nTime)%deltaVoltage = -SegmDumm_Berenger%field*SegmDumm_Berenger%dl - - this%currentValues(this%nTime)%plusVoltage = this%sign* & - (((SegmDumm_Berenger%ChargePlus + SegmDumm_Berenger%ChargePlusPast))/2.0_RKIND)* & - SegmDumm_Berenger%L*(InvMu(SegmDumm_Berenger%imed)*InvEps(SegmDumm_Berenger%imed)) - this%currentValues(this%nTime)%minusVoltage = this%sign* & - (((SegmDumm_Berenger%ChargeMinus + SegmDumm_Berenger%ChargeMinusPast))/2.0_RKIND)* & - SegmDumm_Berenger%L*(InvMu(SegmDumm_Berenger%imed)*InvEps(SegmDumm_Berenger%imed)) - this%currentValues(this%nTime)%voltageDiference = & - this%currentValues(this%nTime)%plusVoltage - this%currentValues(this%nTime)%minusVoltage + this%currentValues(this%nTime)%deltaVoltage = & + - seg%Efield_wire2main * seg%delta -#endif -#ifdef CompileWithSlantedWires - case ('slanted', 'semistructured') - this%nTime = this%nTime + 1 - this%timeStep(this%nTime) = step - SegmDumm_Slanted => this%segmentSlanted - - this%currentValues(this%nTime)%current = SegmDumm_Slanted%Currentpast !ojo: slanted ya los orienta bien y no hay que multiplicar por valorsigno - this%currentValues(this%nTime)%deltaVoltage = -SegmDumm_Slanted%field*SegmDumm_Slanted%dl - this%currentValues(this%nTime)%plusVoltage = & - (((SegmDumm_Slanted%Voltage(iPlus)%ptr%Voltage + SegmDumm_Slanted%Voltage(iPlus)%ptr%VoltagePast))/2.0_RKIND) - this%currentValues(this%nTime)%minusVoltage = & - (((SegmDumm_Slanted%Voltage(iMinus)%ptr%Voltage + SegmDumm_Slanted%Voltage(iMinus)%ptr%VoltagePast))/2.0_RKIND) - this%currentValues(this%nTime)%voltageDiference = & - this%currentValues(this%nTime)%plusVoltage - this%currentValues(this%nTime)%minusVoltage -#endif - end select + if (control%wirecrank) then + this%currentValues(this%nTime)%plusVoltage = this%sign * & + (seg%ChargePlus%ChargePresent) * seg%Lind * & + (InvMu(seg%indexmed) * InvEps(seg%indexmed)) - end subroutine + this%currentValues(this%nTime)%minusVoltage = this%sign * & + (seg%ChargeMinus%ChargePresent) * seg%Lind * & + (InvMu(seg%indexmed) * InvEps(seg%indexmed)) + else + this%currentValues(this%nTime)%plusVoltage = this%sign * & + ((seg%ChargePlus%ChargePresent + seg%ChargePlus%ChargePast) / 2.0_RKIND) * & + seg%Lind * (InvMu(seg%indexmed) * InvEps(seg%indexmed)) - subroutine update_wire_charge_probe_output(this, step) - type(wire_charge_probe_output_t), intent(inout) :: this - real(kind=RKIND_tiempo), intent(in) :: step - type(CurrentSegments), pointer :: segmDumm + this%currentValues(this%nTime)%minusVoltage = this%sign * & + ((seg%ChargeMinus%ChargePresent + seg%ChargeMinus%ChargePast) / 2.0_RKIND) * & + seg%Lind * (InvMu(seg%indexmed) * InvEps(seg%indexmed)) + end if - this%nTime = this%nTime + 1 - this%timeStep(this%nTime) = step - SegmDumm => this%segment - this%chargeValue(this%nTime) = SegmDumm%ChargeMinus%ChargePresent - end subroutine update_wire_charge_probe_output + this%currentValues(this%nTime)%voltageDiference = & + this%currentValues(this%nTime)%plusVoltage - & + this%currentValues(this%nTime)%minusVoltage + end subroutine update_current_holland - subroutine flush_wire_current_probe_output(this) +#ifdef CompileWithBerengerWires + subroutine update_current_berenger(this, InvEps, InvMu) type(wire_current_probe_output_t), intent(inout) :: this - character(len=BUFSIZE) :: filename - integer :: i + real(kind=RKIND), intent(in) :: InvEps(:), InvMu(:) - filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) - open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") + type(TSegment), pointer :: seg - do i = 1, this%nTime - write (this%fileUnitTime, fmt) this%timeStep(i), & - this%currentValues%current, & - this%currentValues%deltaVoltage, & - this%currentValues%plusVoltage, & - this%currentValues%minusVoltage, & - this%currentValues%voltageDiference - end do - close (this%fileUnitTime) + seg => this%segmentBerenger - call clear_time_data() - contains - subroutine clear_time_data() - this%timeStep = 0.0_RKIND_tiempo + this%currentValues(this%nTime)%current = & + this%sign * seg%currentpast - this%currentValues%current = 0.0_RKIND - this%currentValues%deltaVoltage = 0.0_RKIND - this%currentValues%plusVoltage = 0.0_RKIND - this%currentValues%minusVoltage = 0.0_RKIND - this%currentValues%voltageDiference = 0.0_RKIND + this%currentValues(this%nTime)%deltaVoltage = & + - seg%field * seg%dl - this%nTime = 0 - end subroutine clear_time_data - end subroutine flush_wire_current_probe_output + this%currentValues(this%nTime)%plusVoltage = this%sign * & + ((seg%ChargePlus + seg%ChargePlusPast) / 2.0_RKIND) * & + seg%L * (InvMu(seg%imed) * InvEps(seg%imed)) - subroutine flush_wire_charge_probe_output(this) - type(wire_charge_probe_output_t), intent(inout) :: this - character(len=BUFSIZE) :: filename - integer :: i + this%currentValues(this%nTime)%minusVoltage = this%sign * & + ((seg%ChargeMinus + seg%ChargeMinusPast) / 2.0_RKIND) * & + seg%L * (InvMu(seg%imed) * InvEps(seg%imed)) + + this%currentValues(this%nTime)%voltageDiference = & + this%currentValues(this%nTime)%plusVoltage - & + this%currentValues(this%nTime)%minusVoltage + end subroutine update_current_berenger +#endif + +#ifdef CompileWithSlantedWires + subroutine update_current_slanted(this) + type(wire_current_probe_output_t), intent(inout) :: this - filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) - open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") + class(Segment), pointer :: seg - do i = 1, this%nTime - write (this%fileUnitTime, fmt) this%timeStep(i), & - this%chargeValue - end do - close (this%fileUnitTime) - call clear_time_data() - contains - subroutine clear_time_data() - this%timeStep = 0.0_RKIND_tiempo + seg => this%segmentSlanted - this%chargeValue = 0.0_RKIND + this%currentValues(this%nTime)%current = & + seg%Currentpast + + this%currentValues(this%nTime)%deltaVoltage = & + - seg%field * seg%dl + + this%currentValues(this%nTime)%plusVoltage = & + (seg%Voltage(iPlus)%ptr%Voltage + & + seg%Voltage(iPlus)%ptr%VoltagePast) / 2.0_RKIND + + this%currentValues(this%nTime)%minusVoltage = & + (seg%Voltage(iMinus)%ptr%Voltage + & + seg%Voltage(iMinus)%ptr%VoltagePast) / 2.0_RKIND + + this%currentValues(this%nTime)%voltageDiference = & + this%currentValues(this%nTime)%plusVoltage - & + this%currentValues(this%nTime)%minusVoltage + end subroutine update_current_slanted +#endif - this%nTime = 0 - end subroutine clear_time_data - end subroutine flush_wire_charge_probe_output end module mod_wireProbeOutput From 9bca2b98dc2d319f41e5c84a52ecf8f6836e0d89 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 13 Jan 2026 13:58:44 +0100 Subject: [PATCH 58/67] Movie probe refactor --- src_output/movieProbeOutput.F90 | 599 +++++++++++++++----------------- 1 file changed, 284 insertions(+), 315 deletions(-) diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index e3e15f07..c5768c7a 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -3,11 +3,12 @@ module mod_movieProbeOutput use Report use outputTypes use mod_outputUtils + use vtk_fortran implicit none private !=========================== - ! Public interface summary + ! Public interface !=========================== public :: init_movie_probe_output public :: update_movie_probe_output @@ -15,10 +16,13 @@ module mod_movieProbeOutput !=========================== !=========================== - ! Private interface summary + ! Private helpers !=========================== ! Data Extraction & Processing + private :: find_and_store_important_coords private :: count_required_coords + private :: store_required_coords + private :: get_checker_and_component private :: save_current_module private :: save_current_component private :: save_current @@ -29,8 +33,9 @@ module mod_movieProbeOutput ! Output & File Management private :: write_vtu_timestep private :: update_pvd + private :: clear_memory_data - ! Validation Logic (Functions) + ! Validation Logic private :: isValidPointForCurrent private :: isValidPointForField private :: volumicCurrentRequest @@ -38,7 +43,6 @@ module mod_movieProbeOutput private :: volumicMagneticRequest private :: componentCurrentRequest private :: componentFieldRequest - !=========================== abstract interface logical function logical_func(component, i, j, k, problemInfo) @@ -50,112 +54,214 @@ end function logical_func contains + !=========================== + ! Public routines + !=========================== + subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, control, problemInfo, outputTypeExtension) type(movie_probe_output_t), intent(out) :: this - type(cell_coordinate_t), intent(in) :: lowerBound, upperBound - integer(kind=SINGLE), intent(in) :: field - character(len=BUFSIZE), intent(in) :: outputTypeExtension - - type(sim_control_t), intent(in) :: control - type(problem_info_t), intent(in) :: problemInfo - - type(domain_t), intent(in) :: domain + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound + integer(kind=SINGLE), intent(in) :: field + type(domain_t), intent(in) :: domain + type(sim_control_t), intent(in) :: control + type(problem_info_t), intent(in) :: problemInfo + character(len=BUFSIZE), intent(in) :: outputTypeExtension this%mainCoords = lowerBound - this%auxCoords = upperBound - this%component = field !This can refer to electric, magnetic or currentDensity - this%domain = domain - this%path = get_output_path() + this%auxCoords = upperBound + this%component = field + this%domain = domain + this%path = get_output_path(this, outputTypeExtension, field, control%mpidir) call find_and_store_important_coords(this, problemInfo) - call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) - if (any(VOLUMIC_M_MEASURE == this%component)) then + ! Allocate value arrays based on component type + if (any(VOLUMIC_M_MEASURE == field)) then + call alloc_and_init(this%xValueForTime, BuffObse, this%nPoints, 0.0_RKIND) + call alloc_and_init(this%yValueForTime, BuffObse, this%nPoints, 0.0_RKIND) + call alloc_and_init(this%zValueForTime, BuffObse, this%nPoints, 0.0_RKIND) + else if (any(VOLUMIC_X_MEASURE == field)) then call alloc_and_init(this%xValueForTime, BuffObse, this%nPoints, 0.0_RKIND) + else if (any(VOLUMIC_Y_MEASURE == field)) then call alloc_and_init(this%yValueForTime, BuffObse, this%nPoints, 0.0_RKIND) + else if (any(VOLUMIC_Z_MEASURE == field)) then call alloc_and_init(this%zValueForTime, BuffObse, this%nPoints, 0.0_RKIND) else - if (any(VOLUMIC_X_MEASURE == this%component)) then - call alloc_and_init(this%xValueForTime, BuffObse, this%nPoints, 0.0_RKIND) - elseif (any(VOLUMIC_Y_MEASURE == this%component)) then - call alloc_and_init(this%yValueForTime, BuffObse, this%nPoints, 0.0_RKIND) - elseif (any(VOLUMIC_Z_MEASURE == this%component)) then - call alloc_and_init(this%zValueForTime, BuffObse, this%nPoints, 0.0_RKIND) - else - call StopOnError(control%layoutnumber, control%size, "Unexpected output type for movie probe") - end if + call StopOnError(control%layoutnumber, control%size, "Unexpected output type for movie probe") end if - - 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_movie_probe_output subroutine update_movie_probe_output(this, step, fieldsReference, control, problemInfo) type(movie_probe_output_t), intent(inout) :: this - real(kind=RKIND_tiempo), intent(in) :: step - type(sim_control_t), intent(in) :: control - type(problem_info_t), intent(in) :: problemInfo - type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND_tiempo), intent(in) :: step + type(fields_reference_t), intent(in) :: fieldsReference + type(sim_control_t), intent(in) :: control + type(problem_info_t), intent(in) :: problemInfo integer(kind=4) :: request request = this%component - this%nTime = this%nTime + 1 + ! Determine which save routine to call if (any(VOLUMIC_M_MEASURE == request)) then select case (request) - case (iCur); call save_current_module(this, fieldsReference, step, problemInfo) - case (iMEC); call save_field_module(this, fieldsReference%E, request, step, problemInfo) - case (iMHC); call save_field_module(this, fieldsReference%H, request, step, problemInfo) - case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") + case (iCur) + call save_current_module(this, fieldsReference, step, problemInfo) + case (iMEC) + call save_field_module(this, fieldsReference%E, request, step, problemInfo) + case (iMHC) + call save_field_module(this, fieldsReference%H, request, step, problemInfo) + case default + call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select - else if (any(VOLUMIC_X_MEASURE == request)) then select case (request) - case (iCurX); call save_current_component(this, this%xValueForTime, fieldsReference, step, problemInfo, iEx) - case (iExC); call save_field_component(this, this%xValueForTime, fieldsReference%E%x, step, problemInfo, iEx) - case (iHxC); call save_field_component(this, this%xValueForTime, fieldsReference%H%x, step, problemInfo, iHx) - case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") + case (iCurX) + call save_current_component(this, this%xValueForTime, fieldsReference, step, problemInfo, iEx) + case (iExC) + call save_field_component(this, this%xValueForTime, fieldsReference%E%x, step, problemInfo, iEx) + case (iHxC) + call save_field_component(this, this%xValueForTime, fieldsReference%H%x, step, problemInfo, iHx) + case default + call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select - else if (any(VOLUMIC_Y_MEASURE == request)) then select case (request) - case (iCurY); call save_current_component(this, this%yValueForTime, fieldsReference, step, problemInfo, iEy) - case (iEyC); call save_field_component(this, this%yValueForTime, fieldsReference%E%y, step, problemInfo, iEy) - case (iHyC); call save_field_component(this, this%yValueForTime, fieldsReference%H%y, step, problemInfo, iHy) - case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") + case (iCurY) + call save_current_component(this, this%yValueForTime, fieldsReference, step, problemInfo, iEy) + case (iEyC) + call save_field_component(this, this%yValueForTime, fieldsReference%E%y, step, problemInfo, iEy) + case (iHyC) + call save_field_component(this, this%yValueForTime, fieldsReference%H%y, step, problemInfo, iHy) + case default + call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select - else if (any(VOLUMIC_Z_MEASURE == request)) then select case (request) - case (iCurZ); call save_current_component(this, this%zValueForTime, fieldsReference, step, problemInfo, iEz) - case (iEzC); call save_field_component(this, this%zValueForTime, fieldsReference%E%z, step, problemInfo, iEz) - case (iHzC); call save_field_component(this, this%zValueForTime, fieldsReference%H%z, step, problemInfo, iHz) - case default; call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") + case (iCurZ) + call save_current_component(this, this%zValueForTime, fieldsReference, step, problemInfo, iEz) + case (iEzC) + call save_field_component(this, this%zValueForTime, fieldsReference%E%z, step, problemInfo, iEz) + case (iHzC) + call save_field_component(this, this%zValueForTime, fieldsReference%H%z, step, problemInfo, iHz) + case default + call StopOnError(control%layoutnumber, control%size, "Volumic measure not supported") end select end if end subroutine update_movie_probe_output - subroutine save_current_module(this, fieldsReference, simTime, problemInfo) + subroutine flush_movie_probe_output(this) + type(movie_probe_output_t), intent(inout) :: this + integer :: i + + do i = 1, this%nTime + call update_pvd(this, i, this%fileUnitTime) + end do + + call clear_memory_data(this) + end subroutine flush_movie_probe_output + + !=========================== + ! Private routines + !=========================== + + function get_output_path(this, outputTypeExtension, field, mpidir) result(path) + type(movie_probe_output_t), intent(in) :: this + character(len=*), intent(in) :: outputTypeExtension + integer(kind=SINGLE), intent(in) :: field, mpidir + character(len=BUFSIZE) :: path, probeBoundsExtension, prefixFieldExtension + + probeBoundsExtension = get_coordinates_extension(this%mainCoords, this%auxCoords, mpidir) + prefixFieldExtension = get_prefix_extension(field, mpidir) + path = trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) + end function get_output_path + + subroutine find_and_store_important_coords(this, problemInfo) type(movie_probe_output_t), intent(inout) :: this - type(fields_reference_t), intent(in) :: fieldsReference - real(kind=RKIND_tiempo), intent(in) :: simTime type(problem_info_t), intent(in) :: problemInfo - integer :: i, j, k, coordIdx + call count_required_coords(this, problemInfo) + call alloc_and_init(this%coords, 3, this%nPoints, 0_SINGLE) + call store_required_coords(this, problemInfo) + end subroutine find_and_store_important_coords - this%timeStep(this%nTime) = simTime + subroutine count_required_coords(this, problemInfo) + type(movie_probe_output_t), intent(inout) :: this + type(problem_info_t), intent(in) :: problemInfo + + integer :: i, j, k + procedure(logical_func), pointer :: checker => null() + integer :: component, count + + call get_checker_and_component(this, checker, component) + + count = 0 + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (checker(component, i, j, k, problemInfo)) count = count + 1 + end do + end do + end do + + this%nPoints = count + end subroutine count_required_coords + + subroutine store_required_coords(this, problemInfo) + type(movie_probe_output_t), intent(inout) :: this + type(problem_info_t), intent(in) :: problemInfo + + integer :: i, j, k + integer :: count + procedure(logical_func), pointer :: checker => null() + integer :: component + + call get_checker_and_component(this, checker, component) + count = 0 + do i = this%mainCoords%x, this%auxCoords%x + do j = this%mainCoords%y, this%auxCoords%y + do k = this%mainCoords%z, this%auxCoords%z + if (checker(component, i, j, k, problemInfo)) then + count = count + 1 + this%coords(1, count) = i + this%coords(2, count) = j + this%coords(3, count) = k + end if + end do + end do + end do + end subroutine store_required_coords + + subroutine get_checker_and_component(this, checker, component) + type(movie_probe_output_t), intent(in) :: this + procedure(logical_func), pointer, intent(out) :: checker + integer, intent(out) :: component + + select case (this%component) + case (iCur); checker => volumicCurrentRequest; component = iCur + case (iMEC); checker => volumicElectricRequest; component = iMEC + case (iMHC); checker => volumicMagneticRequest; component = iMHC + case (iCurx); checker => componentCurrentRequest; component = iEx + case (iExC); checker => componentFieldRequest; component = iEx + case (iHxC); checker => componentFieldRequest; component = iHx + case (iCurY); checker => componentCurrentRequest; component = iEy + case (iEyC); checker => componentFieldRequest; component = iEy + case (iHyC); checker => componentFieldRequest; component = iHy + case (iCurZ); checker => componentCurrentRequest; component = iEz + case (iEzC); checker => componentFieldRequest; component = iEz + case (iHzC); checker => componentFieldRequest; component = iHz + end select + end subroutine get_checker_and_component + + subroutine save_current_module(this, fieldsReference, simTime, problemInfo) + type(movie_probe_output_t), intent(inout) :: this + type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo + integer :: i, j, k, coordIdx + this%timeStep(this%nTime) = simTime coordIdx = 0 do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y @@ -169,20 +275,18 @@ subroutine save_current_module(this, fieldsReference, simTime, problemInfo) end do end do end do - end subroutine + end subroutine save_current_module subroutine save_current_component(this, currentData, fieldsReference, simTime, problemInfo, fieldDir) type(movie_probe_output_t), intent(inout) :: this - real(kind=RKIND), intent(inout) :: currentData(:, :) - type(fields_reference_t), intent(in) :: fieldsReference - real(kind=RKIND_tiempo), intent(in) :: simTime - type(problem_info_t), intent(in) :: problemInfo - integer, intent(in) :: fieldDir + real(kind=RKIND), intent(inout) :: currentData(:, :) + type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: fieldDir integer :: i, j, k, coordIdx - this%timeStep(this%nTime) = simTime - coordIdx = 0 do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y @@ -194,122 +298,84 @@ subroutine save_current_component(this, currentData, fieldsReference, simTime, p end do end do end do - end subroutine + end subroutine save_current_component subroutine save_current(currentData, timeIdx, coordIdx, field, i, j, k, fieldsReference) - real(kind=RKIND), intent(inout) :: currentData(:, :) - integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx, field, i, j, k - type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND), intent(inout) :: currentData(:, :) + integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx, field, i, j, k + type(fields_reference_t), intent(in) :: fieldsReference - real(kind=RKIND) :: jdir - jdir = computeJ(field, i, j, k, fieldsReference) - currentData(timeIdx, coordIdx) = jdir - end subroutine + currentData(timeIdx, coordIdx) = computeJ(field, i, j, k, fieldsReference) + end subroutine save_current subroutine save_field_module(this, field, request, simTime, problemInfo) type(movie_probe_output_t), intent(inout) :: this - type(field_data_t), intent(in) :: field - real(kind=RKIND_tiempo), intent(in) :: simTime - type(problem_info_t), intent(in) :: problemInfo - integer, intent(in) :: request + type(field_data_t), intent(in) :: field + real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: request integer :: i, j, k, coordIdx - this%timeStep(this%nTime) = simTime - coordIdx = 0 do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y do k = this%mainCoords%z, this%auxCoords%z if (isValidPointForField(request, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_field(this%xValueForTime, this%nTime, coordIdx, field%x(i, j, k)) - call save_field(this%yValueForTime, this%nTime, coordIdx, field%y(i, j, k)) - call save_field(this%zValueForTime, this%nTime, coordIdx, field%z(i, j, k)) + call save_field(this%xValueForTime, this%nTime, coordIdx, field%x(i,j,k)) + call save_field(this%yValueForTime, this%nTime, coordIdx, field%y(i,j,k)) + call save_field(this%zValueForTime, this%nTime, coordIdx, field%z(i,j,k)) end if end do end do end do - - end subroutine + end subroutine save_field_module subroutine save_field_component(this, fieldData, fieldComponent, simTime, problemInfo, fieldDir) type(movie_probe_output_t), intent(inout) :: this - real(kind=RKIND), intent(inout) :: fieldData(:, :) - real(kind=RKIND), intent(in) :: fieldComponent(:, :, :) - real(kind=RKIND_tiempo), intent(in) :: simTime - type(problem_info_t), intent(in) :: problemInfo - integer, intent(in) :: fieldDir + real(kind=RKIND), intent(inout) :: fieldData(:, :) + real(kind=RKIND), intent(in) :: fieldComponent(:, :, :) + real(kind=RKIND_tiempo), intent(in) :: simTime + type(problem_info_t), intent(in) :: problemInfo + integer, intent(in) :: fieldDir integer :: i, j, k, coordIdx - this%timeStep(this%nTime) = simTime - coordIdx = 0 do i = this%mainCoords%x, this%auxCoords%x do j = this%mainCoords%y, this%auxCoords%y do k = this%mainCoords%z, this%auxCoords%z if (isValidPointForField(fieldDir, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 - call save_field(fieldData, this%nTime, coordIdx, fieldComponent(i, j, k)) + call save_field(fieldData, this%nTime, coordIdx, fieldComponent(i,j,k)) end if end do end do end do - end subroutine + end subroutine save_field_component subroutine save_field(fieldData, timeIdx, coordIdx, fieldValue) - real(kind=RKIND), intent(inout) :: fieldData(:, :) + real(kind=RKIND), intent(inout) :: fieldData(:, :) integer(kind=SINGLE), intent(in) :: timeIdx, coordIdx - real(kind=RKIND), intent(in) :: fieldValue - fieldData(timeIdx, coordIdx) = fieldValue - end subroutine + real(kind=RKIND), intent(in) :: fieldValue - subroutine flush_movie_probe_output(this) - type(movie_probe_output_t), intent(inout) :: this - integer :: status, i - - do i = 1, this%nTime - call update_pvd(this, i, this%fileUnitTime) - end do - call clear_memory_data() - - contains - subroutine clear_memory_data() - this%nTime = 0 - this%timeStep = 0.0_RKIND - if (any(VOLUMIC_M_MEASURE == this%component)) then - this%xValueForTime = 0.0_RKIND - this%yValueForTime = 0.0_RKIND - this%zValueForTime = 0.0_RKIND - else if (any(VOLUMIC_X_MEASURE == this%component)) then - this%xValueForTime = 0.0_RKIND - else if (any(VOLUMIC_Y_MEASURE == this%component)) then - this%yValueForTime = 0.0_RKIND - else if (any(VOLUMIC_Z_MEASURE == this%component)) then - this%zValueForTime = 0.0_RKIND - end if - end subroutine clear_memory_data - - end subroutine flush_movie_probe_output + fieldData(timeIdx, coordIdx) = fieldValue + end subroutine save_field subroutine write_vtu_timestep(this, stepIndex, filename) - use vtk_fortran - implicit none - type(movie_probe_output_t), intent(in) :: this - integer, intent(in) :: stepIndex - character(len=*), intent(in) :: filename + integer, intent(in) :: stepIndex + character(len=*), intent(in) :: filename - character(len=BUFSIZE) :: requestName - type(vtk_file) :: vtkOutput - integer :: ierr, npts, i + integer :: npts, i, ierr real(kind=RKIND), allocatable :: x(:), y(:), z(:) real(kind=RKIND), allocatable :: Componentx(:), Componenty(:), Componentz(:) logical :: writeX, writeY, writeZ + character(len=BUFSIZE) :: requestName + type(vtk_file) :: vtkOutput - !================= Determine the measure type ================= - + !================= Determine measure type ================= if (any(CURRENT_MEASURE == this%component)) then requestName = 'Current' else if (any(ELECTRIC_FIELD_MEASURE == this%component)) then @@ -320,197 +386,97 @@ subroutine write_vtu_timestep(this, stepIndex, filename) requestName = 'Unknown' end if - !================= Determine which components to write ================= writeX = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_X_MEASURE == this%component) writeY = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_Y_MEASURE == this%component) writeZ = any(VOLUMIC_M_MEASURE == this%component) .or. any(VOLUMIC_Z_MEASURE == this%component) - !================= Allocate and fill coordinates ================= npts = this%nPoints - allocate (x(npts), y(npts), z(npts)) + allocate(x(npts), y(npts), z(npts)) do i = 1, npts - x(i) = this%coords(1, i) - y(i) = this%coords(2, i) - z(i) = this%coords(3, i) + x(i) = this%coords(1,i) + y(i) = this%coords(2,i) + z(i) = this%coords(3,i) end do ierr = vtkOutput%initialize(format='ASCII', filename=trim(filename), mesh_topology='UnstructuredGrid') ierr = vtkOutput%xml_writer%write_geo(n=npts, x=x, y=y, z=z) - !================= Allocate and fill component arrays ================= if (writeX) then - allocate (Componentx(npts)) - do i = 1, npts + allocate(Componentx(npts)) + do i=1, npts Componentx(i) = this%xValueForTime(stepIndex, i) end do - end if - - if (writeY) then - allocate (Componenty(npts)) - do i = 1, npts - Componenty(i) = this%yValueForTime(stepIndex, i) - end do - end if - - if (writeZ) then - allocate (Componentz(npts)) - do i = 1, npts - Componentz(i) = this%zValueForTime(stepIndex, i) - end do - end if - - !================= Write arrays to VTK ================= - if (writeX) then ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'X', x=Componentx) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - deallocate (Componentx) + deallocate(Componentx) end if if (writeY) then + allocate(Componenty(npts)) + do i=1, npts + Componenty(i) = this%yValueForTime(stepIndex, i) + end do ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'Y', x=Componenty) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - deallocate (Componenty) + deallocate(Componenty) end if if (writeZ) then + allocate(Componentz(npts)) + do i=1, npts + Componentz(i) = this%zValueForTime(stepIndex, i) + end do ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') ierr = vtkOutput%xml_writer%write_dataarray(data_name=trim(adjustl(requestName))//'Z', x=Componentz) ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - deallocate (Componentz) + deallocate(Componentz) end if ierr = vtkOutput%xml_writer%finalize() - deallocate (x, y, z) - + deallocate(x, y, z) end subroutine write_vtu_timestep subroutine update_pvd(this, stepIndex, unitPVD) - implicit none type(movie_probe_output_t), intent(in) :: this - integer, intent(in) :: stepIndex - integer, intent(in) :: unitPVD - character(len=64) :: ts - character(len=256) :: filename - - ! Generamos nombre del archivo VTU para este timestep - write (filename, '(A,A,I4.4,A)') trim(this%path), '_ts', stepIndex, '.vtu' + integer, intent(in) :: stepIndex, unitPVD + character(len=256) :: filename + character(len=64) :: ts - ! Escribimos el VTU correspondiente + write(filename,'(A,A,I4.4,A)') trim(this%path), '_ts', stepIndex, '.vtu' call write_vtu_timestep(this, stepIndex, filename) - ! Añadimos entrada en el PVD - write (ts, '(ES16.8)') this%timeStep(stepIndex) - write (unitPVD, '(A)') ' ' + write(ts,'(ES16.8)') this%timeStep(stepIndex) + write(unitPVD,'(A)') ' ' end subroutine update_pvd - subroutine find_and_store_important_coords(this, problemInfo) - type(movie_probe_output_t), intent(inout) :: this - type(problem_info_t), intent(in) :: problemInfo - - call count_required_coords(this, problemInfo) - call alloc_and_init(this%coords, 3, this%nPoints, 0_SINGLE) - call store_required_coords(this, problemInfo) - end subroutine - - subroutine count_required_coords(this, problemInfo) + subroutine clear_memory_data(this) type(movie_probe_output_t), intent(inout) :: this - type(problem_info_t), intent(in) :: problemInfo - integer :: i, j, k - - procedure(logical_func), pointer :: checker => null() ! Pointer to logical function - integer :: component, count - call get_checker_and_component(this, checker, component) - - count = 0 - do i = this%mainCoords%x, this%auxCoords%x - do j = this%mainCoords%y, this%auxCoords%y - do k = this%mainCoords%z, this%auxCoords%z - if (checker(component, i, j, k, problemInfo)) count = count + 1 - end do - end do - end do - - this%nPoints = count - - end subroutine - - subroutine store_required_coords(this, problemInfo) - type(movie_probe_output_t), intent(inout) :: this - type(problem_info_t), intent(in) :: problemInfo - - integer :: i, j, k - - procedure(logical_func), pointer :: checker => null() ! Pointer to logical function - integer :: component, count - call get_checker_and_component(this, checker, component) - - count = 0 - do i = this%mainCoords%x, this%auxCoords%x - do j = this%mainCoords%y, this%auxCoords%y - do k = this%mainCoords%z, this%auxCoords%z - if (checker(component, i, j, k, problemInfo)) then - count = count + 1 - this%coords(1, count) = i - this%coords(2, count) = j - this%coords(3, count) = k - end if - end do - end do - end do - end subroutine - - subroutine get_checker_and_component(this, checker, component) - type(movie_probe_output_t), intent(in) :: this - procedure(logical_func), pointer, intent(out) :: checker - integer, intent(out) :: component + this%nTime = 0 + this%timeStep = 0.0_RKIND + if (any(VOLUMIC_M_MEASURE == this%component)) then + this%xValueForTime = 0.0_RKIND + this%yValueForTime = 0.0_RKIND + this%zValueForTime = 0.0_RKIND + else if (any(VOLUMIC_X_MEASURE == this%component)) then + this%xValueForTime = 0.0_RKIND + else if (any(VOLUMIC_Y_MEASURE == this%component)) then + this%yValueForTime = 0.0_RKIND + else if (any(VOLUMIC_Z_MEASURE == this%component)) then + this%zValueForTime = 0.0_RKIND + end if + end subroutine clear_memory_data - select case (this%component) - case (iCur) - checker => volumicCurrentRequest - component = iCur - case (iMEC) - checker => volumicElectricRequest - component = iMEC - case (iMHC) - checker => volumicMagneticRequest - component = iMHC - case (iCurx) - checker => componentCurrentRequest - component = iEx - case (iExC) - checker => componentFieldRequest - component = iEx - case (iHxC) - checker => componentFieldRequest - component = iHx - case (iCurY) - checker => componentCurrentRequest - component = iEy - case (iEyC) - checker => componentFieldRequest - component = iEy - case (iHyC) - checker => componentFieldRequest - component = iHy - case (iCurZ) - checker => componentCurrentRequest - component = iEz - case (iEzC) - checker => componentFieldRequest - component = iEz - case (iHzC) - checker => componentFieldRequest - component = iHz - end select - end subroutine + !=========================== + ! Validation functions + !=========================== logical function isValidPointForCurrent(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo + integer, intent(in) :: request, i, j, k + type(problem_info_t), intent(in) :: problemInfo select case (request) case (iCur) isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) @@ -519,11 +485,11 @@ logical function isValidPointForCurrent(request, i, j, k, problemInfo) case default isValidPointForCurrent = .false. end select - end function + end function isValidPointForCurrent logical function isValidPointForField(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t) :: problemInfo + integer, intent(in) :: request, i, j, k + type(problem_info_t), intent(in) :: problemInfo select case (request) case (iMEC) isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) @@ -534,42 +500,45 @@ logical function isValidPointForField(request, i, j, k, problemInfo) case default isValidPointForField = .false. end select - end function + end function isValidPointForField logical function volumicCurrentRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request + integer, intent(in) :: request, i, j, k type(problem_info_t), intent(in) :: problemInfo - volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) & - .or. componentCurrentRequest(iEy, i, j, k, problemInfo) & - .or. componentCurrentRequest(iEz, i, j, k, problemInfo) - end function + volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) .or. & + componentCurrentRequest(iEy, i, j, k, problemInfo) .or. & + componentCurrentRequest(iEz, i, j, k, problemInfo) + end function volumicCurrentRequest + logical function volumicElectricRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request + integer, intent(in) :: request, i, j, k type(problem_info_t), intent(in) :: problemInfo - volumicElectricRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & - .or. componentFieldRequest(iEy, i, j, k, problemInfo) & - .or. componentFieldRequest(iEz, i, j, k, problemInfo) - end function + volumicElectricRequest = componentFieldRequest(iEx, i, j, k, problemInfo) .or. & + componentFieldRequest(iEy, i, j, k, problemInfo) .or. & + componentFieldRequest(iEz, i, j, k, problemInfo) + end function volumicElectricRequest + logical function volumicMagneticRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request + integer, intent(in) :: request, i, j, k type(problem_info_t), intent(in) :: problemInfo - volumicMagneticRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & - .or. componentFieldRequest(iHy, i, j, k, problemInfo) & - .or. componentFieldRequest(iHz, i, j, k, problemInfo) - end function + volumicMagneticRequest = componentFieldRequest(iHx, i, j, k, problemInfo) .or. & + componentFieldRequest(iHy, i, j, k, problemInfo) .or. & + componentFieldRequest(iHz, i, j, k, problemInfo) + end function volumicMagneticRequest + logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, fieldDir + integer, intent(in) :: fieldDir, i, j, k type(problem_info_t), intent(in) :: problemInfo componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) if (componentCurrentRequest) then - componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) & - .or. isThinWire(fieldDir, i, j, k, problemInfo) + componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) .or. isThinWire(fieldDir, i, j, k, problemInfo) end if - end function + end function componentCurrentRequest + logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, fieldDir + integer, intent(in) :: fieldDir, i, j, k type(problem_info_t), intent(in) :: problemInfo componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) - end function + end function componentFieldRequest end module mod_movieProbeOutput From d37cc295fbdd67a61379d34b84324d7243ef44ea Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 13 Jan 2026 14:57:49 +0100 Subject: [PATCH 59/67] Remove redundacy code from volumic probes --- src_output/CMakeLists.txt | 1 + src_output/frequencySliceProbeOutput.F90 | 171 +++------------------- src_output/movieProbeOutput.F90 | 178 +---------------------- src_output/volumicProbeUtils.F90 | 176 ++++++++++++++++++++++ 4 files changed, 202 insertions(+), 324 deletions(-) create mode 100644 src_output/volumicProbeUtils.F90 diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index 9bfe1c5c..d58cab7c 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -3,6 +3,7 @@ add_library(fdtd-output "outputTypes.F90" "domain.F90" "outputUtils.F90" + "volumicProbeUtils.F90" "pointProbeOutput.F90" "wireProbeOutput.F90" "bulkProbeOutput.F90" diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index c5d331ee..3ec9d3cc 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -3,6 +3,7 @@ module mod_frequencySliceProbeOutput use Report use outputTypes use mod_outputUtils + use mod_volumicProbeUtils implicit none private @@ -27,13 +28,7 @@ module mod_frequencySliceProbeOutput private :: write_vtu_frequency_slice !=========================== - abstract interface - logical function logical_func(component, i, j, k, problemInfo) - import :: problem_info_t - type(problem_info_t), intent(in) :: problemInfo - integer, intent(in) :: component, i, j, k - end function logical_func - end interface + !=========================== contains @@ -53,7 +48,7 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI this%auxCoords = upperBound this%component = field !This can refer to electric, magnetic or currentDensity this%domain = domain - this%path = get_output_path() + this%path = get_output_path_freq(this, outputTypeExtension, field, control) this%nFreq = domain%fnum call alloc_and_init(this%frequencySlice, this%nFreq, 0.0_RKIND) @@ -61,8 +56,7 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI call init_frequency_slice(this%frequencySlice, this%domain) end do - call count_required_coords(this, problemInfo) - call alloc_and_init(this%coords, 3, this%nPoints, 0_SINGLE) + call find_and_store_important_coords(this%mainCoords, this%auxCoords, this%component, problemInfo, this%nPoints, this%coords) if (any(VOLUMIC_M_MEASURE == this%component)) then call alloc_and_init(this%xValueForFreq, this%nFreq, this%nPoints, (0.0_CKIND, 0.0_CKIND)) @@ -84,23 +78,25 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI call alloc_and_init(this%auxExp_H, this%nFreq, (0.0_CKIND, 0.0_CKIND)) do i = 1, this%nFreq - this%auxExp_E(i) = timeInterval*(1.0E0_RKIND, 0.0E0_RKIND)*Exp(mcpi2*this%frequencySlice(i)) !el dt deberia ser algun tipo de promedio + this%auxExp_E(i) = timeInterval*(1.0E0_RKIND, 0.0E0_RKIND)*Exp(mcpi2*this%frequencySlice(i)) ! the dt should be some kind of average this%auxExp_H(i) = this%auxExp_E(i)*Exp(mcpi2*this%frequencySlice(i)*timeInterval*0.5_RKIND) end do - 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_frequency_slice_probe_output + function get_output_path_freq(this, outputTypeExtension, field, control) result(outputPath) + type(frequency_slice_probe_output_t), intent(in) :: this + character(len=*), intent(in) :: outputTypeExtension + integer(kind=SINGLE), intent(in) :: field + type(sim_control_t), intent(in) :: control + 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)) + end function get_output_path_freq + subroutine update_frequency_slice_probe_output(this, step, fieldsReference, control, problemInfo) type(frequency_slice_probe_output_t), intent(inout) :: this real(kind=RKIND_tiempo), intent(in) :: step @@ -386,138 +382,17 @@ subroutine update_pvd(this, freq, unitPVD) character(len=64) :: ts character(len=256) :: filename - ! Generamos nombre del archivo VTU para este timestep + ! Generate VTU file name for this frequency write (filename, '(A,A,I4.4,A)') trim(this%path), '_fq', freq, '.vtu' - - ! Escribimos el VTU correspondiente + + ! Write the corresponding VTU file call write_vtu_frequency_slice(this, freq, filename) - - ! Añadimos entrada en el PVD + + ! Add entry in the PVD write (ts, '(ES16.8)') this%frequencySlice(freq) write (unitPVD, '(A)') ' ' end subroutine update_pvd - subroutine count_required_coords(this, problemInfo) - type(frequency_slice_probe_output_t), intent(inout) :: this - type(problem_info_t), intent(in) :: problemInfo - - procedure(logical_func), pointer :: checker => null() ! Pointer to logical function - integer :: i, j, k - integer :: component, count - select case (this%component) - case (iCur) - checker => volumicCurrentRequest - component = iCur - case (iMEC) - checker => volumicElectricRequest - component = iMEC - case (iMHC) - checker => volumicMagneticRequest - component = iMHC - case (iCurx) - checker => componentCurrentRequest - component = iEx - case (iExC) - checker => componentFieldRequest - component = iEx - case (iHxC) - checker => componentFieldRequest - component = iHx - case (iCurY) - checker => componentCurrentRequest - component = iEy - case (iEyC) - checker => componentFieldRequest - component = iEy - case (iHyC) - checker => componentFieldRequest - component = iHy - case (iCurZ) - checker => componentCurrentRequest - component = iEz - case (iEzC) - checker => componentFieldRequest - component = iEz - case (iHzC) - checker => componentFieldRequest - component = iHz - end select - - count = 0 - do i = this%mainCoords%x, this%auxCoords%x - do j = this%mainCoords%y, this%auxCoords%y - do k = this%mainCoords%z, this%auxCoords%z - if (checker(component, i, j, k, problemInfo)) count = count + 1 - end do - end do - end do - this%nPoints = count - - end subroutine - - logical function isValidPointForCurrent(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t), intent(in) :: problemInfo - select case (request) - case (iCur) - isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) - case (iEx, iEy, iEz) - isValidPointForCurrent = componentCurrentRequest(request, i, j, k, problemInfo) - case default - isValidPointForCurrent = .false. - end select - end function - - logical function isValidPointForField(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t), intent(in) :: problemInfo - select case (request) - case (iMEC) - isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) - case (iMHC) - isValidPointForField = volumicMagneticRequest(request, i, j, k, problemInfo) - case (iEx, iEy, iEz, iHx, iHy, iHz) - isValidPointForField = componentFieldRequest(request, i, j, k, problemInfo) - case default - isValidPointForField = .false. - end select - end function - - logical function volumicCurrentRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t), intent(in) :: problemInfo - volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) & - .or. componentCurrentRequest(iEy, i, j, k, problemInfo) & - .or. componentCurrentRequest(iEz, i, j, k, problemInfo) - end function - logical function volumicElectricRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t), intent(in) :: problemInfo - volumicElectricRequest = componentFieldRequest(iEx, i, j, k, problemInfo) & - .or. componentFieldRequest(iEy, i, j, k, problemInfo) & - .or. componentFieldRequest(iEz, i, j, k, problemInfo) - end function - logical function volumicMagneticRequest(request, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, request - type(problem_info_t), intent(in) :: problemInfo - volumicMagneticRequest = componentFieldRequest(iHx, i, j, k, problemInfo) & - .or. componentFieldRequest(iHy, i, j, k, problemInfo) & - .or. componentFieldRequest(iHz, i, j, k, problemInfo) - end function - logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, fieldDir - type(problem_info_t), intent(in) :: problemInfo - componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) - if (componentCurrentRequest) then - componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) & - .or. isThinWire(fieldDir, i, j, k, problemInfo) - end if - end function - logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: i, j, k, fieldDir - type(problem_info_t), intent(in) :: problemInfo - componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) - end function end module mod_frequencySliceProbeOutput diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index c5768c7a..7784db3f 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -3,6 +3,7 @@ module mod_movieProbeOutput use Report use outputTypes use mod_outputUtils + use mod_volumicProbeUtils use vtk_fortran implicit none private @@ -18,40 +19,11 @@ module mod_movieProbeOutput !=========================== ! Private helpers !=========================== - ! Data Extraction & Processing - private :: find_and_store_important_coords - private :: count_required_coords - private :: store_required_coords - private :: get_checker_and_component - private :: save_current_module - private :: save_current_component - private :: save_current - private :: save_field_module - private :: save_field_component - private :: save_field - ! Output & File Management private :: write_vtu_timestep private :: update_pvd private :: clear_memory_data - ! Validation Logic - private :: isValidPointForCurrent - private :: isValidPointForField - private :: volumicCurrentRequest - private :: volumicElectricRequest - private :: volumicMagneticRequest - private :: componentCurrentRequest - private :: componentFieldRequest - - abstract interface - logical function logical_func(component, i, j, k, problemInfo) - import :: problem_info_t - type(problem_info_t), intent(in) :: problemInfo - integer, intent(in) :: component, i, j, k - end function logical_func - end interface - contains !=========================== @@ -73,7 +45,7 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, this%domain = domain this%path = get_output_path(this, outputTypeExtension, field, control%mpidir) - call find_and_store_important_coords(this, problemInfo) + call find_and_store_important_coords(this%mainCoords, this%auxCoords, this%component, problemInfo, this%nPoints, this%coords) call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) ! Allocate value arrays based on component type @@ -177,82 +149,6 @@ function get_output_path(this, outputTypeExtension, field, mpidir) result(path) path = trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) end function get_output_path - subroutine find_and_store_important_coords(this, problemInfo) - type(movie_probe_output_t), intent(inout) :: this - type(problem_info_t), intent(in) :: problemInfo - - call count_required_coords(this, problemInfo) - call alloc_and_init(this%coords, 3, this%nPoints, 0_SINGLE) - call store_required_coords(this, problemInfo) - end subroutine find_and_store_important_coords - - subroutine count_required_coords(this, problemInfo) - type(movie_probe_output_t), intent(inout) :: this - type(problem_info_t), intent(in) :: problemInfo - - integer :: i, j, k - procedure(logical_func), pointer :: checker => null() - integer :: component, count - - call get_checker_and_component(this, checker, component) - - count = 0 - do i = this%mainCoords%x, this%auxCoords%x - do j = this%mainCoords%y, this%auxCoords%y - do k = this%mainCoords%z, this%auxCoords%z - if (checker(component, i, j, k, problemInfo)) count = count + 1 - end do - end do - end do - - this%nPoints = count - end subroutine count_required_coords - - subroutine store_required_coords(this, problemInfo) - type(movie_probe_output_t), intent(inout) :: this - type(problem_info_t), intent(in) :: problemInfo - - integer :: i, j, k - integer :: count - procedure(logical_func), pointer :: checker => null() - integer :: component - - call get_checker_and_component(this, checker, component) - count = 0 - do i = this%mainCoords%x, this%auxCoords%x - do j = this%mainCoords%y, this%auxCoords%y - do k = this%mainCoords%z, this%auxCoords%z - if (checker(component, i, j, k, problemInfo)) then - count = count + 1 - this%coords(1, count) = i - this%coords(2, count) = j - this%coords(3, count) = k - end if - end do - end do - end do - end subroutine store_required_coords - - subroutine get_checker_and_component(this, checker, component) - type(movie_probe_output_t), intent(in) :: this - procedure(logical_func), pointer, intent(out) :: checker - integer, intent(out) :: component - - select case (this%component) - case (iCur); checker => volumicCurrentRequest; component = iCur - case (iMEC); checker => volumicElectricRequest; component = iMEC - case (iMHC); checker => volumicMagneticRequest; component = iMHC - case (iCurx); checker => componentCurrentRequest; component = iEx - case (iExC); checker => componentFieldRequest; component = iEx - case (iHxC); checker => componentFieldRequest; component = iHx - case (iCurY); checker => componentCurrentRequest; component = iEy - case (iEyC); checker => componentFieldRequest; component = iEy - case (iHyC); checker => componentFieldRequest; component = iHy - case (iCurZ); checker => componentCurrentRequest; component = iEz - case (iEzC); checker => componentFieldRequest; component = iEz - case (iHzC); checker => componentFieldRequest; component = iHz - end select - end subroutine get_checker_and_component subroutine save_current_module(this, fieldsReference, simTime, problemInfo) type(movie_probe_output_t), intent(inout) :: this @@ -470,75 +366,5 @@ subroutine clear_memory_data(this) end if end subroutine clear_memory_data - !=========================== - ! Validation functions - !=========================== - - logical function isValidPointForCurrent(request, i, j, k, problemInfo) - integer, intent(in) :: request, i, j, k - type(problem_info_t), intent(in) :: problemInfo - select case (request) - case (iCur) - isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) - case (iEx, iEy, iEz) - isValidPointForCurrent = componentCurrentRequest(request, i, j, k, problemInfo) - case default - isValidPointForCurrent = .false. - end select - end function isValidPointForCurrent - - logical function isValidPointForField(request, i, j, k, problemInfo) - integer, intent(in) :: request, i, j, k - type(problem_info_t), intent(in) :: problemInfo - select case (request) - case (iMEC) - isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) - case (iMHC) - isValidPointForField = volumicMagneticRequest(request, i, j, k, problemInfo) - case (iEx, iEy, iEz, iHx, iHy, iHz) - isValidPointForField = componentFieldRequest(request, i, j, k, problemInfo) - case default - isValidPointForField = .false. - end select - end function isValidPointForField - - logical function volumicCurrentRequest(request, i, j, k, problemInfo) - integer, intent(in) :: request, i, j, k - type(problem_info_t), intent(in) :: problemInfo - volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) .or. & - componentCurrentRequest(iEy, i, j, k, problemInfo) .or. & - componentCurrentRequest(iEz, i, j, k, problemInfo) - end function volumicCurrentRequest - - logical function volumicElectricRequest(request, i, j, k, problemInfo) - integer, intent(in) :: request, i, j, k - type(problem_info_t), intent(in) :: problemInfo - volumicElectricRequest = componentFieldRequest(iEx, i, j, k, problemInfo) .or. & - componentFieldRequest(iEy, i, j, k, problemInfo) .or. & - componentFieldRequest(iEz, i, j, k, problemInfo) - end function volumicElectricRequest - - logical function volumicMagneticRequest(request, i, j, k, problemInfo) - integer, intent(in) :: request, i, j, k - type(problem_info_t), intent(in) :: problemInfo - volumicMagneticRequest = componentFieldRequest(iHx, i, j, k, problemInfo) .or. & - componentFieldRequest(iHy, i, j, k, problemInfo) .or. & - componentFieldRequest(iHz, i, j, k, problemInfo) - end function volumicMagneticRequest - - logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: fieldDir, i, j, k - type(problem_info_t), intent(in) :: problemInfo - componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) - if (componentCurrentRequest) then - componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) .or. isThinWire(fieldDir, i, j, k, problemInfo) - end if - end function componentCurrentRequest - - logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) - integer, intent(in) :: fieldDir, i, j, k - type(problem_info_t), intent(in) :: problemInfo - componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) - end function componentFieldRequest end module mod_movieProbeOutput diff --git a/src_output/volumicProbeUtils.F90 b/src_output/volumicProbeUtils.F90 new file mode 100644 index 00000000..e4a3a75d --- /dev/null +++ b/src_output/volumicProbeUtils.F90 @@ -0,0 +1,176 @@ +module mod_volumicProbeUtils + use FDETYPES + use outputTypes + use mod_outputUtils + implicit none + private + + ! Public interface + public :: find_and_store_important_coords + public :: isValidPointForCurrent + public :: isValidPointForField + + abstract interface + logical function logical_func(component, i, j, k, problemInfo) + import :: problem_info_t, SINGLE + type(problem_info_t), intent(in) :: problemInfo + integer(kind=SINGLE), intent(in) :: component, i, j, k + end function logical_func + end interface + +contains + + subroutine find_and_store_important_coords(lowerBound, upperBound, component, problemInfo, nPoints, coords) + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound + integer(kind=SINGLE), intent(in) :: component + type(problem_info_t), intent(in) :: problemInfo + integer(kind=SINGLE), intent(out) :: nPoints + integer(kind=SINGLE), allocatable, intent(inout) :: coords(:, :) + + call count_required_coords(lowerBound, upperBound, component, problemInfo, nPoints) + call alloc_and_init(coords, 3, nPoints, 0_SINGLE) + call store_required_coords(lowerBound, upperBound, component, problemInfo, coords) + end subroutine find_and_store_important_coords + + subroutine count_required_coords(lowerBound, upperBound, requestComponent, problemInfo, count) + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound + integer(kind=SINGLE), intent(in) :: requestComponent + type(problem_info_t), intent(in) :: problemInfo + integer(kind=SINGLE), intent(out) :: count + + integer :: i, j, k + procedure(logical_func), pointer :: checker => null() + integer :: component + + call get_checker_and_component(requestComponent, checker, component) + + count = 0 + do i = lowerBound%x, upperBound%x + do j = lowerBound%y, upperBound%y + do k = lowerBound%z, upperBound%z + if (checker(component, i, j, k, problemInfo)) count = count + 1 + end do + end do + end do + end subroutine count_required_coords + + subroutine store_required_coords(lowerBound, upperBound, requestComponent, problemInfo, coords) + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound + integer(kind=SINGLE), intent(in) :: requestComponent + type(problem_info_t), intent(in) :: problemInfo + integer(kind=SINGLE), intent(inout) :: coords(:, :) + + integer :: i, j, k, count + procedure(logical_func), pointer :: checker => null() + integer :: component + + call get_checker_and_component(requestComponent, checker, component) + + count = 0 + do i = lowerBound%x, upperBound%x + do j = lowerBound%y, upperBound%y + do k = lowerBound%z, upperBound%z + if (checker(component, i, j, k, problemInfo)) then + count = count + 1 + coords(1, count) = i + coords(2, count) = j + coords(3, count) = k + end if + end do + end do + end do + end subroutine store_required_coords + + subroutine get_checker_and_component(request, checker, component) + integer(kind=SINGLE), intent(in) :: request + procedure(logical_func), pointer, intent(out) :: checker + integer(kind=SINGLE), intent(out) :: component + + select case (request) + case (iCur); checker => volumicCurrentRequest; component = iCur + case (iMEC); checker => volumicElectricRequest; component = iMEC + case (iMHC); checker => volumicMagneticRequest; component = iMHC + case (iCurx); checker => componentCurrentRequest; component = iEx + case (iExC); checker => componentFieldRequest; component = iEx + case (iHxC); checker => componentFieldRequest; component = iHx + case (iCurY); checker => componentCurrentRequest; component = iEy + case (iEyC); checker => componentFieldRequest; component = iEy + case (iHyC); checker => componentFieldRequest; component = iHy + case (iCurZ); checker => componentCurrentRequest; component = iEz + case (iEzC); checker => componentFieldRequest; component = iEz + case (iHzC); checker => componentFieldRequest; component = iHz + end select + end subroutine get_checker_and_component + + !-------------------------------------------------------------------------- + ! Logic Functions + !-------------------------------------------------------------------------- + + logical function isValidPointForCurrent(request, i, j, k, problemInfo) + integer(kind=SINGLE), intent(in) :: request, i, j, k + type(problem_info_t), intent(in) :: problemInfo + select case (request) + case (iCur) + isValidPointForCurrent = volumicCurrentRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz) + isValidPointForCurrent = componentCurrentRequest(request, i, j, k, problemInfo) + case default + isValidPointForCurrent = .false. + end select + end function isValidPointForCurrent + + logical function isValidPointForField(request, i, j, k, problemInfo) + integer(kind=SINGLE), intent(in) :: request, i, j, k + type(problem_info_t), intent(in) :: problemInfo + select case (request) + case (iMEC) + isValidPointForField = volumicElectricRequest(request, i, j, k, problemInfo) + case (iMHC) + isValidPointForField = volumicMagneticRequest(request, i, j, k, problemInfo) + case (iEx, iEy, iEz, iHx, iHy, iHz) + isValidPointForField = componentFieldRequest(request, i, j, k, problemInfo) + case default + isValidPointForField = .false. + end select + end function isValidPointForField + + logical function volumicCurrentRequest(request, i, j, k, problemInfo) + integer(kind=SINGLE), intent(in) :: request, i, j, k + type(problem_info_t), intent(in) :: problemInfo + volumicCurrentRequest = componentCurrentRequest(iEx, i, j, k, problemInfo) .or. & + componentCurrentRequest(iEy, i, j, k, problemInfo) .or. & + componentCurrentRequest(iEz, i, j, k, problemInfo) + end function volumicCurrentRequest + + logical function volumicElectricRequest(request, i, j, k, problemInfo) + integer(kind=SINGLE), intent(in) :: request, i, j, k + type(problem_info_t), intent(in) :: problemInfo + volumicElectricRequest = componentFieldRequest(iEx, i, j, k, problemInfo) .or. & + componentFieldRequest(iEy, i, j, k, problemInfo) .or. & + componentFieldRequest(iEz, i, j, k, problemInfo) + end function volumicElectricRequest + + logical function volumicMagneticRequest(request, i, j, k, problemInfo) + integer(kind=SINGLE), intent(in) :: request, i, j, k + type(problem_info_t), intent(in) :: problemInfo + volumicMagneticRequest = componentFieldRequest(iHx, i, j, k, problemInfo) .or. & + componentFieldRequest(iHy, i, j, k, problemInfo) .or. & + componentFieldRequest(iHz, i, j, k, problemInfo) + end function volumicMagneticRequest + + logical function componentCurrentRequest(fieldDir, i, j, k, problemInfo) + integer(kind=SINGLE), intent(in) :: fieldDir, i, j, k + type(problem_info_t), intent(in) :: problemInfo + componentCurrentRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) + if (componentCurrentRequest) then + componentCurrentRequest = isPEC(fieldDir, i, j, k, problemInfo) .or. isThinWire(fieldDir, i, j, k, problemInfo) + end if + end function componentCurrentRequest + + logical function componentFieldRequest(fieldDir, i, j, k, problemInfo) + integer(kind=SINGLE), intent(in) :: fieldDir, i, j, k + type(problem_info_t), intent(in) :: problemInfo + componentFieldRequest = isWithinBounds(fieldDir, i, j, k, problemInfo) + end function componentFieldRequest + +end module mod_volumicProbeUtils From 44d56931af1e059def9c472442d5d1958bec83e2 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 14 Jan 2026 13:04:08 +0100 Subject: [PATCH 60/67] Moved allocation utils to utils module --- CMakeLists.txt | 2 + src_output/CMakeLists.txt | 1 + src_output/bulkProbeOutput.F90 | 1 + src_output/frequencySliceProbeOutput.F90 | 1 + src_output/movieProbeOutput.F90 | 1 + src_output/outputUtils.F90 | 106 ++----------------- src_output/pointProbeOutput.F90 | 1 + src_output/volumicProbeUtils.F90 | 1 + src_output/wireProbeOutput.F90 | 1 + src_utils/CMakeLists.txt | 4 +- src_utils/allocationUtils.F90 | 124 +++++++++++++++++++++++ src_utils/utils.F90 | 8 ++ src_utils/valueReplacer.F90 | 31 +----- test/utils/CMakeLists.txt | 1 + test/utils/fdetypes_tools.F90 | 31 ++---- 15 files changed, 170 insertions(+), 144 deletions(-) create mode 100644 src_utils/allocationUtils.F90 create mode 100644 src_utils/utils.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index b6f73bef..7e0a51f6 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -191,6 +191,8 @@ if (SEMBA_FDTD_ENABLE_MTLN) endif() endif() +add_subdirectory(src_utils) + if (SEMBA_FDTD_ENABLE_OUTPUT_MODULE) add_subdirectory(external/VTKFortran) add_subdirectory(src_output) diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index d58cab7c..33389f7d 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -14,5 +14,6 @@ add_library(fdtd-output target_link_libraries(fdtd-output semba-types semba-components + fdtd-utils VTKFortran::VTKFortran ) \ No newline at end of file diff --git a/src_output/bulkProbeOutput.F90 b/src_output/bulkProbeOutput.F90 index 5c958ade..25e1f8bd 100644 --- a/src_output/bulkProbeOutput.F90 +++ b/src_output/bulkProbeOutput.F90 @@ -1,5 +1,6 @@ module mod_bulkProbeOutput use FDETYPES + use mod_UTILS use outputTypes use FDETYPES_TOOLS use mod_outputUtils diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index 3ec9d3cc..ea93239a 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -1,5 +1,6 @@ module mod_frequencySliceProbeOutput use FDETYPES + use mod_UTILS use Report use outputTypes use mod_outputUtils diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 7784db3f..86f36a83 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -1,5 +1,6 @@ module mod_movieProbeOutput use FDETYPES + USE mod_UTILS use Report use outputTypes use mod_outputUtils diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index b6244af6..683d1788 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -11,6 +11,7 @@ module mod_outputUtils !=========================== ! Public interface summary !=========================== + public :: new_cell_coordinate public :: get_coordinates_extension public :: get_prefix_extension public :: get_field_component @@ -30,7 +31,6 @@ module mod_outputUtils public :: computej public :: computeJ1 public :: computeJ2 - public :: alloc_and_init public :: fieldo !=========================== @@ -48,99 +48,15 @@ module mod_outputUtils module procedure get_probe_coords_extension, get_probe_bounds_coords_extension end interface get_coordinates_extension - interface alloc_and_init - procedure alloc_and_init_int_1D - procedure alloc_and_init_int_2D - procedure alloc_and_init_int_3D - procedure alloc_and_init_real_1D - procedure alloc_and_init_real_2D - procedure alloc_and_init_real_3D - procedure alloc_and_init_complex_1D - procedure alloc_and_init_complex_2D - procedure alloc_and_init_complex_3D - end interface - contains - subroutine alloc_and_init_int_1D(array, n1, initVal) - integer(SINGLE), allocatable, intent(inout) :: array(:) - integer, intent(IN) :: n1 - integer(SINGLE), intent(IN) :: initVal - - allocate (array(n1)) - array = initVal - END subroutine alloc_and_init_int_1D - - subroutine alloc_and_init_int_2D(array, n1, n2, initVal) - integer(SINGLE), allocatable, intent(inout) :: array(:, :) - integer, intent(IN) :: n1, n2 - integer(SINGLE), intent(IN) :: initVal - - allocate (array(n1, n2)) - array = initVal - END subroutine alloc_and_init_int_2D - - subroutine alloc_and_init_int_3D(array, n1, n2, n3, initVal) - integer(SINGLE), allocatable, intent(inout) :: array(:, :, :) - integer, intent(IN) :: n1, n2, n3 - integer(SINGLE), intent(IN) :: initVal - - allocate (array(n1, n2, n3)) - array = initVal - END subroutine alloc_and_init_int_3D - - subroutine alloc_and_init_real_1D(array, n1, initVal) - REAL(RKIND), allocatable, intent(inout) :: array(:) - integer, intent(IN) :: n1 - REAL(RKIND), intent(IN) :: initVal - - allocate (array(n1)) - array = initVal - END subroutine alloc_and_init_real_1D - - subroutine alloc_and_init_real_2D(array, n1, n2, initVal) - REAL(RKIND), allocatable, intent(inout) :: array(:, :) - integer, intent(IN) :: n1, n2 - REAL(RKIND), intent(IN) :: initVal - - allocate (array(n1, n2)) - array = initVal - END subroutine alloc_and_init_real_2D - - subroutine alloc_and_init_real_3D(array, n1, n2, n3, initVal) - REAL(RKIND), allocatable, intent(inout) :: array(:, :, :) - integer, intent(IN) :: n1, n2, n3 - REAL(RKIND), intent(IN) :: initVal - - allocate (array(n1, n2, n3)) - array = initVal - END subroutine alloc_and_init_real_3D - - subroutine alloc_and_init_complex_1D(array, n1, initVal) - COMPLEX(CKIND), allocatable, intent(inout) :: array(:) - integer, intent(IN) :: n1 - COMPLEX(CKIND), intent(IN) :: initVal - - allocate (array(n1)) - array = initVal - END subroutine alloc_and_init_complex_1D - - subroutine alloc_and_init_complex_2D(array, n1, n2, initVal) - COMPLEX(CKIND), allocatable, intent(inout) :: array(:, :) - integer, intent(IN) :: n1, n2 - COMPLEX(CKIND), intent(IN) :: initVal - - allocate (array(n1, n2)) - array = initVal - END subroutine alloc_and_init_complex_2D - - subroutine alloc_and_init_complex_3D(array, n1, n2, n3, initVal) - COMPLEX(CKIND), allocatable, intent(inout) :: array(:, :, :) - integer, intent(IN) :: n1, n2, n3 - COMPLEX(CKIND), intent(IN) :: initVal - - allocate (array(n1, n2, n3)) - array = initVal - END subroutine alloc_and_init_complex_3D + function new_cell_coordinate(x, y, z) result(cell) + integer(kind=SINGLE), intent(in) :: x, y, z + type(cell_coordinate_t) :: cell + + cell%x = x + cell%y = y + cell%z = z + end function new_cell_coordinate function getMediaIndex(field, i, j, k, CoordToMaterial) result(res) integer, intent(in) :: field, i, j, k @@ -177,7 +93,7 @@ function get_probe_coords_extension(coordinates, mpidir) result(ext) elseif (mpidir == 1) then ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj)) else - call stoponerror(0,0,'Buggy error in mpidir. ') + call stoponerror(0, 0, 'Buggy error in mpidir. ') end if #else ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark)) @@ -211,7 +127,7 @@ function get_probe_bounds_coords_extension(lowerCoordinates, upperCoordinates, m ext = trim(adjustl(chark))//'_'//trim(adjustl(chari))//'_'//trim(adjustl(charj))//'__'// & trim(adjustl(chark2))//'_'//trim(adjustl(chari2))//'_'//trim(adjustl(charj2)) else - call stoponerror(0,0,'Buggy error in mpidir. ') + call stoponerror(0, 0, 'Buggy error in mpidir. ') end if #else ext = trim(adjustl(chari))//'_'//trim(adjustl(charj))//'_'//trim(adjustl(chark))//'__'// & diff --git a/src_output/pointProbeOutput.F90 b/src_output/pointProbeOutput.F90 index 33dd0183..127eab4d 100644 --- a/src_output/pointProbeOutput.F90 +++ b/src_output/pointProbeOutput.F90 @@ -1,5 +1,6 @@ module mod_pointProbeOutput use FDETYPES + use mod_UTILS use outputTypes use mod_domain use mod_outputUtils diff --git a/src_output/volumicProbeUtils.F90 b/src_output/volumicProbeUtils.F90 index e4a3a75d..8db59a66 100644 --- a/src_output/volumicProbeUtils.F90 +++ b/src_output/volumicProbeUtils.F90 @@ -1,5 +1,6 @@ module mod_volumicProbeUtils use FDETYPES + USE mod_UTILS use outputTypes use mod_outputUtils implicit none diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index d52760f2..eed3e45f 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -1,5 +1,6 @@ module mod_wireProbeOutput use FDETYPES + USE mod_UTILS use Report use outputTypes use mod_outputUtils diff --git a/src_utils/CMakeLists.txt b/src_utils/CMakeLists.txt index e0c36221..e735c664 100644 --- a/src_utils/CMakeLists.txt +++ b/src_utils/CMakeLists.txt @@ -1,5 +1,7 @@ add_library(fdtd-utils - "valueReplacer.f90" + "utils.F90" + "valueReplacer.F90" + "allocationUtils.F90" ) target_link_libraries(fdtd-utils semba-types diff --git a/src_utils/allocationUtils.F90 b/src_utils/allocationUtils.F90 new file mode 100644 index 00000000..e2e1337b --- /dev/null +++ b/src_utils/allocationUtils.F90 @@ -0,0 +1,124 @@ +module mod_allocationUtils + use FDETYPES, only: RKIND, CKIND, SINGLE, RKIND_tiempo, IKINDMTAG, INTEGERSIZEOFMEDIAMATRICES + implicit none + private + public :: alloc_and_init + + interface alloc_and_init + procedure alloc_and_init_int_1D + procedure alloc_and_init_int_2D + procedure alloc_and_init_int_3D + procedure alloc_and_init_real_1D + procedure alloc_and_init_real_2D + procedure alloc_and_init_real_3D + procedure alloc_and_init_complex_1D + procedure alloc_and_init_complex_2D + procedure alloc_and_init_complex_3D + procedure alloc_and_init_int_3D_tag + procedure alloc_and_init_int_3D_med + end interface +contains + + subroutine alloc_and_init_int_1D(array, n1, initVal) + integer(SINGLE), allocatable, intent(inout) :: array(:) + integer, intent(IN) :: n1 + integer(SINGLE), intent(IN) :: initVal + + allocate (array(n1)) + array = initVal + END subroutine alloc_and_init_int_1D + + subroutine alloc_and_init_int_2D(array, n1, n2, initVal) + integer(SINGLE), allocatable, intent(inout) :: array(:, :) + integer, intent(IN) :: n1, n2 + integer(SINGLE), intent(IN) :: initVal + + allocate (array(n1, n2)) + array = initVal + END subroutine alloc_and_init_int_2D + + subroutine alloc_and_init_int_3D(array, n1, n2, n3, initVal) + integer(SINGLE), allocatable, intent(inout) :: array(:, :, :) + integer, intent(IN) :: n1, n2, n3 + integer(SINGLE), intent(IN) :: initVal + + allocate (array(n1, n2, n3)) + array = initVal + END subroutine alloc_and_init_int_3D + + ! Allocate array of kind=IKINDMTAG + subroutine alloc_and_init_int_3D_tag(array, n1_min, n1_max, n2_min, n2_max, n3_min, n3_max, initVal) + integer(kind=IKINDMTAG), allocatable, intent(inout) :: array(:, :, :) + integer, intent(in) :: n1_min, n1_max, n2_min, n2_max, n3_min, n3_max + integer(kind=IKINDMTAG), intent(in) :: initVal + + if (allocated(array)) deallocate (array) + allocate (array(n1_min:n1_max, n2_min:n2_max, n3_min:n3_max)) + array = initVal + end subroutine + + ! Allocate array of kind=INTEGERSIZEOFMEDIAMATRICES + subroutine alloc_and_init_int_3D_med(array, n1_min, n1_max, n2_min, n2_max, n3_min, n3_max, initVal) + integer(kind=INTEGERSIZEOFMEDIAMATRICES), allocatable, intent(inout) :: array(:, :, :) + integer, intent(in) :: n1_min, n1_max, n2_min, n2_max, n3_min, n3_max + integer(kind=INTEGERSIZEOFMEDIAMATRICES), intent(in) :: initVal + + if (allocated(array)) deallocate (array) + allocate (array(n1_min:n1_max, n2_min:n2_max, n3_min:n3_max)) + array = initVal + end subroutine + + subroutine alloc_and_init_real_1D(array, n1, initVal) + REAL(RKIND), allocatable, intent(inout) :: array(:) + integer, intent(IN) :: n1 + REAL(RKIND), intent(IN) :: initVal + + allocate (array(n1)) + array = initVal + END subroutine alloc_and_init_real_1D + + subroutine alloc_and_init_real_2D(array, n1, n2, initVal) + REAL(RKIND), allocatable, intent(inout) :: array(:, :) + integer, intent(IN) :: n1, n2 + REAL(RKIND), intent(IN) :: initVal + + allocate (array(n1, n2)) + array = initVal + END subroutine alloc_and_init_real_2D + + subroutine alloc_and_init_real_3D(array, n1, n2, n3, initVal) + REAL(RKIND), allocatable, intent(inout) :: array(:, :, :) + integer, intent(IN) :: n1, n2, n3 + REAL(RKIND), intent(IN) :: initVal + + allocate (array(n1, n2, n3)) + array = initVal + END subroutine alloc_and_init_real_3D + + subroutine alloc_and_init_complex_1D(array, n1, initVal) + COMPLEX(CKIND), allocatable, intent(inout) :: array(:) + integer, intent(IN) :: n1 + COMPLEX(CKIND), intent(IN) :: initVal + + allocate (array(n1)) + array = initVal + END subroutine alloc_and_init_complex_1D + + subroutine alloc_and_init_complex_2D(array, n1, n2, initVal) + COMPLEX(CKIND), allocatable, intent(inout) :: array(:, :) + integer, intent(IN) :: n1, n2 + COMPLEX(CKIND), intent(IN) :: initVal + + allocate (array(n1, n2)) + array = initVal + END subroutine alloc_and_init_complex_2D + + subroutine alloc_and_init_complex_3D(array, n1, n2, n3, initVal) + COMPLEX(CKIND), allocatable, intent(inout) :: array(:, :, :) + integer, intent(IN) :: n1, n2, n3 + COMPLEX(CKIND), intent(IN) :: initVal + + allocate (array(n1, n2, n3)) + array = initVal + END subroutine alloc_and_init_complex_3D +end module mod_allocationUtils diff --git a/src_utils/utils.F90 b/src_utils/utils.F90 new file mode 100644 index 00000000..58c7f93c --- /dev/null +++ b/src_utils/utils.F90 @@ -0,0 +1,8 @@ +module mod_UTILS + use mod_allocationUtils + use mod_valueReplacer + implicit none + +contains + +end module mod_UTILS \ No newline at end of file diff --git a/src_utils/valueReplacer.F90 b/src_utils/valueReplacer.F90 index 0fd5f4bc..8c3df663 100644 --- a/src_utils/valueReplacer.F90 +++ b/src_utils/valueReplacer.F90 @@ -1,6 +1,6 @@ -module value_replacer_mod - implicit none +module mod_valueReplacer use FDETYPES, only: RKIND, CKIND, SINGLE, RKIND_tiempo + implicit none private public :: replace_value @@ -9,25 +9,21 @@ module value_replacer_mod ! Scalars module procedure replace_scalar_int module procedure replace_scalar_real - module procedure replace_scalar_real_t module procedure replace_scalar_complex ! 1D arrays module procedure replace_1d_int module procedure replace_1d_real - module procedure replace_1d_real_t module procedure replace_1d_complex ! 2D arrays module procedure replace_2d_int module procedure replace_2d_real - module procedure replace_2d_real_t module procedure replace_2d_complex ! 3D arrays module procedure replace_3d_int module procedure replace_3d_real - module procedure replace_3d_real_t module procedure replace_3d_complex end interface @@ -76,13 +72,6 @@ subroutine replace_1d_real(x, idx1, val) x(idx1) = val end subroutine - subroutine replace_1d_real_t(x, idx1, val) - real(RKIND_tiempo), intent(inout) :: x(:) - integer(SINGLE), intent(in) :: idx1 - real(RKIND_tiempo), intent(in) :: val - x(idx1) = val - end subroutine - subroutine replace_1d_complex(x, idx1, val) complex(CKIND), intent(inout) :: x(:) integer(SINGLE), intent(in) :: idx1 @@ -107,13 +96,6 @@ subroutine replace_2d_real(x, idx1, idx2, val) x(idx1, idx2) = val end subroutine - subroutine replace_2d_real_t(x, idx1, idx2, val) - real(RKIND_tiempo), intent(inout) :: x(:,:) - integer(SINGLE), intent(in) :: idx1, idx2 - real(RKIND_tiempo), intent(in) :: val - x(idx1, idx2) = val - end subroutine - subroutine replace_2d_complex(x, idx1, idx2, val) complex(CKIND), intent(inout) :: x(:,:) integer(SINGLE), intent(in) :: idx1, idx2 @@ -138,13 +120,6 @@ subroutine replace_3d_real(x, idx1, idx2, idx3, val) x(idx1, idx2, idx3) = val end subroutine - subroutine replace_3d_real_t(x, idx1, idx2, idx3, val) - real(RKIND_tiempo), intent(inout) :: x(:,:,:) - integer(SINGLE), intent(in) :: idx1, idx2, idx3 - real(RKIND_tiempo), intent(in) :: val - x(idx1, idx2, idx3) = val - end subroutine - subroutine replace_3d_complex(x, idx1, idx2, idx3, val) complex(CKIND), intent(inout) :: x(:,:,:) integer(SINGLE), intent(in) :: idx1, idx2, idx3 @@ -152,4 +127,4 @@ subroutine replace_3d_complex(x, idx1, idx2, idx3, val) x(idx1, idx2, idx3) = val end subroutine -end module value_replacer_mod +end module mod_valueReplacer diff --git a/test/utils/CMakeLists.txt b/test/utils/CMakeLists.txt index 5e070429..96e569ad 100644 --- a/test/utils/CMakeLists.txt +++ b/test/utils/CMakeLists.txt @@ -10,4 +10,5 @@ add_library( target_link_libraries(test_utils_fortran semba-types + fdtd-utils ) diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index e2323a29..916f33bf 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -1,5 +1,6 @@ module FDETYPES_TOOLS use FDETYPES + use mod_UTILS use NFDETypes implicit none private @@ -36,7 +37,6 @@ module FDETYPES_TOOLS !=========================== - real(kind=rkind) :: UTILEPS0 = 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 real(kind=rkind) :: UTILMU0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 type :: observation_domain_t @@ -110,27 +110,18 @@ function create_tag_list(sggAlloc) result(r) end function create_tag_list subroutine create_geometry_media(res, xi, xe, yi, ye, zi, ze) - integer(kind=SINGLE) :: xi, yi, zi, xe, ye, ze + integer(kind=SINGLE), intent(in) :: xi, xe, yi, ye, zi, ze type(media_matrices_t), intent(inout) :: res - allocate (res%sggMtag(xi:xe, yi:ye, zi:ze)) - - allocate (res%sggMiNo(xi:xe, yi:ye, zi:ze)) - allocate (res%sggMiEx(xi:xe, yi:ye, zi:ze)) - allocate (res%sggMiEy(xi:xe, yi:ye, zi:ze)) - allocate (res%sggMiEz(xi:xe, yi:ye, zi:ze)) - allocate (res%sggMiHx(xi:xe, yi:ye, zi:ze)) - allocate (res%sggMiHy(xi:xe, yi:ye, zi:ze)) - allocate (res%sggMiHz(xi:xe, yi:ye, zi:ze)) - - res%sggMtag = 1_SINGLE - res%sggMiNo = 1_SINGLE - res%sggMiEx = 1_SINGLE - res%sggMiEy = 1_SINGLE - res%sggMiEz = 1_SINGLE - res%sggMiHx = 1_SINGLE - res%sggMiHy = 1_SINGLE - res%sggMiHz = 1_SINGLE + ! Allocate each array with its own kind + call alloc_and_init(res%sggMtag, xi, xe, yi, ye, zi, ze, 1_IKINDMTAG) + call alloc_and_init(res%sggMiNo, xi, xe, yi, ye, zi, ze, 1_INTEGERSIZEOFMEDIAMATRICES) + call alloc_and_init(res%sggMiEx, xi, xe, yi, ye, zi, ze, 1_INTEGERSIZEOFMEDIAMATRICES) + call alloc_and_init(res%sggMiEy, xi, xe, yi, ye, zi, ze, 1_INTEGERSIZEOFMEDIAMATRICES) + call alloc_and_init(res%sggMiEz, xi, xe, yi, ye, zi, ze, 1_INTEGERSIZEOFMEDIAMATRICES) + call alloc_and_init(res%sggMiHx, xi, xe, yi, ye, zi, ze, 1_INTEGERSIZEOFMEDIAMATRICES) + call alloc_and_init(res%sggMiHy, xi, xe, yi, ye, zi, ze, 1_INTEGERSIZEOFMEDIAMATRICES) + call alloc_and_init(res%sggMiHz, xi, xe, yi, ye, zi, ze, 1_INTEGERSIZEOFMEDIAMATRICES) end subroutine create_geometry_media function create_geometry_media_from_sggAlloc(sggAlloc) result(r) From 2a053966a5ba4c9390ababefa946bf9ee6b86fee Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 14 Jan 2026 14:05:34 +0100 Subject: [PATCH 61/67] Add volumic utils tests --- src_output/outputUtils.F90 | 5 +- test/output/CMakeLists.txt | 1 + test/output/output_tests.h | 10 +++ test/output/test_output_utils.F90 | 46 ++++++++++ test/output/test_volumic_utils.F90 | 138 +++++++++++++++++++++++++++++ 5 files changed, 199 insertions(+), 1 deletion(-) create mode 100644 test/output/test_volumic_utils.F90 diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 683d1788..7bcd1430 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -430,7 +430,10 @@ logical function isWithinBounds(field, i, j, k, problem) isWithinBounds = (i <= problem%problemDimension(field)%XE) .and. & (j <= problem%problemDimension(field)%YE) .and. & - (k <= problem%problemDimension(field)%ZE) + (k <= problem%problemDimension(field)%ZE) .and. & + (i >= problem%problemDimension(field)%XI) .and. & + (j >= problem%problemDimension(field)%YI) .and. & + (k >= problem%problemDimension(field)%ZI) end function logical function isMediaVacuum(field, i, j, k, problem) diff --git a/test/output/CMakeLists.txt b/test/output/CMakeLists.txt index ce30ba47..03cc0733 100644 --- a/test/output/CMakeLists.txt +++ b/test/output/CMakeLists.txt @@ -4,6 +4,7 @@ add_library( output_test_fortran "test_output.F90" "test_output_utils.F90" + "test_volumic_utils.F90" ) target_link_libraries(output_test_fortran diff --git a/test/output/output_tests.h b/test/output/output_tests.h index 8feeb501..8fa915cf 100644 --- a/test/output/output_tests.h +++ b/test/output/output_tests.h @@ -13,6 +13,11 @@ extern "C" int test_init_frequency_slice_probe(); extern "C" int test_update_frequency_slice_probe(); extern "C" int test_flush_frequency_slice_probe(); +extern "C" int test_count_required_coords(); +extern "C" int test_store_required_coords(); +extern "C" int test_is_valid_point_current(); +extern "C" int test_is_valid_point_field(); + TEST(output, test_initialize_point_probe) {EXPECT_EQ(0, test_init_point_probe()); } TEST(output, test_update_point_probe_info) {EXPECT_EQ(0, test_update_point_probe()); } @@ -25,4 +30,9 @@ TEST(output, test_init_frequency_slice) {EXPECT_EQ(0, test_init_frequency_sli TEST(output, test_update_frequency_slice) {EXPECT_EQ(0, test_update_frequency_slice_probe()); } TEST(output, test_flush_frequency_slice) {EXPECT_EQ(0, test_flush_frequency_slice_probe()); } +TEST(output, test_volumic_utils_count) { EXPECT_EQ(0, test_count_required_coords()); } +TEST(output, test_volumic_utils_store) { EXPECT_EQ(0, test_store_required_coords()); } +TEST(output, test_volumic_utils_valid_current) { EXPECT_EQ(0, test_is_valid_point_current()); } +TEST(output, test_volumic_utils_valid_field) { EXPECT_EQ(0, test_is_valid_point_field()); } + #endif \ No newline at end of file diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index 8a175874..f58d9929 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -15,7 +15,15 @@ module mod_testOutputUtils public :: create_frequency_slice_observation public :: create_dummy_fields public :: fillGradient + public :: setup_dummy_problem_info + public :: clean_dummy_problem_info !=========================== + + ! Storage for dummy targets + type(media_matrices_t), target :: dummyGeometry + type(limit_t), allocatable, target :: dummyProblemDim(:) + type(MediaData_t), allocatable, target :: dummyMaterialList(:) + type(bounds_t), target :: dummyBounds !=========================== ! Private interface summary @@ -171,4 +179,42 @@ subroutine fillGradient(dummyFields, direction, minVal, maxVal) end subroutine fillGradient + !-------------------------------------------------------------------------------- + ! Setup/Teardown + !-------------------------------------------------------------------------------- + subroutine setup_dummy_problem_info(problemInfo) + type(problem_info_t), intent(out) :: problemInfo + + integer :: i + + ! Create a 11x11x11 grid (0..10) + if (allocated(dummyProblemDim)) deallocate(dummyProblemDim) + allocate(dummyProblemDim(6)) + do i = 1,6 + dummyProblemDim(i) = create_limit_t(0, 10, 0, 10, 0, 10, 1, 1, 1) + end do + problemInfo%problemDimension => dummyProblemDim + + call create_geometry_media(dummyGeometry, 0, 10, 0, 10, 0, 10) + problemInfo%geometryToMaterialData => dummyGeometry + + call init_simulation_material_list(dummyMaterialList) + problemInfo%materialList => dummyMaterialList + + problemInfo%simulationBounds => dummyBounds + + end subroutine setup_dummy_problem_info + + subroutine clean_dummy_problem_info(problemInfo) + type(problem_info_t), intent(inout) :: problemInfo + + if (allocated(dummyProblemDim)) deallocate(dummyProblemDim) + if (allocated(dummyMaterialList)) deallocate(dummyMaterialList) + + nullify(problemInfo%problemDimension) + nullify(problemInfo%geometryToMaterialData) + nullify(problemInfo%materialList) + nullify(problemInfo%simulationBounds) + end subroutine clean_dummy_problem_info + end module mod_testOutputUtils diff --git a/test/output/test_volumic_utils.F90 b/test/output/test_volumic_utils.F90 new file mode 100644 index 00000000..97962edc --- /dev/null +++ b/test/output/test_volumic_utils.F90 @@ -0,0 +1,138 @@ +!-------------------------------------------------------------------------------- +! Test: count_required_coords +!-------------------------------------------------------------------------------- +integer function test_count_required_coords() bind(c) result(err) + use FDETYPES + use outputTypes + use mod_volumicProbeUtils + use mod_assertionTools + use mod_testOutputUtils + implicit none + + type(cell_coordinate_t) :: lowerBound, upperBound + type(problem_info_t) :: problemInfo + integer(kind=SINGLE) :: count + integer :: test_err = 0 + integer, allocatable :: dummy_coords(:,:) + + ! Setup test case: 3x3x3 domain (1..3) + lowerBound = cell_coordinate_t(1, 1, 1) + upperBound = cell_coordinate_t(3, 3, 3) + + call setup_dummy_problem_info(problemInfo) + + ! Test Case 1: Field Request (iExC) + call find_and_store_important_coords(lowerBound, upperBound, iExC, problemInfo, count, dummy_coords) + + ! Expected: 3*3*3 = 27 points + test_err = test_err + assert_integer_equal(count, 27_SINGLE, "Failed count for iExC") + + if (allocated(dummy_coords)) deallocate(dummy_coords) + call clean_dummy_problem_info(problemInfo) + err = test_err +end function test_count_required_coords + +!-------------------------------------------------------------------------------- +! Test: store_required_coords +!-------------------------------------------------------------------------------- +integer function test_store_required_coords() bind(c) result(err) + use FDETYPES + use outputTypes + use mod_outputUtils + use mod_volumicProbeUtils + use mod_assertionTools + use mod_testOutputUtils + implicit none + + type(cell_coordinate_t) :: lowerBound, upperBound + type(problem_info_t) :: problemInfo + integer(kind=SINGLE) :: nPoints + integer(kind=SINGLE), allocatable :: stored_coords(:,:) + integer :: test_err = 0 + + lowerBound = new_cell_coordinate(1, 1, 1) + upperBound = new_cell_coordinate(2, 2, 2) + call setup_dummy_problem_info(problemInfo) + + call find_and_store_important_coords(lowerBound, upperBound, iHyC, problemInfo, nPoints, stored_coords) + + test_err = test_err + assert_integer_equal(nPoints, 8_SINGLE, "Failed nPoints for iHyC") + + if (allocated(stored_coords)) then + test_err = test_err + assert_integer_equal(int(size(stored_coords, 2), SINGLE), 8_SINGLE, "Allocated coords size error") + ! Verify first coord is (1,1,1) + test_err = test_err + assert_integer_equal(stored_coords(1,1), 1_SINGLE, "First x coord mismatch") + test_err = test_err + assert_integer_equal(stored_coords(2,1), 1_SINGLE, "First y coord mismatch") + test_err = test_err + assert_integer_equal(stored_coords(3,1), 1_SINGLE, "First z coord mismatch") + deallocate(stored_coords) + else + print *, "Coords not allocated." + test_err = test_err + 1 + end if + + call clean_dummy_problem_info(problemInfo) + err = test_err +end function test_store_required_coords + +!-------------------------------------------------------------------------------- +! Test: isValidPointForCurrent +!-------------------------------------------------------------------------------- +integer function test_is_valid_point_current() bind(c) result(err) + use FDETYPES + use outputTypes + use mod_volumicProbeUtils + use mod_testOutputUtils + implicit none + + type(problem_info_t) :: problemInfo + integer :: test_err = 0 + logical :: valid + + call setup_dummy_problem_info(problemInfo) + + ! By default, our dummy setup has NO PEC and NO Wires. + ! So isValidPointForCurrent should be FALSE (as it requires PEC or Wire) + valid = isValidPointForCurrent(iCur, 1, 1, 1, problemInfo) + + if (valid) then + print *, "Expected False for empty space current probe (no PEC/Wire)" + test_err = test_err + 1 + end if + + call clean_dummy_problem_info(problemInfo) + err = test_err +end function test_is_valid_point_current + +!-------------------------------------------------------------------------------- +! Test: isValidPointForField +!-------------------------------------------------------------------------------- +integer function test_is_valid_point_field() bind(c) result(err) + use FDETYPES + use outputTypes + use mod_volumicProbeUtils + use mod_testOutputUtils + implicit none + + type(problem_info_t) :: problemInfo + integer :: test_err = 0 + logical :: valid + + call setup_dummy_problem_info(problemInfo) + + ! Point inside boundary + valid = isValidPointForField(iEx, 5, 5, 5, problemInfo) + if (.not. valid) then + print *, "Expected True for field probe in bounds" + test_err = test_err + 1 + end if + + ! Point outside boundary (-1) + valid = isValidPointForField(iEx, -1, 5, 5, problemInfo) + if (valid) then + print *, "Expected False for field probe out of bounds" + test_err = test_err + 1 + end if + + call clean_dummy_problem_info(problemInfo) + err = test_err +end function test_is_valid_point_field From 3fa0480ec1675fe21511ab46a07f3d712d83f2cf Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 15 Jan 2026 10:13:58 +0100 Subject: [PATCH 62/67] Add new output to ubuntu test actions --- .github/workflows/ubuntu.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 34f2d056..7be8b74f 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -29,6 +29,7 @@ jobs: mtln: ["Yes", "No"] hdf: ["Yes"] double-precision: ["No"] + new-output-module: ["No","Yes"] include: - os: ubuntu-22.04 @@ -105,13 +106,15 @@ jobs: -DSEMBA_FDTD_ENABLE_MPI=${{matrix.mpi}} \ -DSEMBA_FDTD_ENABLE_HDF=${{matrix.hdf}} \ -DSEMBA_FDTD_ENABLE_MTLN=${{matrix.mtln}} \ - -DSEMBA_FDTD_ENABLE_DOUBLE_PRECISION=${{matrix.double-precision}} + -DSEMBA_FDTD_ENABLE_DOUBLE_PRECISION=${{matrix.double-precision}} \ + -DSEMBA_FDTD_ENABLE_OUTPUT_MODULE=${{matrix.new-output-module}} \ cmake --build build -j - name: Run unit tests run: build/bin/fdtd_tests - name: Run python tests + if: matrix.new-output-module=='No' env: SEMBA_FDTD_ENABLE_MPI: ${{ matrix.mpi }} SEMBA_FDTD_ENABLE_MTLN: ${{ matrix.mtln }} From 82161d1a6cf687f01adce28d29389fa4421e6198 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 16 Jan 2026 12:43:38 +0100 Subject: [PATCH 63/67] Removed outputUpdater.F90 --- src_output/outputUpdater.F90 | 39 ------------------------------------ 1 file changed, 39 deletions(-) delete mode 100644 src_output/outputUpdater.F90 diff --git a/src_output/outputUpdater.F90 b/src_output/outputUpdater.F90 deleted file mode 100644 index 963c42d0..00000000 --- a/src_output/outputUpdater.F90 +++ /dev/null @@ -1,39 +0,0 @@ -module mod_outputUpdater - implicit none - use FDETYPES -contains - subroutine save_next_scalar(scalar, idx, val) - real, intent(inout) :: scalar(:) - integer, intent(in) :: idx - real, intent(in) :: val - scalar(idx) = val - end subroutine save_next_scalar - - subroutine save_next_vector(xVector, yVector, zVector, idx, xVal, yVal, zVal) - real, intent(inout) :: xVector(:), yVector(:), zVector(:) - integer, intent(in) :: idx - real, intent(in) :: xVal, yVal, zVal - xVector(idx) = xVal - yVector(idx) = yVal - zVector(idx) = zVal - end subroutine save_next_vector - - subroutine add_value(scalar, idx, val) - complex, intent(inout) :: scalar(:) - integer, intent(in) :: idx - complex, intent(in) :: val - scalar(idx) = val + scalar(idx) - end subroutine update_scalar_value_freq - - subroutine update_vector_value_freq(xVector, yVector, zVector, idx, xVal, yVal, zVal) - real, intent(inout) :: xVector(:), yVector(:), zVector(:) - integer, intent(in) :: idx - real, intent(in) :: xVal, yVal, zVal - xVector(idx) = xVal + xVector(idx) - yVector(idx) = yVal + yVector(idx) - zVector(idx) = zVal + zVector(idx) - end subroutine update_vector_value_freq - - subroutine save_scalar_timestep_for_valid_points(scalar, lowerCoord, upperCoord, idx) - -end module mod_outputUpdater \ No newline at end of file From 6812ce4df3eca1d4a69adedd9c0a3a6ba1b49144 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 22 Jan 2026 13:03:22 +0100 Subject: [PATCH 64/67] Aplly requested changes --- .github/workflows/ubuntu.yml | 2 +- test/output/test_output.F90 | 4 ++-- test/utils/assertion_tools.F90 | 5 +++-- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index b3de4c83..3c94829b 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -91,7 +91,7 @@ jobs: -DSEMBA_FDTD_ENABLE_HDF=${{matrix.hdf}} \ -DSEMBA_FDTD_ENABLE_MTLN=${{matrix.mtln}} \ -DSEMBA_FDTD_ENABLE_DOUBLE_PRECISION=${{matrix.double-precision}} \ - -DSEMBA_FDTD_ENABLE_OUTPUT_MODULE=${{matrix.new-output-module}} \ + -DSEMBA_FDTD_ENABLE_OUTPUT_MODULE=${{matrix.new-output-module}} cmake --build build -j - name: Run unit tests diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 51c6f7c9..2bb00546 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -287,11 +287,11 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) call flush_point_probe_output(probe) open (unit=probe%fileUnitTime, file=file_time, status='old', action='read') - test_err = test_err + assert_file_content(probe%fileUnitTime, expectedTime, 2*n, 2) + test_err = test_err + assert_file_content(probe%fileUnitTime, expectedTime, 2*n, 2, 1e-06_RKIND) close (probe%fileUnitTime) open (unit=probe%fileUnitFreq, file=file_freq, status='old', action='read') - test_err = test_err + assert_file_content(probe%fileUnitFreq, expectedFreq, n, 2) + test_err = test_err + assert_file_content(probe%fileUnitFreq, expectedFreq, n, 2, 1e-06_RKIND) close (probe%fileUnitFreq) err = test_err diff --git a/test/utils/assertion_tools.F90 b/test/utils/assertion_tools.F90 index 0d80eed9..b125187b 100644 --- a/test/utils/assertion_tools.F90 +++ b/test/utils/assertion_tools.F90 @@ -118,11 +118,12 @@ integer function assert_written_output_file(filename) result(code) end if end function assert_written_output_file - integer function assert_file_content(unit, expectedValues, nRows, nCols, headers) result(flag) + integer function assert_file_content(unit, expectedValues, nRows, nCols, tolerance, headers) result(flag) implicit none integer(kind=SINGLE), intent(in) :: unit real(kind=RKIND), intent(in) :: expectedValues(:, :) integer(kind=SINGLE), intent(in) :: nRows, nCols + real(kind=RKIND), intent(in) :: tolerance character(len=*), intent(in), optional :: headers(:) integer(kind=SINGLE) :: i, j, ios real(kind=RKIND), dimension(nCols) :: val @@ -141,7 +142,7 @@ integer function assert_file_content(unit, expectedValues, nRows, nCols, headers return end if do j = 1, nCols - if (abs(val(j) - expectedValues(i, j)) > 1d-6) then + if (abs(val(j) - expectedValues(i, j)) > tolerance) then flag = flag + 1 end if end do From 4f8b9a83a2de0ac586259bf31ba93aaa7d03f4fe Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 23 Jan 2026 12:05:32 +0100 Subject: [PATCH 65/67] Fix compilation error in allocationUtils for RKIND_tiempo --- src_utils/allocationUtils.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src_utils/allocationUtils.F90 b/src_utils/allocationUtils.F90 index e2e1337b..60bf63f0 100644 --- a/src_utils/allocationUtils.F90 +++ b/src_utils/allocationUtils.F90 @@ -16,9 +16,21 @@ module mod_allocationUtils procedure alloc_and_init_complex_3D procedure alloc_and_init_int_3D_tag procedure alloc_and_init_int_3D_med +#ifndef CompileWithReal8 + procedure alloc_and_init_real_time_1D +#endif end interface contains +#ifndef CompileWithReal8 + subroutine alloc_and_init_real_time_1D(array, n1, initVal) + REAL(RKIND_tiempo), allocatable, intent(inout) :: array(:) + integer, intent(IN) :: n1 + REAL(RKIND_tiempo), intent(IN) :: initVal + allocate (array(n1)) + array = initVal + END subroutine alloc_and_init_real_time_1D +#endif subroutine alloc_and_init_int_1D(array, n1, initVal) integer(SINGLE), allocatable, intent(inout) :: array(:) integer, intent(IN) :: n1 From d6364121a79077c90c8f3eec5abac46574d382a9 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 26 Jan 2026 12:54:00 +0100 Subject: [PATCH 66/67] Replace unit info for path references --- src_output/bulkProbeOutput.F90 | 22 +-- src_output/farFieldProbeOutput.F90 | 4 +- src_output/frequencySliceProbeOutput.F90 | 24 +-- src_output/movieProbeOutput.F90 | 27 ++-- src_output/output.F90 | 52 +++---- src_output/outputTypes.F90 | 8 +- src_output/outputUtils.F90 | 79 ++-------- src_output/pointProbeOutput.F90 | 47 ++---- src_output/wireProbeOutput.F90 | 35 ++--- src_utils/CMakeLists.txt | 1 + src_utils/directoryUtils.F90 | 189 +++++++++++++++++++++++ src_utils/utils.F90 | 1 + 12 files changed, 290 insertions(+), 199 deletions(-) create mode 100644 src_utils/directoryUtils.F90 diff --git a/src_output/bulkProbeOutput.F90 b/src_output/bulkProbeOutput.F90 index 25e1f8bd..a98b49c9 100644 --- a/src_output/bulkProbeOutput.F90 +++ b/src_output/bulkProbeOutput.F90 @@ -26,6 +26,7 @@ subroutine init_bulk_probe_output(this, lowerBound, upperBound, field, domain, o 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 @@ -41,18 +42,6 @@ end function get_output_path end subroutine init_bulk_probe_output - subroutine create_bulk_probe_output(this) - type(bulk_current_probe_output_t), intent(inout) :: this - character(len=BUFSIZE) :: file_time - integer(kind=SINGLE) :: err - err = 0 - - file_time = trim(adjustl(this%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & - trim(adjustl(datFileExtension)) - call create_or_clear_file(file_time, this%fileUnitTime, err) - end subroutine create_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 @@ -168,21 +157,20 @@ end subroutine update_bulk_probe_output subroutine flush_bulk_probe_output(this) type(bulk_current_probe_output_t), intent(inout) :: this - character(len=BUFSIZE) :: filename integer :: i + integer :: unit if (this%nTime <= 0) then print *, "No data to write." return end if - filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) - open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") + open (unit=unit, file=this%filePathTime, status="old", action="write", position="append") do i = 1, this%nTime - write (this%fileUnitTime, fmt) this%timeStep(i), this%valueForTime(i) + write (unit, fmt) this%timeStep(i), this%valueForTime(i) end do - close (this%fileUnitTime) + close (unit) call clear_time_data() contains subroutine clear_time_data() diff --git a/src_output/farFieldProbeOutput.F90 b/src_output/farFieldProbeOutput.F90 index aaa1a970..15ffc752 100644 --- a/src_output/farFieldProbeOutput.F90 +++ b/src_output/farFieldProbeOutput.F90 @@ -33,13 +33,11 @@ subroutine init_farField_probe_output(this, sgg, lowerBound, upperBound, field, this%sphericRange = sphericRange this%component = field this%path = get_output_path() - this%fileUnitFreq = 2025 !Dummy unit for now - call InitFarField(sgg, & problemInfo%geometryToMaterialData%sggMiEx, problemInfo%geometryToMaterialData%sggMiEy, problemInfo%geometryToMaterialData%sggMiEz, & problemInfo%geometryToMaterialData%sggMiHx, problemInfo%geometryToMaterialData%sggMiHy, problemInfo%geometryToMaterialData%sggMiHz, & control%layoutnumber, control%size, problemInfo%simulationBounds, control%resume, & - this%fileUnitFreq, this%path, & + 2025, this%path, & lowerBound%x, upperBound%x, & lowerBound%y, upperBound%y, & lowerBound%z, upperBound%z, & diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index ea93239a..c34a56a8 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -282,7 +282,7 @@ subroutine flush_frequency_slice_probe_output(this) integer :: status, i do i = 1, this%nFreq - call update_pvd(this, i, this%fileUnitFreq) + call update_pvd(this, i, this%filePathFreq) end do end subroutine flush_frequency_slice_probe_output @@ -375,24 +375,24 @@ subroutine write_vtu_frequency_slice(this, freq, filename) end subroutine write_vtu_frequency_slice - subroutine update_pvd(this, freq, unitPVD) + subroutine update_pvd(this, freq, PVDfilePath) implicit none type(frequency_slice_probe_output_t), intent(in) :: this integer, intent(in) :: freq - integer, intent(in) :: unitPVD + character(len=*), intent(in) :: PVDfilePath character(len=64) :: ts - character(len=256) :: filename + character(len=256) :: newVTUfilename + integer :: unit - ! Generate VTU file name for this frequency - write (filename, '(A,A,I4.4,A)') trim(this%path), '_fq', freq, '.vtu' - - ! Write the corresponding VTU file - call write_vtu_frequency_slice(this, freq, filename) + + write (newVTUfilename, '(A,A,I4.4,A)') trim(this%path), '_fq', freq, '.vtu' + call write_vtu_frequency_slice(this, freq, newVTUfilename) - ! Add entry in the PVD write (ts, '(ES16.8)') this%frequencySlice(freq) - write (unitPVD, '(A)') ' ' + + open (newunit=unit, file=trim(PVDfilePath), status='old', position='append') + write (unit, '(A)') ' ' + close(unit) end subroutine update_pvd diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 86f36a83..f9d1f63d 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -40,12 +40,16 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, type(problem_info_t), intent(in) :: problemInfo character(len=BUFSIZE), intent(in) :: outputTypeExtension + integer :: error + this%mainCoords = lowerBound this%auxCoords = upperBound this%component = field this%domain = domain this%path = get_output_path(this, outputTypeExtension, field, control%mpidir) + call create_folder(this%path, error) + call find_and_store_important_coords(this%mainCoords, this%auxCoords, this%component, problemInfo, this%nPoints, this%coords) call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) @@ -129,7 +133,7 @@ subroutine flush_movie_probe_output(this) integer :: i do i = 1, this%nTime - call update_pvd(this, i, this%fileUnitTime) + call update_pvd(this, i, this%filePathTime) end do call clear_memory_data(this) @@ -335,18 +339,23 @@ subroutine write_vtu_timestep(this, stepIndex, filename) deallocate(x, y, z) end subroutine write_vtu_timestep - subroutine update_pvd(this, stepIndex, unitPVD) + subroutine update_pvd(this, stepIndex, PVDfilePath) + implicit none type(movie_probe_output_t), intent(in) :: this - integer, intent(in) :: stepIndex, unitPVD - character(len=256) :: filename - character(len=64) :: ts + integer, intent(in) :: stepIndex + character(len=*), intent(in) :: PVDfilePath + character(len=64) :: ts + character(len=256) :: newVTUfilename + integer :: unit - write(filename,'(A,A,I4.4,A)') trim(this%path), '_ts', stepIndex, '.vtu' - call write_vtu_timestep(this, stepIndex, filename) + write(newVTUfilename,'(A,A,I4.4,A)') trim(this%path), '_ts', stepIndex, '.vtu' + call write_vtu_timestep(this, stepIndex, newVTUfilename) write(ts,'(ES16.8)') this%timeStep(stepIndex) - write(unitPVD,'(A)') ' ' + + open (newunit=unit, file=trim(PVDfilePath), status='old', position='append') + write(unit,'(A)') ' ' + close(unit) end subroutine update_pvd subroutine clear_memory_data(this) diff --git a/src_output/output.F90 b/src_output/output.F90 index 5ee90f32..e391255e 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -59,14 +59,6 @@ module output init_farField_probe_output end interface - interface create_empty_files - module procedure & - create_point_probe_output_files, & - create_wire_current_probe_output, & - create_wire_charge_probe_output, & - create_bulk_probe_output - end interface - interface update_solver_output module procedure & update_point_probe_output, & @@ -168,7 +160,6 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio allocate (outputs(outputCount)%pointProbe) call init_solver_output(outputs(outputCount)%pointProbe, lowerBound, outputRequestType, domain, outputTypeExtension, control%mpidir, sgg%dt) - call create_empty_files(outputs(outputCount)%pointProbe) case (iJx, iJy, iJz) if (wiresExists) then outputCount = outputCount + 1 @@ -176,7 +167,6 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio allocate (outputs(outputCount)%wireCurrentProbe) call init_solver_output(outputs(outputCount)%wireCurrentProbe, lowerBound, NODE, outputRequestType, domain, problemInfo%materialList, outputTypeExtension, control%mpidir, control%wiresflavor) - call create_empty_files(outputs(outputCount)%wireCurrentProbe) end if case (iQx, iQy, iQz) @@ -185,7 +175,6 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio allocate (outputs(outputCount)%wireChargeProbe) call init_solver_output(outputs(outputCount)%wireChargeProbe, lowerBound, NODE, outputRequestType, domain, outputTypeExtension, control%mpidir, control%wiresflavor) - call create_empty_files(outputs(outputCount)%wireChargeProbe) case (iBloqueJx, iBloqueJy, iBloqueJz, iBloqueMx, iBloqueMy, iBloqueMz) outputCount = outputCount + 1 @@ -193,7 +182,6 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio allocate (outputs(outputCount)%bulkCurrentProbe) call init_solver_output(outputs(outputCount)%bulkCurrentProbe, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control%mpidir) - call create_empty_files(outputs(outputCount)%bulkCurrentProbe) !! call adjust_computation_range --- Required due to issues in mpi region edges case (iCur, iMEC, iMHC, iCurX, iCurY, iCurZ, iExC, iEyC, iEzC, iHxC, iHyC, iHzC) @@ -205,7 +193,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = MOVIE_PROBE_ID allocate (outputs(outputCount)%movieProbe) call init_solver_output(outputs(outputCount)%movieProbe, lowerBound, upperBound, outputRequestType, domain, control, problemInfo, outputTypeExtension) - call create_pvd(outputs(outputCount)%movieProbe%path, outputs(outputCount)%movieProbe%fileUnitTime) + call create_pvd(outputs(outputCount)%movieProbe%path, outputs(outputCount)%movieProbe%pvdPath) else if (domain%domainType == FREQUENCY_DOMAIN) then @@ -213,7 +201,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputs(outputCount)%outputID = FREQUENCY_SLICE_PROBE_ID allocate (outputs(outputCount)%frequencySliceProbe) call init_solver_output(outputs(outputCount)%frequencySliceProbe, lowerBound, upperBound, sgg%dt, outputRequestType, domain, outputTypeExtension, control, problemInfo) - call create_pvd(outputs(outputCount)%frequencySliceProbe%path, outputs(outputCount)%frequencySliceProbe%fileUnitFreq) + call create_pvd(outputs(outputCount)%frequencySliceProbe%path, outputs(outputCount)%frequencySliceProbe%pvdPath) end if case (farfield) @@ -427,35 +415,41 @@ subroutine close_outputs() case (BULK_PROBE_ID) case (VOLUMIC_CURRENT_PROBE_ID) case (MOVIE_PROBE_ID) - call close_pvd(outputs(i)%movieProbe%fileUnitTime) + call close_pvd(outputs(i)%movieProbe%pvdPath) case (FREQUENCY_SLICE_PROBE_ID) - call close_pvd(outputs(i)%frequencySliceProbe%fileUnitFreq) + call close_pvd(outputs(i)%frequencySliceProbe%pvdPath) end select end do end subroutine - subroutine create_pvd(pdvPath, unitPVD) + subroutine create_pvd(probePath, pvdPath) implicit none - character(len=*), intent(in) :: pdvPath - integer, intent(out) :: unitPVD + character(len=*), intent(in) :: probePath + character(len=*), intent(out) :: pvdPath integer :: ios + integer :: unit - open (newunit=unitPVD, file=trim(pdvPath)//".pvd", status="replace", action="write", iostat=ios) + pvdPath = trim(probePath)//'.pvd' + open (newunit=unit, file=trim(pvdPath), status="replace", action="write", iostat=ios) if (ios /= 0) stop "Error al crear archivo PVD" ! Escribimos encabezados XML - write (unitPVD, *) '' - write (unitPVD, *) '' - write (unitPVD, *) ' ' + write (unit, *) '' + write (unit, *) '' + write (unit, *) ' ' + close(unit) end subroutine create_pvd - subroutine close_pvd(unitPVD) + subroutine close_pvd(pvdPath) implicit none - integer, intent(in) :: unitPVD - - write (unitPVD, *) ' ' - write (unitPVD, *) '' - close (unitPVD) + character(len=*), intent(in) :: pvdPath + integer :: unit + integer :: ios + if (ios /= 0) stop "Error al abrir archivo PVD" + open (newunit=unit, file=trim(pvdPath), status="old", action="write", iostat=ios) + write (unit, *) ' ' + write (unit, *) '' + close (unit) end subroutine close_pvd function get_required_output_count(sgg) result(count) diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 2c028a01..0008dfcc 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -89,20 +89,20 @@ module outputTypes end type abstract_probe_t type, extends(abstract_probe_t) :: abstract_time_probe_t - integer(kind=SINGLE) :: fileUnitTime + character(len=BUFSIZE) :: filePathTime integer(kind=SINGLE) :: nTime = 0_SINGLE real(kind=RKIND_tiempo), allocatable :: timeStep(:) end type abstract_time_probe_t type, extends(abstract_probe_t) :: abstract_frequency_probe_t - integer(kind=SINGLE) :: fileUnitFreq + character(len=BUFSIZE) :: filePathFreq integer(kind=SINGLE) :: nFreq = 0_SINGLE real(kind=RKIND), allocatable :: frequencySlice(:) complex(kind=CKIND), allocatable :: auxExp_E(:), auxExp_H(:) end type abstract_frequency_probe_t type, extends(abstract_probe_t) :: abstract_time_frequency_probe_t - integer(kind=SINGLE) :: fileUnitTime, fileUnitFreq + character(len=BUFSIZE) :: filePathTime, filePathFreq integer(kind=SINGLE) :: nTime = 0_SINGLE, nFreq = 0_SINGLE real(kind=RKIND_tiempo), allocatable :: timeStep(:) real(kind=RKIND), allocatable :: frequencySlice(:) @@ -155,6 +155,7 @@ module outputTypes real(kind=RKIND), allocatable :: xValueForTime(:, :) real(kind=RKIND), allocatable :: yValueForTime(:, :) real(kind=RKIND), allocatable :: zValueForTime(:, :) + character(len=BUFSIZE) :: pvdPath end type movie_probe_output_t type, extends(abstract_frequency_probe_t) :: frequency_slice_probe_output_t @@ -164,6 +165,7 @@ module outputTypes complex(kind=CKIND), allocatable :: xValueForFreq(:, :) complex(kind=CKIND), allocatable :: yValueForFreq(:, :) complex(kind=CKIND), allocatable :: zValueForFreq(:, :) + character(len=BUFSIZE) :: pvdPath end type frequency_slice_probe_output_t !===================================================== diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 7bcd1430..f3850dfd 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -16,9 +16,6 @@ module mod_outputUtils public :: get_prefix_extension public :: get_field_component public :: get_field_reference - public :: open_file - public :: close_file - public :: create_or_clear_file public :: init_frequency_slice public :: getBlockCurrentDirection public :: isPEC @@ -32,6 +29,7 @@ module mod_outputUtils public :: computeJ1 public :: computeJ2 public :: fieldo + public :: create_data_file !=========================== !=========================== @@ -348,25 +346,6 @@ function get_field_reference(fieldId, fieldReference) result(field) end select end function get_field_reference - function open_file(fileUnit, fileName) result(iostat) - character(len=*), intent(in) :: fileName - integer(kind=SINGLE), intent(in) :: fileUnit - integer(kind=SINGLE) :: iostat - - open (unit=fileUnit, file=fileName, status='OLD', action='WRITE', position='APPEND', iostat=iostat) - if (iostat /= 0) then - open (unit=fileUnit, file=fileName, status='NEW', action='WRITE', iostat=iostat) - end if - return - end function open_file - - function close_file(fileUnit) result(iostat) - integer(kind=SINGLE), intent(in) :: fileUnit - integer(kind=SINGLE) :: iostat - - close (fileUnit, iostat=iostat) - end function close_file - subroutine init_frequency_slice(frequencySlice, domain) real(kind=RKIND), dimension(:), intent(out) :: frequencySlice type(domain_t), intent(in) :: domain @@ -622,48 +601,18 @@ function get_delta(field, i, j, k, fields_reference) result(res) end select end function get_delta - subroutine create_or_clear_file(path, unit_out, err) - implicit none - character(len=*), intent(in) :: path - integer, intent(out) :: unit_out - integer, intent(out) :: err - integer :: unit, ios - logical :: opened - character(len=BUFSIZE) :: fname - integer, parameter :: unit_min = 10, unit_max = 99 - - err = 0 - unit_out = -1 - - ! --- Find a free unit --- - do unit = unit_min, unit_max - inquire (unit=unit, opened=opened, name=fname) - if (.not. opened) exit ! Found free unit - if (trim(fname) == trim(path)) then - ! Unit is already associated with the same file -> safe to clear - close (unit) - exit - end if - end do - - ! Check if no free unit was found - inquire (unit=unit, opened=opened) - if (opened) then - err = 1 - return - end if - - ! --- Open the file, replacing it if it exists --- - open (unit=unit, file=path, status="replace", action="write", iostat=ios) - if (ios /= 0) then - err = 2 - return - end if - - close (unit) - - ! --- Success --- - unit_out = unit - end subroutine create_or_clear_file + subroutine create_data_file(filePathReference, probePathReference ,domainTypeReference, fileExtension) + use mod_directoryUtils + character(len=*), intent(out) :: filePathReference + character(len=*), intent(in) :: probePathReference + character(len=*), intent(in) :: domainTypeReference + character(len=*), intent(in) :: fileExtension + + character(len=1) :: sep = '_' + integer :: err + + filePathReference = trim(probePathReference)//sep//trim(domainTypeReference)//fileExtension + call create_file_with_path(filePathReference, err) + end subroutine end module mod_outputUtils diff --git a/src_output/pointProbeOutput.F90 b/src_output/pointProbeOutput.F90 index 127eab4d..0c06fd67 100644 --- a/src_output/pointProbeOutput.F90 +++ b/src_output/pointProbeOutput.F90 @@ -9,14 +9,9 @@ module mod_pointProbeOutput private - !=========================== - ! Public interface summary - !=========================== public :: init_point_probe_output - public :: create_point_probe_output_files public :: update_point_probe_output public :: flush_point_probe_output - !=========================== contains subroutine init_point_probe_output(this, coordinates, field, domain, outputTypeExtension, mpidir, timeInterval) @@ -40,6 +35,7 @@ subroutine init_point_probe_output(this, coordinates, field, domain, outputTypeE if (any(this%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then call alloc_and_init(this%timeStep, BUFSIZE, 0.0_RKIND_tiempo) call alloc_and_init(this%valueForTime, BUFSIZE, 0.0_RKIND) + call create_data_file(this%filePathTime, this%path, timeExtension, datFileExtension) end if if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then this%nFreq = this%domain%fnum @@ -56,6 +52,7 @@ subroutine init_point_probe_output(this, coordinates, field, domain, outputTypeE this%auxExp_E(i) = timeInterval*(1.0E0_RKIND, 0.0E0_RKIND)*Exp(mcpi2*this%frequencySlice(i)) !el dt deberia ser algun tipo de promedio this%auxExp_H(i) = this%auxExp_E(i)*Exp(mcpi2*this%frequencySlice(i)*timeInterval*0.5_RKIND) end do + call create_data_file(this%filePathFreq, this%path, frequencyExtension, datFileExtension) end if contains @@ -71,26 +68,6 @@ end function get_output_path end subroutine init_point_probe_output - subroutine create_point_probe_output_files(this) - implicit none - type(point_probe_output_t), intent(inout) :: this - character(len=BUFSIZE) :: file_time, file_freq - integer(kind=SINGLE) :: err - err = 0 - - file_time = trim(adjustl(this%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & - trim(adjustl(datFileExtension)) - - file_freq = trim(adjustl(this%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & - trim(adjustl(datFileExtension)) - - call create_or_clear_file(file_time, this%fileUnitTime, err) - call create_or_clear_file(file_freq, this%fileUnitFreq, err) - - end subroutine create_point_probe_output_files - subroutine update_point_probe_output(this, step, field) type(point_probe_output_t), intent(inout) :: this real(kind=RKIND), pointer, dimension(:, :, :), intent(in) :: field @@ -135,27 +112,26 @@ subroutine flush_point_probe_output(this) subroutine flush_time_domain(this) type(point_probe_output_t), intent(in) :: this integer :: i - character(len=BUFSIZE) :: filename + integer :: unit if (this%nTime <= 0) then print *, "No data to write." return end if - filename = trim(adjustl(this%path))//'_'//trim(adjustl(timeExtension))//'_'//trim(adjustl(datFileExtension)) - open (unit=this%fileUnitTime, file=filename, status="old", action="write", position="append") + open (unit=unit, file=this%filePathTime, status="old", action="write", position="append") do i = 1, this%nTime - write (this%fileUnitTime, '(F12.6,1X,F12.6)') this%timeStep(i), this%valueForTime(i) + write (unit, '(F12.6,1X,F12.6)') this%timeStep(i), this%valueForTime(i) end do - close (this%fileUnitTime) + close (unit) end subroutine flush_time_domain subroutine flush_frequency_domain(this) type(point_probe_output_t), intent(in) :: this - integer ::i - character(len=BUFSIZE) :: filename + integer :: i + integer :: unit if (.not. allocated(this%frequencySlice) .or. .not. allocated(this%valueForFreq)) then print *, "Error: arrays not allocated." @@ -166,14 +142,13 @@ subroutine flush_frequency_domain(this) print *, "No data to write." return end if - filename = trim(adjustl(this%path))//'_'//trim(adjustl(frequencyExtension))//'_'//trim(adjustl(datFileExtension)) - open (unit=this%fileUnitFreq, file=filename, status="replace", action="write") + open (unit=unit, file=this%filePathFreq, status="replace", action="write") do i = 1, this%nFreq - write (this%fileUnitFreq, '(F12.6,1X,F12.6,1X,F12.6)') this%frequencySlice(i), real(this%valueForFreq(i)), aimag(this%valueForFreq(i)) + write (unit, '(F12.6,1X,F12.6,1X,F12.6)') this%frequencySlice(i), real(this%valueForFreq(i)), aimag(this%valueForFreq(i)) end do - close (this%fileUnitFreq) + close (unit) end subroutine flush_frequency_domain subroutine clear_time_data() diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 index eed3e45f..572cc288 100644 --- a/src_output/wireProbeOutput.F90 +++ b/src_output/wireProbeOutput.F90 @@ -15,8 +15,6 @@ module mod_wireProbeOutput !=========================== public :: init_wire_current_probe_output public :: init_wire_charge_probe_output - public :: create_wire_current_probe_output - public :: create_wire_charge_probe_output public :: update_wire_current_probe_output public :: update_wire_charge_probe_output public :: flush_wire_current_probe_output @@ -65,6 +63,7 @@ subroutine init_wire_current_probe_output(this, coordinates, node, field, domain this%path = build_output_path(outputTypeExtension, field, node, mpidir, coordinates) call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) + call create_data_file(this%filePathTime, this%path, timeExtension, datFileExtension) end subroutine init_wire_current_probe_output @@ -87,26 +86,10 @@ subroutine init_wire_charge_probe_output(this, coordinates, node, field, domain, call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) call alloc_and_init(this%chargeValue, BuffObse, 0.0_RKIND) + call create_data_file(this%filePathTime, this%path, timeExtension, datFileExtension) end subroutine init_wire_charge_probe_output - !====================================================================== - ! FILE CREATION - !====================================================================== - subroutine create_wire_current_probe_output(this) - type(wire_current_probe_output_t), intent(inout) :: this - integer(kind=SINGLE) :: err - call create_or_clear_file(trim(this%path)//'_'//timeExtension//'_'//datFileExtension, & - this%fileUnitTime, err) - end subroutine - - subroutine create_wire_charge_probe_output(this) - type(wire_charge_probe_output_t), intent(inout) :: this - integer(kind=SINGLE) :: err - call create_or_clear_file(trim(this%path)//'_'//timeExtension//'_'//datFileExtension, & - this%fileUnitTime, err) - end subroutine - !====================================================================== ! UPDATE !====================================================================== @@ -149,19 +132,20 @@ subroutine update_wire_charge_probe_output(this, step) subroutine flush_wire_current_probe_output(this) type(wire_current_probe_output_t), intent(inout) :: this integer :: i + integer :: unit - open(this%fileUnitTime, file=trim(this%path)//'_'//timeExtension//'_'//datFileExtension, & + open(unit, file=this%filePathTime, & status='old', position='append') do i = 1, this%nTime - write(this%fileUnitTime, fmt) this%timeStep(i), & + write(unit, fmt) this%timeStep(i), & this%currentValues(i)%current, & this%currentValues(i)%deltaVoltage, & this%currentValues(i)%plusVoltage, & this%currentValues(i)%minusVoltage, & this%currentValues(i)%voltageDiference end do - close(this%fileUnitTime) + close(unit) call clear_current_time_data(this) end subroutine @@ -170,14 +154,15 @@ subroutine flush_wire_current_probe_output(this) subroutine flush_wire_charge_probe_output(this) type(wire_charge_probe_output_t), intent(inout) :: this integer :: i + integer :: unit - open(this%fileUnitTime, file=trim(this%path)//'_'//timeExtension//'_'//datFileExtension, & + open(unit, file=this%filePathTime, & status='old', position='append') do i = 1, this%nTime - write(this%fileUnitTime, fmt) this%timeStep(i), this%chargeValue(i) + write(unit, fmt) this%timeStep(i), this%chargeValue(i) end do - close(this%fileUnitTime) + close(unit) call clear_charge_time_data(this) end subroutine diff --git a/src_utils/CMakeLists.txt b/src_utils/CMakeLists.txt index e735c664..13268e21 100644 --- a/src_utils/CMakeLists.txt +++ b/src_utils/CMakeLists.txt @@ -2,6 +2,7 @@ add_library(fdtd-utils "utils.F90" "valueReplacer.F90" "allocationUtils.F90" + "directoryUtils.F90" ) target_link_libraries(fdtd-utils semba-types diff --git a/src_utils/directoryUtils.F90 b/src_utils/directoryUtils.F90 new file mode 100644 index 00000000..70e2e739 --- /dev/null +++ b/src_utils/directoryUtils.F90 @@ -0,0 +1,189 @@ +module mod_directoryUtils + implicit none + private + + public :: create_folder + public :: folder_exists + public :: remove_folder + public :: file_exists + public :: delete_file + public :: list_files + public :: create_file_with_path + public :: get_path_separator + +contains + + !------------------------------------------------------------ + ! Check if a folder exists + !------------------------------------------------------------ + function folder_exists(path) result(exists) + character(len=*), intent(in) :: path + logical :: exists + character(len=256) :: p + + p = trim(path) + if (index(p, '\') > 0) then + p = trim(p)//"\" + else + p = trim(p)//"/" + end if + + inquire (file=p, exist=exists) + end function folder_exists + + !------------------------------------------------------------ + ! Create a folder (portable) + !------------------------------------------------------------ + subroutine create_folder(path, ios) + character(len=*), intent(in) :: path + integer, intent(out) :: ios + + if (folder_exists(path)) then + ios = 0 + return + end if + +#ifdef _WIN32 + call execute_command_line("mkdir """//trim(path)//"""", exitstat=ios) +#else + call execute_command_line("mkdir -p "//trim(path), exitstat=ios) +#endif + end subroutine create_folder + + !------------------------------------------------------------ + ! Remove a folder + !------------------------------------------------------------ + subroutine remove_folder(path, ios) + character(len=*), intent(in) :: path + integer, intent(out) :: ios + + if (.not. folder_exists(path)) then + ios = 0 + return + end if + +#ifdef _WIN32 + call execute_command_line("rmdir /S /Q """//trim(path)//"""", exitstat=ios) +#else + call execute_command_line("rm -rf "//trim(path), exitstat=ios) +#endif + + end subroutine remove_folder + + !------------------------------------------------------------ + ! Check if a file exists + !------------------------------------------------------------ + function file_exists(path) result(exists) + character(len=*), intent(in) :: path + logical :: exists + + inquire (file=trim(path), exist=exists) + end function file_exists + + !------------------------------------------------------------ + ! Delete a file + !------------------------------------------------------------ + subroutine delete_file(path, ios) + character(len=*), intent(in) :: path + integer, intent(out) :: ios + + if (.not. file_exists(path)) then + ios = 0 + return + end if + +#ifdef _WIN32 + call execute_command_line("del /Q """//trim(path)//"""", exitstat=ios) +#else + call execute_command_line("rm -f "//trim(path), exitstat=ios) +#endif + + end subroutine delete_file + + !------------------------------------------------------------ + ! List files in a folder (simple) + !------------------------------------------------------------ + subroutine list_files(path, files, nfiles, ios) + character(len=*), intent(in) :: path + character(len=256), dimension(:), intent(out) :: files + integer, intent(out) :: nfiles + integer, intent(out) :: ios + + character(len=512) :: cmd + character(len=512) :: line + integer :: i + integer :: unit + + nfiles = 0 + ios = 0 + + if (.not. folder_exists(path)) then + ios = 1 + return + end if + +#ifdef _WIN32 + cmd = 'dir /B "'//trim(path)//'"' +#else + cmd = 'ls -1 "'//trim(path)//'"' +#endif + + open (newunit=unit, file=cmd, action='read', status='old', iostat=ios) + + if (ios /= 0) return + + do + read (unit, '(A)', iostat=ios) line + if (ios /= 0) exit + i = i + 1 + if (i > size(files)) then + ios = 2 + exit + end if + files(i) = adjustl(trim(line)) + end do + + nfiles = i + close (unit) + + end subroutine list_files + + !------------------------------------------------------------ + ! Create a file, creating its folder if needed + !------------------------------------------------------------ + subroutine create_file_with_path(fullpath, ios) + character(len=*), intent(in) :: fullpath + integer, intent(out) :: ios + integer :: unit + + character(len=512) :: folder + integer :: pos + + ios = 0 + + ! Find last slash or backslash + pos = max(index(fullpath, '/'), index(fullpath, '\')) + + if (pos > 0) then + folder = adjustl(fullpath(:pos - 1)) + call create_folder(trim(folder), ios) + if (ios /= 0) return + end if + + open (newunit=unit, file=trim(fullpath), status='replace', action='write', iostat=ios) + if (ios == 0) close (unit) + + end subroutine create_file_with_path + + function get_path_separator() result(sep) + character(len=1) :: sep + +#ifdef _WIN32 + sep = '\' +#else + sep = '/' +#endif + + end function get_path_separator + +end module mod_directoryUtils diff --git a/src_utils/utils.F90 b/src_utils/utils.F90 index 58c7f93c..da6a7b7d 100644 --- a/src_utils/utils.F90 +++ b/src_utils/utils.F90 @@ -1,6 +1,7 @@ module mod_UTILS use mod_allocationUtils use mod_valueReplacer + use mod_directoryUtils implicit none contains From dfa4b1024dd009b2e39bcc9d463d2dd414ce1670 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 26 Jan 2026 13:33:44 +0100 Subject: [PATCH 67/67] Implement teardown on point probe tests --- CMakeLists.txt | 8 ++ src_output/output.F90 | 9 -- test/output/test_output.F90 | 190 +++++++++++++++++++----------- test/output/test_output_utils.F90 | 2 +- 4 files changed, 128 insertions(+), 81 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 11c820de..fbf30376 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -31,6 +31,14 @@ option(SEMBA_FDTD_OUTPUTS_LIB "Compiles outputs library" ON) option(SEMBA_FDTD_ENABLE_OUTPUT_MODULE "Use new output module" OFF) # Compilation defines. +if (CMAKE_SYSTEM_NAME STREQUAL "Windows") +add_compile_definitions(_WIN32) +elseif (CMAKE_SYSTEM_NAME STREQUAL "Darwin") +add_compile_definitions(__APPLE__) +elseif (CMAKE_SYSTEM_NAME STREQUAL "Linux") +add_compile_definitions(__linux__) +endif() + if(SEMBA_FDTD_ENABLE_OUTPUT_MODULE) add_definitions(-DCompileWithNewOutputModule) endif() diff --git a/src_output/output.F90 b/src_output/output.F90 index e391255e..f1d910a5 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -299,15 +299,6 @@ end function preprocess_polar_range end subroutine init_outputs - subroutine create_output_files() - integer(kind=SINGLE) :: i - do i = 1, size(outputs) - select case (outputs(i)%outputID) - case (POINT_PROBE_ID); call create_empty_files(outputs(i)%pointProbe) - end select - end do - end subroutine create_output_files - subroutine update_outputs(control, discreteTimeArray, timeIndx, fieldsReference) integer(kind=SINGLE), intent(in) :: timeIndx real(kind=RKIND_tiempo), dimension(:), intent(in) :: discreteTimeArray diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 2bb00546..6a54f162 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -2,9 +2,22 @@ integer function test_init_point_probe() bind(c) result(err) use FDETYPES use FDETYPES_TOOLS use output + use outputTypes use mod_testOutputUtils use mod_sggMethods use mod_assertionTools + use mod_directoryUtils + implicit none + + ! Parameters + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=18), parameter :: test_name = 'initPointProbeTest' + + ! Local variables + character(len=1) :: sep + character(len=BUFSIZE) :: nEntrada + character(len=BUFSIZE) :: expectedProbePath + character(len=BUFSIZE) :: expectedDataPath type(SGGFDTDINFO) :: sgg type(sim_control_t) :: control @@ -19,8 +32,15 @@ integer function test_init_point_probe() bind(c) result(err) real(kind=RKIND_tiempo), pointer :: timeArray(:) real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo integer(kind=SINGLE) :: nSteps = 100_SINGLE - logical :: outputRequested, hasWires = .false. - integer(kind=SINGLE) :: test_err = 0 + + logical :: outputRequested + logical :: hasWires = .false. + integer(kind=SINGLE) :: test_err = 0 + integer :: ios + + ! Setup + sep = get_path_separator() + nEntrada = test_folder//sep//test_name call sgg_init(sgg) call init_time_array(timeArray, nSteps, dt) @@ -34,18 +54,25 @@ integer function test_init_point_probe() bind(c) result(err) probe = create_point_probe_observation(4, 4, 4) call sgg_add_observation(sgg, probe) - control = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') + control = create_control_flags(mpidir=3, nEntradaRoot=trim(nEntrada), wiresflavor='holland') + ! Action call init_outputs(sgg, media, sinpml, bounds, control, outputRequested, hasWires) - outputs => GetOutputs() - test_err = test_err + assert_true(outputRequested, 'Valid probes not found') + ! Assertions + test_err = test_err + assert_true(outputRequested, 'Valid probes not found') test_err = test_err + assert_integer_equal(outputs(1)%outputID, POINT_PROBE_ID, 'Unexpected probe id') - test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, & - 'entradaRoot_poinProbe_Ex_4_4_4', 'Unexpected path') - call close_outputs() + expectedProbePath = trim(nEntrada)//wordSeparation//'pointProbe_Ex_4_4_4' + expectedDataPath = trim(expectedProbePath)//wordSeparation//timeExtension//datFileExtension + + test_err = test_err + assert_string_equal(outputs(1)%pointProbe%path, expectedProbePath, 'Unexpected path') + test_err = test_err + assert_string_equal(outputs(1)%pointProbe%filePathTime, expectedDataPath, 'Unexpected path') + test_err = test_err + assert_true(file_exists(expectedDataPath), 'Time data file do not exist') + + ! Cleanup + call remove_folder(test_folder, ios) deallocate (sgg%Observation, outputs) err = test_err @@ -59,6 +86,16 @@ integer function test_update_point_probe() bind(c) result(err) use mod_testOutputUtils use mod_sggMethods use mod_assertionTools + use mod_directoryUtils + implicit none + + ! Parameters + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=20), parameter :: test_name = 'updatePointProbeTest' + + ! Local variables + character(len=1) :: sep + character(len=BUFSIZE) :: nEntrada type(SGGFDTDINFO) :: sgg type(sim_control_t) :: control @@ -76,8 +113,15 @@ integer function test_update_point_probe() bind(c) result(err) real(kind=RKIND_tiempo), pointer :: timeArray(:) real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo integer(kind=SINGLE) :: nSteps = 100_SINGLE - logical :: outputRequested, hasWires = .false. - integer(kind=SINGLE) :: test_err = 0 + + logical :: outputRequested + logical :: hasWires = .false. + integer(kind=SINGLE) :: test_err = 0 + integer :: ios + + ! Setup + sep = get_path_separator() + nEntrada = test_folder//sep//test_name call sgg_init(sgg) call init_time_array(timeArray, nSteps, dt) @@ -91,8 +135,7 @@ integer function test_update_point_probe() bind(c) result(err) materialsPtr => materials call sgg_set_Med(sgg, materialsPtr) - control = create_control_flags(mpidir=3, nEntradaRoot='entradaRoot', wiresflavor='holland') - + control = create_control_flags(mpidir=3, nEntradaRoot=nEntrada, wiresflavor='holland') call init_outputs(sgg, media, sinpml, bounds, control, outputRequested, hasWires) call create_dummy_fields(dummyFields, 1, 10, 0.01_RKIND) @@ -103,6 +146,7 @@ integer function test_update_point_probe() bind(c) result(err) fields%E%deltax => dummyFields%dxe fields%E%deltaY => dummyFields%dye fields%E%deltaZ => dummyFields%dze + fields%H%x => dummyFields%Hx fields%H%y => dummyFields%Hy fields%H%z => dummyFields%Hz @@ -110,11 +154,12 @@ integer function test_update_point_probe() bind(c) result(err) fields%H%deltaY => dummyFields%dyh fields%H%deltaZ => dummyFields%dzh + ! Action dummyFields%Ex(4, 4, 4) = 5.0_RKIND call update_outputs(control, sgg%tiempo, 1_SINGLE, fields) - outputs => GetOutputs() + ! Assertions test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(1), 0.0_RKIND_tiempo, 1e-5_RKIND_tiempo, 'Unexpected timestep 1') test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(1), 5.0_RKIND, 1e-5_RKIND, 'Unexpected field 1') @@ -124,7 +169,8 @@ integer function test_update_point_probe() bind(c) result(err) test_err = test_err + assert_real_time_equal(outputs(1)%pointProbe%timeStep(2), 0.1_RKIND_tiempo, 1e-5_RKIND_tiempo, 'Unexpected timestep 2') test_err = test_err + assert_real_equal(outputs(1)%pointProbe%valueForTime(2), -4.0_RKIND, 1e-5_RKIND, 'Unexpected field 2') - call close_outputs() + !Cleanup + call remove_folder(test_folder, ios) err = test_err end function @@ -136,19 +182,28 @@ integer function test_flush_point_probe() bind(c) result(err) use mod_domain use mod_testOutputUtils use mod_assertionTools + use mod_directoryUtils + implicit none + + ! Parameters + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=19), parameter :: test_name = 'flushPointProbeTest' + + ! Local variables + character(len=1) :: sep + character(len=BUFSIZE) :: nEntrada type(point_probe_output_t) :: probe type(domain_t) :: domain type(cell_coordinate_t) :: coordinates - character(len=BUFSIZE) :: file_time, file_freq - character(len=27) :: test_extension - integer :: n, i integer :: test_err = 0 + integer :: ios - err = 1 - test_extension = 'tmp_cases/flush_point_probe' + ! Setup + sep = get_path_separator() + nEntrada = test_folder//sep//test_name domain = domain_t( & 0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, & @@ -158,10 +213,9 @@ integer function test_flush_point_probe() bind(c) result(err) coordinates%y = 2 coordinates%z = 2 - call init_point_probe_output(probe, coordinates, iEx, domain, & - test_extension, 3, 0.1_RKIND_tiempo) - call create_point_probe_output_files(probe) + call init_point_probe_output(probe, coordinates, iEx, domain, nEntrada, 3, 0.1_RKIND_tiempo) + ! Action n = 10 do i = 1, n probe%timeStep(i) = real(i) @@ -173,25 +227,15 @@ integer function test_flush_point_probe() bind(c) result(err) probe%nTime = n probe%nFreq = n - file_time = trim(adjustl(probe%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & - trim(adjustl(datFileExtension)) - - file_freq = trim(adjustl(probe%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & ! intentional: mirrors implementation - trim(adjustl(datFileExtension)) - call flush_point_probe_output(probe) - test_err = test_err + assert_written_output_file(file_time) - test_err = test_err + assert_written_output_file(file_freq) + ! Assertions + test_err = test_err + assert_written_output_file(probe%filePathTime) + test_err = test_err + assert_written_output_file(probe%filePathFreq) - test_err = test_err + assert_integer_equal( & - probe%nTime, 0, & - 'ERROR: clear_time_data did not reset serializedTimeSize!') + test_err = test_err + assert_integer_equal(probe%nTime, 0, 'ERROR: clear_time_data did not reset serializedTimeSize!') - if (.not. all(probe%timeStep == 0.0) .or. & - .not. all(probe%valueForTime == 0.0)) then + if (.not. all(probe%timeStep == 0.0) .or. .not. all(probe%valueForTime == 0.0)) then print *, 'ERROR: time arrays not cleared!' test_err = test_err + 1 end if @@ -201,8 +245,11 @@ integer function test_flush_point_probe() bind(c) result(err) test_err = test_err + 1 end if + !Cleanup + call remove_folder(test_folder, ios) + err = test_err -end function test_flush_point_probe +end function integer function test_multiple_flush_point_probe() bind(c) result(err) use output @@ -211,22 +258,31 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) use mod_domain use mod_testOutputUtils use mod_assertionTools + use mod_directoryUtils + implicit none + + ! Parameters + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=27), parameter :: test_name = 'flushMultiplePointProbeTest' + + ! Local variables + character(len=1) :: sep + character(len=BUFSIZE) :: nEntrada type(point_probe_output_t) :: probe type(domain_t) :: domain type(cell_coordinate_t) :: coordinates - character(len=BUFSIZE) :: file_time, file_freq - character(len=36) :: test_extension - real(kind=RKIND), allocatable :: expectedTime(:, :) real(kind=RKIND), allocatable :: expectedFreq(:, :) - integer :: n, i + integer :: n, i, unit integer :: test_err = 0 + integer :: ios - err = 1 - test_extension = 'tmp_cases/multiple_flush_point_probe' + ! Setup + sep = get_path_separator() + nEntrada = test_folder//sep//test_name domain = domain_t( & 0.0_RKIND_tiempo, 10.0_RKIND_tiempo, 0.1_RKIND_tiempo, & @@ -236,22 +292,13 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) coordinates%y = 2 coordinates%z = 2 - call init_point_probe_output(probe, coordinates, iEx, domain, & - test_extension, 3, 0.1_RKIND_tiempo) - call create_point_probe_output_files(probe) - - file_time = trim(adjustl(probe%path))//'_'// & - trim(adjustl(timeExtension))//'_'// & - trim(adjustl(datFileExtension)) - - file_freq = trim(adjustl(probe%path))//'_'// & - trim(adjustl(frequencyExtension))//'_'// & - trim(adjustl(datFileExtension)) + call init_point_probe_output(probe, coordinates, iEx, domain, nEntrada, 3, 0.1_RKIND_tiempo) n = 10 allocate (expectedTime(2*n, 2)) allocate (expectedFreq(n, 2)) + ! Action - first flush do i = 1, n probe%timeStep(i) = real(i) probe%valueForTime(i) = 10.0*i @@ -267,9 +314,9 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) probe%nTime = n probe%nFreq = n - call flush_point_probe_output(probe) + ! Action - second flush do i = 1, n probe%timeStep(i) = real(i + 10) probe%valueForTime(i) = 10.0*(i + 10) @@ -283,19 +330,22 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) end do probe%nTime = n - call flush_point_probe_output(probe) - open (unit=probe%fileUnitTime, file=file_time, status='old', action='read') - test_err = test_err + assert_file_content(probe%fileUnitTime, expectedTime, 2*n, 2, 1e-06_RKIND) - close (probe%fileUnitTime) + ! Assertions + open (unit=unit, file=probe%filePathTime, status='old', action='read') + test_err = test_err + assert_file_content(unit, expectedTime, 2*n, 2, 1e-06_RKIND) + close (unit) - open (unit=probe%fileUnitFreq, file=file_freq, status='old', action='read') - test_err = test_err + assert_file_content(probe%fileUnitFreq, expectedFreq, n, 2, 1e-06_RKIND) - close (probe%fileUnitFreq) + open (unit=unit, file=probe%filePathFreq, status='old', action='read') + test_err = test_err + assert_file_content(unit, expectedFreq, n, 2, 1e-06_RKIND) + close (unit) + + !Cleanup + call remove_folder(test_folder, ios) err = test_err -end function test_multiple_flush_point_probe +end function integer function test_init_movie_probe() bind(c) result(err) use output @@ -392,8 +442,6 @@ integer function test_init_movie_probe() bind(c) result(err) test_err = test_err + assert_integer_equal( & size(outputs(1)%movieProbe%timeStep), BuffObse, 'Unexpected timestep buffer size') - call close_outputs() - err = test_err end function @@ -896,8 +944,8 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) test_err = test_err + assert_array_value(outputs(1)%frequencySliceProbe%xValueForFreq, (0.0_CKIND , 0.0_CKIND), errormessage='Detected Current on X Axis for Hx gradient') test_err = test_err + assert_arrays_equal(outputs(1)%frequencySliceProbe%yValueForFreq, & - -1.0_RKIND * outputs(1)%frequencySliceProbe%zValueForFreq, errormessage='Unequal values for Y and -Z') - + -1.0_RKIND*outputs(1)%frequencySliceProbe%zValueForFreq, errormessage='Unequal values for Y and -Z') + call close_outputs() err = test_err @@ -1001,11 +1049,11 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) outputs(1)%frequencySliceProbe%yvalueForFreq(freq, :) = [(0.5_RKIND, 0.5_RKIND), (0.6_RKIND, 0.6_RKIND), (0.7_RKIND, 0.7_RKIND), (0.8_RKIND, 0.8_RKIND)] outputs(1)%frequencySliceProbe%zvalueForFreq(freq, :) = [(0.9_RKIND, 0.9_RKIND), (1.0_RKIND, 1.0_RKIND), (1.1_RKIND, 1.1_RKIND), (1.2_RKIND, 1.2_RKIND)] end do - !frequencySliceXObservable + !frequencySliceXObservable do freq = 1, expectedNumFrequencies outputs(2)%frequencySliceProbe%xvalueForFreq(freq, :) = [(0.1_RKIND, 0.1_RKIND), (0.2_RKIND, 0.2_RKIND), (0.3_RKIND, 0.3_RKIND), (0.4_RKIND, 0.4_RKIND)] end do - !frequencySliceYObservable + !frequencySliceYObservable do freq = 1, expectedNumFrequencies outputs(3)%frequencySliceProbe%yvalueForFreq(freq, :) = [(0.1_RKIND, 0.1_RKIND), (0.2_RKIND, 0.2_RKIND), (0.3_RKIND, 0.3_RKIND), (0.4_RKIND, 0.4_RKIND)] end do @@ -1014,7 +1062,7 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) !--- Assert generated files --- do iter = 1, expectedNumFrequencies - write(freqIdName, '(i3)') iter + write (freqIdName, '(i3)') iter expectedPath = trim(adjustl(outputs(1)%frequencySliceProbe%path))//'_fq'//'000'//trim(adjustl(freqIdName))//'.vtu' test_err = test_err + assert_file_exists(expectedPath) end do diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index f58d9929..da24797d 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -49,7 +49,7 @@ function create_point_probe_observation(x, y, z) result(obs) P(1) = create_observable(x, y, z, x, y, z, iEx) call initialize_observation_time_domain(domain, 0.0_RKIND, 10.0_RKIND, 0.1_RKIND) - call set_observation(obs, P, 'poinProbe', domain, 'DummyFileNormalize') + call set_observation(obs, P, 'pointProbe', domain, 'DummyFileNormalize') end function function create_volumic_probe_observation(xi, yi, zi, xe, ye, ze) result(obs)