From 2f959c65960e3fb8bb1eda3e3aee1b0d31614ebb Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 27 Nov 2025 09:38:45 +0100 Subject: [PATCH 01/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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/96] 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) From 21835f833ea33368c95af9a32f68395e4b24032f Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 28 Jan 2026 15:09:43 +0100 Subject: [PATCH 68/96] Improve output format. Movie and frequencySlice now are created on their own folder --- src_output/frequencySliceProbeOutput.F90 | 11 +- src_output/movieProbeOutput.F90 | 12 +- src_output/output.F90 | 5 +- src_output/outputTypes.F90 | 5 +- src_utils/directoryUtils.F90 | 98 +++++++++++++- test/output/test_output.F90 | 158 +++++++++++++++++------ test/output/test_output_utils.F90 | 2 +- 7 files changed, 233 insertions(+), 58 deletions(-) diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index c34a56a8..34437a88 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -44,6 +44,8 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI type(problem_info_t), intent(in) :: problemInfo integer :: i + integer :: error + character(len=BUFSIZE) :: pdvFileName this%mainCoords = lowerBound this%auxCoords = upperBound @@ -51,6 +53,11 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI this%domain = domain this%path = get_output_path_freq(this, outputTypeExtension, field, control) + pdvFileName = add_extension(get_last_component(this%path), pdvExtension) + this%pvdPath = join_path(this%path, pdvFileName) + + call create_folder(this%path, error) + this%nFreq = domain%fnum call alloc_and_init(this%frequencySlice, this%nFreq, 0.0_RKIND) do i = 1, this%nFreq @@ -282,7 +289,7 @@ subroutine flush_frequency_slice_probe_output(this) integer :: status, i do i = 1, this%nFreq - call update_pvd(this, i, this%filePathFreq) + call update_pvd(this, i, this%pvdPath) end do end subroutine flush_frequency_slice_probe_output @@ -385,7 +392,7 @@ subroutine update_pvd(this, freq, PVDfilePath) integer :: unit - write (newVTUfilename, '(A,A,I4.4,A)') trim(this%path), '_fq', freq, '.vtu' + write (newVTUfilename, '(A,A,I4.4,A)') trim(remove_extension(this%pvdPath)), '_fq', freq, '.vtu' call write_vtu_frequency_slice(this, freq, newVTUfilename) write (ts, '(ES16.8)') this%frequencySlice(freq) diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index f9d1f63d..f9f97d2f 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -41,12 +41,16 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, character(len=BUFSIZE), intent(in) :: outputTypeExtension integer :: error + character(len=BUFSIZE) :: pdvFileName this%mainCoords = lowerBound this%auxCoords = upperBound this%component = field this%domain = domain this%path = get_output_path(this, outputTypeExtension, field, control%mpidir) + + pdvFileName = add_extension(get_last_component(this%path), pdvExtension) + this%pvdPath = join_path(this%path, pdvFileName) call create_folder(this%path, error) @@ -133,7 +137,7 @@ subroutine flush_movie_probe_output(this) integer :: i do i = 1, this%nTime - call update_pvd(this, i, this%filePathTime) + call update_pvd(this, i, this%pvdPath) end do call clear_memory_data(this) @@ -345,10 +349,10 @@ subroutine update_pvd(this, stepIndex, PVDfilePath) integer, intent(in) :: stepIndex character(len=*), intent(in) :: PVDfilePath character(len=64) :: ts - character(len=256) :: newVTUfilename + character(len=BUFSIZE) :: newVTUfilename integer :: unit - - write(newVTUfilename,'(A,A,I4.4,A)') trim(this%path), '_ts', stepIndex, '.vtu' + + write(newVTUfilename,'(A,A,I4.4,A)') trim(remove_extension(this%pvdPath)), '_ts', stepIndex, '.vtu' call write_vtu_timestep(this, stepIndex, newVTUfilename) write(ts,'(ES16.8)') this%timeStep(stepIndex) diff --git a/src_output/output.F90 b/src_output/output.F90 index f1d910a5..9226cbcf 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -193,15 +193,14 @@ 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%pvdPath) - + call create_pvd(outputs(outputCount)%movieProbe%pvdPath) else if (domain%domainType == FREQUENCY_DOMAIN) then outputCount = outputCount + 1 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%pvdPath) + call create_pvd(outputs(outputCount)%frequencySliceProbe%pvdPath) end if case (farfield) diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 0008dfcc..968cbd51 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -21,8 +21,9 @@ module outputTypes integer, parameter :: BOTH_DOMAIN = 2 character(len=4), parameter :: datFileExtension = '.dat' - character(len=4), parameter :: timeExtension = 'tm' - character(len=4), parameter :: frequencyExtension = 'fq' + character(len=2), parameter :: timeExtension = 'tm' + character(len=2), parameter :: frequencyExtension = 'fq' + character(len=1), parameter :: wordseparation = '_' !===================================================== ! Basic helper / geometry types diff --git a/src_utils/directoryUtils.F90 b/src_utils/directoryUtils.F90 index 70e2e739..cf1829f7 100644 --- a/src_utils/directoryUtils.F90 +++ b/src_utils/directoryUtils.F90 @@ -1,9 +1,14 @@ module mod_directoryUtils + use FDETYPES implicit none private + public :: add_extension public :: create_folder + public :: remove_extension public :: folder_exists + public :: join_path + public :: get_last_component public :: remove_folder public :: file_exists public :: delete_file @@ -13,13 +18,23 @@ module mod_directoryUtils contains + !------------------------------------------------------------ + ! Add an extension to a filename + !------------------------------------------------------------ + function add_extension(filename, ext) result(fullname) + character(len=*), intent(in) :: filename, ext + character(len=:), allocatable :: fullname + + fullname = trim(filename) // trim(ext) + end function add_extension + !------------------------------------------------------------ ! Check if a folder exists !------------------------------------------------------------ function folder_exists(path) result(exists) character(len=*), intent(in) :: path logical :: exists - character(len=256) :: p + character(len=BUFSIZE) :: p p = trim(path) if (index(p, '\') > 0) then @@ -31,6 +46,77 @@ function folder_exists(path) result(exists) inquire (file=p, exist=exists) end function folder_exists + !------------------------------------------------------------ + ! Remove the final extension from a filename + !------------------------------------------------------------ + function remove_extension(filename) result(base) + character(len=*), intent(in) :: filename + character(len=BUFSIZE) :: base + integer :: last_dot, n, i + + base = trim(filename) + n = len_trim(base) + last_dot = 0 + + do i = n, 1, -1 + if (base(i:i) == '.') then + last_dot = i + exit + end if + end do + + if (last_dot > 0) then + base = base(:last_dot-1) + end if + end function remove_extension + + !------------------------------------------------------------ + ! Join two path components into one (simplified) + !------------------------------------------------------------ + function join_path(base, child) result(fullpath) + character(len=*), intent(in) :: base, child + character(len=:), allocatable :: fullpath + character(len=1) :: sep + integer :: n + + + sep = get_path_separator() + + + fullpath = trim(base) + n = len_trim(fullpath) + + + if (n > 0) then + if (fullpath(n:n) /= sep) fullpath = fullpath // sep + end if + + + fullpath = fullpath // trim(child) + end function join_path + + !------------------------------------------------------------ + ! Get the last component of a path (file or folder) + !------------------------------------------------------------ + function get_last_component(path) result(component) + character(len=*), intent(in) :: path + character(len=BUFSIZE) :: component + integer :: last_slash, n + + n = len_trim(path) + component = path(:n) + + if (n > 0) then + if (component(n:n) == get_path_separator()) component = component(:n - 1) + end if + + last_slash = scan(component, get_path_separator()) + + if (last_slash > 0) then + component = component(last_slash + 1:) + end if + end function get_last_component + !------------------------------------------------------------ ! Create a folder (portable) !------------------------------------------------------------ @@ -105,12 +191,12 @@ end subroutine delete_file !------------------------------------------------------------ subroutine list_files(path, files, nfiles, ios) character(len=*), intent(in) :: path - character(len=256), dimension(:), intent(out) :: files + character(len=BUFSIZE), dimension(:), intent(out) :: files integer, intent(out) :: nfiles integer, intent(out) :: ios - character(len=512) :: cmd - character(len=512) :: line + character(len=BUFSIZE) :: cmd + character(len=BUFSIZE) :: line integer :: i integer :: unit @@ -156,13 +242,13 @@ subroutine create_file_with_path(fullpath, ios) integer, intent(out) :: ios integer :: unit - character(len=512) :: folder + character(len=BUFSIZE) :: folder integer :: pos ios = 0 ! Find last slash or backslash - pos = max(index(fullpath, '/'), index(fullpath, '\')) + pos = index(fullpath, get_path_separator()) if (pos > 0) then folder = adjustl(fullpath(:pos - 1)) diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 6a54f162..f8296a3a 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -354,6 +354,8 @@ integer function test_init_movie_probe() bind(c) result(err) use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + use mod_directoryUtils + implicit none type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl @@ -383,7 +385,18 @@ integer function test_init_movie_probe() bind(c) result(err) integer(kind=SINGLE) :: iter integer(kind=SINGLE) :: test_err = 0 - character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=9), parameter :: test_name = 'initMovie' + + character(len=BUFSIZE) :: nEntrada + character(len=1) :: sep + character(len=BUFSIZE) :: expectedProbePath + character(len=BUFSIZE) :: expectedPDVPath + character(len=BUFSIZE) :: pdvFileName + integer :: ios + + sep = get_path_separator() + nEntrada = test_folder//sep//test_name err = 1 @@ -422,25 +435,29 @@ integer function test_init_movie_probe() bind(c) result(err) sinpml(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) end do - dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) 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)%outputID, MOVIE_PROBE_ID, 'Unexpected probe id') + 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_integer_equal(size(outputs(1)%movieProbe%timeStep), BuffObse, 'Unexpected timestep buffer size') - test_err = test_err + assert_integer_equal(outputs(1)%movieProbe%nPoints, & - expectedNumMeasurments, 'Unexpected number of measurements') + expectedProbePath = trim(nEntrada)//wordSeparation//'movieProbe_BC_2_2_2__5_5_5' + pdvFileName = trim(get_last_component(expectedProbePath))//pdvExtension + expectedPDVPath = join_path(expectedProbePath, pdvFileName) - test_err = test_err + assert_integer_equal( & - size(outputs(1)%movieProbe%xValueForTime), & - expectedNumMeasurments*BuffObse, 'Unexpected allocation size') + test_err = test_err + assert_string_equal(outputs(1)%movieProbe%path, expectedProbePath, 'Unexpected path') + test_err = test_err + assert_string_equal(outputs(1)%movieProbe%pvdPath, expectedPDVPath, 'Unexpected pdv path') + test_err = test_err + assert_true(folder_exists(expectedProbePath), 'Movie folder do not exist') + test_err = test_err + assert_true(file_exists(expectedPDVPath), 'PDV file for movie do not exist') - test_err = test_err + assert_integer_equal( & - size(outputs(1)%movieProbe%timeStep), BuffObse, 'Unexpected timestep buffer size') + !Cleanup + call remove_folder(test_folder, ios) err = test_err end function @@ -452,6 +469,8 @@ integer function test_update_movie_probe() bind(c) result(err) use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + use mod_directoryUtils + implicit none type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl @@ -483,7 +502,13 @@ integer function test_update_movie_probe() bind(c) result(err) logical :: ThereAreWires = .false. logical :: outputRequested - character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=11), parameter :: test_name = 'updateMovie' + + character(len=BUFSIZE) :: nEntrada + integer :: ios + + nEntrada = join_path(test_folder, test_name) err = 1 @@ -520,7 +545,7 @@ integer function test_update_movie_probe() bind(c) result(err) end do sinpml_fullsizePtr => sinpml_fullsize - dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & outputRequested, ThereAreWires) @@ -563,7 +588,8 @@ integer function test_update_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() + !Cleanup + call remove_folder(test_folder, ios) err = test_err end function @@ -575,6 +601,8 @@ integer function test_flush_movie_probe() bind(c) result(err) use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + use mod_directoryUtils + implicit none type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl @@ -606,8 +634,15 @@ integer function test_flush_movie_probe() bind(c) result(err) logical :: ThereAreWires = .false. logical :: outputRequested - character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=10), parameter :: test_name = 'flushMovie' + + character(len=BUFSIZE) :: nEntrada character(len=BUFSIZE) :: expectedPath + integer :: outputIdx + integer :: ios + + nEntrada = join_path(test_folder, test_name) err = 1 @@ -661,7 +696,7 @@ integer function test_flush_movie_probe() bind(c) result(err) end do sinpml_fullsizePtr => sinpml_fullsize - dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & outputRequested, ThereAreWires) @@ -708,17 +743,19 @@ integer function test_flush_movie_probe() bind(c) result(err) ! --- 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 = add_extension(remove_extension(outputs(outputIdx)%movieProbe%pvdPath),'_ts0001.vtu') + test_err = test_err + assert_true(file_exists(expectedPath), 'Primera iteracion no encontrada') - expectedPath = trim(adjustl(outputs(outputIdx)%movieProbe%path))//'_ts0002.vtu' - test_err = test_err + assert_file_exists(expectedPath) + expectedPath = add_extension(remove_extension(outputs(outputIdx)%movieProbe%pvdPath),'_ts0002.vtu') + test_err = test_err + assert_true(file_exists(expectedPath), 'Segunda iteracion no encontrada') end do call close_outputs() - expectedPath = trim(adjustl(outputs(1)%movieProbe%path))//'.pvd' - test_err = test_err + assert_file_exists(expectedPath) + expectedPath = trim(adjustl(outputs(1)%movieProbe%pvdPath)) + test_err = test_err + assert_true(file_exists(expectedPath), 'PVD file not found') + + call remove_folder(test_folder, ios) err = test_err end function @@ -730,6 +767,8 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + use mod_directoryUtils + implicit none type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl @@ -759,8 +798,17 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) logical :: ThereAreWires = .false. logical :: outputRequested - character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=13), parameter :: test_name = 'initFrequency' + + character(len=BUFSIZE) :: nEntrada + character(len=BUFSIZE) :: expectedPDVPath + character(len=BUFSIZE) :: expectedProbePath + character(len=BUFSIZE) :: pdvFileName + integer :: ios + + nEntrada = join_path(test_folder, test_name) err = 1 call sgg_init(dummysgg) @@ -799,21 +847,18 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) end do sinpml_fullsizePtr => sinpml_fullsize - dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) 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)%outputID, FREQUENCY_SLICE_PROBE_ID, 'Unexpected probe id') - 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%nFreq, 6, 'Unexpected number of frequencies') - test_err = test_err + assert_integer_equal(outputs(1)%frequencySliceProbe%nPoints, & - 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), & @@ -823,7 +868,16 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) size(outputs(1)%frequencySliceProbe%frequencySlice), & expectedTotalFrequnecies, 'Unexpected frequency count') - call close_outputs() + expectedProbePath = trim(nEntrada)//wordSeparation//'frequencySliceProbe_BC_2_2_2__5_5_5' + pdvFileName = trim(get_last_component(expectedProbePath))//pdvExtension + expectedPDVPath = join_path(expectedProbePath, pdvFileName) + + test_err = test_err + assert_string_equal(outputs(1)%frequencySliceProbe%path, expectedProbePath, 'Unexpected path') + test_err = test_err + assert_string_equal(outputs(1)%frequencySliceProbe%pvdPath, expectedPDVPath, 'Unexpected pdv path') + test_err = test_err + assert_true(folder_exists(expectedProbePath), 'Frequency Slice folder do not exist') + test_err = test_err + assert_true(file_exists(expectedPDVPath), 'PDV file for Frequency Slice do not exist') + + call remove_folder(test_folder, ios) err = test_err end function @@ -835,6 +889,8 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + use mod_directoryUtils + implicit none type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl @@ -867,8 +923,15 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) logical :: ThereAreWires = .false. logical :: outputRequested - character(len=BUFSIZE) :: test_folder_path = 'tmp_cases/' + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=13), parameter :: test_name = 'initFrequency' + + character(len=BUFSIZE) :: nEntrada + integer :: ios + + nEntrada = join_path(test_folder, test_name) + err = 1 call sgg_init(dummysgg) @@ -904,7 +967,7 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) end do sinpml_fullsizePtr => sinpml_fullsize - dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & outputRequested, ThereAreWires) @@ -946,7 +1009,8 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) 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() + + call remove_folder(test_folder, ios) err = test_err end function @@ -958,6 +1022,8 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) use FDETYPES_TOOLS use mod_sggMethods use mod_assertionTools + use mod_directoryUtils + implicit none type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl @@ -993,6 +1059,16 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) character(len=BUFSIZE) :: expectedPath character(len=3) :: freqIdName + + character(len=14), parameter :: test_folder = 'testing_folder' + character(len=13), parameter :: test_name = 'initFrequency' + + character(len=BUFSIZE) :: nEntrada + integer :: ios + integer :: freq + + nEntrada = join_path(test_folder, test_name) + err = 1 !--- Setup SGG --- @@ -1036,7 +1112,7 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) end do sinpml_fullsizePtr => sinpml_fullsize - dummyControl = create_control_flags(nEntradaRoot=test_folder_path, mpidir=mpidir) + dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & outputRequested, ThereAreWires) @@ -1060,17 +1136,19 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) - !--- Assert generated files --- + ! --- Assert file existance 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) + expectedPath = add_extension(remove_extension(outputs(1)%frequencySliceProbe%pvdPath),'_fq'//'000'//trim(adjustl(freqIdName))//'.vtu') + test_err = test_err + assert_true(file_exists(expectedPath), 'Primera iteracion no encontrada') end do call close_outputs() - expectedPath = trim(adjustl(outputs(1)%frequencySliceProbe%path))//'.pvd' - test_err = test_err + assert_file_exists(expectedPath) + expectedPath = trim(adjustl(outputs(1)%frequencySliceProbe%pvdPath)) + test_err = test_err + assert_true(file_exists(expectedPath), 'PVD file not found') + + call remove_folder(test_folder, ios) err = test_err end function diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index da24797d..c609e594 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -93,7 +93,7 @@ function create_frequency_slice_observation(xi, yi, zi, xe, ye, ze, request) res 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') + call set_observation(observation, P, 'frequencySliceProbe', domain, 'DummyFileNormalize') end function create_frequency_slice_observation subroutine create_dummy_fields(this, lower, upper, delta) From 953505aa0214a717cd74f690c793d32edc624dd6 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 30 Jan 2026 09:09:58 +0100 Subject: [PATCH 69/96] [wip] Create wire tests --- src_output/mapVTKOutput.F90 | 11 +++++++++++ src_output/output.F90 | 9 +++++---- test/output/test_output.F90 | 26 ++++++++++++++++++++++++++ 3 files changed, 42 insertions(+), 4 deletions(-) create mode 100644 src_output/mapVTKOutput.F90 diff --git a/src_output/mapVTKOutput.F90 b/src_output/mapVTKOutput.F90 new file mode 100644 index 00000000..c3ba170e --- /dev/null +++ b/src_output/mapVTKOutput.F90 @@ -0,0 +1,11 @@ +module mod_mapVTKOutput + implicit none + use FDETYPES + +contains + + subroutine create_geometry_simulation_vtk() + end subroutine + +end module mod_mapVTKOutput + diff --git a/src_output/output.F90 b/src_output/output.F90 index 9226cbcf..e242d8dc 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -154,6 +154,9 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputRequestType = sgg%observation(ii)%P(i)%what select case (outputRequestType) + !case (mapvtk) + ! call create_geometry_simulation_vtk(lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, problemInfo, control) + case (iEx, iEy, iEz, iHx, iHy, iHz) outputCount = outputCount + 1 outputs(outputCount)%outputID = POINT_PROBE_ID @@ -412,14 +415,12 @@ subroutine close_outputs() end do end subroutine - subroutine create_pvd(probePath, pvdPath) + subroutine create_pvd(pvdPath) implicit none - character(len=*), intent(in) :: probePath character(len=*), intent(out) :: pvdPath integer :: ios integer :: unit - 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" @@ -435,8 +436,8 @@ subroutine close_pvd(pvdPath) 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) + if (ios /= 0) stop "Error al abrir archivo PVD" write (unit, *) ' ' write (unit, *) '' close (unit) diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index f8296a3a..8262103a 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -1153,3 +1153,29 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) err = test_err end function +integer function test_init_wire_probe() bind(c) result(err) + use output + use outputTypes + use mod_testOutputUtils + use FDETYPES_TOOLS + use mod_sggMethods + use mod_assertionTools + use mod_directoryUtils + implicit none + + 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(limit_t), target :: sinpml_fullsize(6) + type(limit_t), pointer :: sinpml_fullsizePtr(:) + + type(Obses_t) +end function \ No newline at end of file From 902d7a53f833b84e837f953ed4765b24e048e3ae Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 2 Feb 2026 11:39:16 +0100 Subject: [PATCH 70/96] Refactor output handling and add bulk probe observation utils --- .github/workflows/ubuntu.yml | 2 +- src_output/frequencySliceProbeOutput.F90 | 3 ++- src_output/movieProbeOutput.F90 | 2 +- src_output/outputTypes.F90 | 2 ++ test/output/test_output.F90 | 31 ++---------------------- test/output/test_output_utils.F90 | 16 ++++++++++++ 6 files changed, 24 insertions(+), 32 deletions(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 3c94829b..7aaf8e5a 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -98,7 +98,7 @@ jobs: run: build/bin/fdtd_tests - name: Run python tests - if: matrix.new-output-module=='No' + if: matrix.new-output-module=='OFF' env: SEMBA_FDTD_ENABLE_MPI: ${{ matrix.mpi }} SEMBA_FDTD_ENABLE_MTLN: ${{ matrix.mtln }} diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index 34437a88..cf06b323 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -5,6 +5,7 @@ module mod_frequencySliceProbeOutput use outputTypes use mod_outputUtils use mod_volumicProbeUtils + use mod_directoryUtils implicit none private @@ -53,7 +54,7 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI this%domain = domain this%path = get_output_path_freq(this, outputTypeExtension, field, control) - pdvFileName = add_extension(get_last_component(this%path), pdvExtension) + pdvFileName = add_extension(get_last_component(this%path), pvdExtension ) this%pvdPath = join_path(this%path, pdvFileName) call create_folder(this%path, error) diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index f9f97d2f..47604426 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -49,7 +49,7 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, this%domain = domain this%path = get_output_path(this, outputTypeExtension, field, control%mpidir) - pdvFileName = add_extension(get_last_component(this%path), pdvExtension) + pdvFileName = add_extension(get_last_component(this%path), pvdExtension) this%pvdPath = join_path(this%path, pdvFileName) call create_folder(this%path, error) diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 968cbd51..58542444 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -20,6 +20,8 @@ module outputTypes integer, parameter :: FREQUENCY_DOMAIN = 1 integer, parameter :: BOTH_DOMAIN = 2 + + character(len=4), parameter :: pvdExtension = '.pvd' character(len=4), parameter :: datFileExtension = '.dat' character(len=2), parameter :: timeExtension = 'tm' character(len=2), parameter :: frequencyExtension = 'fq' diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 8262103a..2c837e08 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -448,7 +448,7 @@ 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') expectedProbePath = trim(nEntrada)//wordSeparation//'movieProbe_BC_2_2_2__5_5_5' - pdvFileName = trim(get_last_component(expectedProbePath))//pdvExtension + pdvFileName = trim(get_last_component(expectedProbePath))//pvdExtension expectedPDVPath = join_path(expectedProbePath, pdvFileName) test_err = test_err + assert_string_equal(outputs(1)%movieProbe%path, expectedProbePath, 'Unexpected path') @@ -869,7 +869,7 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) expectedTotalFrequnecies, 'Unexpected frequency count') expectedProbePath = trim(nEntrada)//wordSeparation//'frequencySliceProbe_BC_2_2_2__5_5_5' - pdvFileName = trim(get_last_component(expectedProbePath))//pdvExtension + pdvFileName = trim(get_last_component(expectedProbePath))//pvdExtension expectedPDVPath = join_path(expectedProbePath, pdvFileName) test_err = test_err + assert_string_equal(outputs(1)%frequencySliceProbe%path, expectedProbePath, 'Unexpected path') @@ -1152,30 +1152,3 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) err = test_err end function - -integer function test_init_wire_probe() bind(c) result(err) - use output - use outputTypes - use mod_testOutputUtils - use FDETYPES_TOOLS - use mod_sggMethods - use mod_assertionTools - use mod_directoryUtils - implicit none - - 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(limit_t), target :: sinpml_fullsize(6) - type(limit_t), pointer :: sinpml_fullsizePtr(:) - - type(Obses_t) -end function \ No newline at end of file diff --git a/test/output/test_output_utils.F90 b/test/output/test_output_utils.F90 index c609e594..75a9d238 100644 --- a/test/output/test_output_utils.F90 +++ b/test/output/test_output_utils.F90 @@ -52,6 +52,22 @@ function create_point_probe_observation(x, y, z) result(obs) call set_observation(obs, P, 'pointProbe', domain, 'DummyFileNormalize') end function + function create_bulk_probe_observation(xi, yi, zi) result(obs) + integer, intent(in) :: xi, yi, zi + type(Obses_t) :: obs + + type(observable_t), dimension(:), allocatable :: P + type(observation_domain_t) :: domain + + allocate (P(1)) + P(1) = create_observable(xi, yi, zi, xi+1, yi+1, zi+1, iCurX) + + 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, 'bulkProbe', domain, 'DummyFileNormalize') + end function create_bulk_probe_observation + 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 From 9ccb6fac8654bc9e87def05dd2a9304eb9d3071a Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 5 Feb 2026 13:09:03 +0100 Subject: [PATCH 71/96] Fix | Compilation fix for ubuntu system and intel compiler --- CMakeLists.txt | 10 ++++- CMakePresets.json | 14 ++++++ src_output/pointProbeOutput.F90 | 2 +- src_utils/directoryUtils.F90 | 15 ++++--- test/output/test_output.F90 | 78 +++++++++++++++++++++++++-------- 5 files changed, 92 insertions(+), 27 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index fbf30376..9ad6d7cf 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -32,7 +32,7 @@ option(SEMBA_FDTD_ENABLE_OUTPUT_MODULE "Use new output module" OFF) # Compilation defines. if (CMAKE_SYSTEM_NAME STREQUAL "Windows") -add_compile_definitions(_WIN32) +add_compile_definitions(__WIN32__) elseif (CMAKE_SYSTEM_NAME STREQUAL "Darwin") add_compile_definitions(__APPLE__) elseif (CMAKE_SYSTEM_NAME STREQUAL "Linux") @@ -58,6 +58,14 @@ add_definitions( -DCompileWithOpenMP ) +if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + add_definitions(-DGNUCompiler) +endif() +if(CMAKE_Fortran_COMPILER_ID MATCHES "IntelLLVM") + add_definitions(-DIFXCompiler) +endif() + + include("${CMAKE_CURRENT_SOURCE_DIR}/set_precompiled_libraries.cmake") if (CMAKE_SYSTEM_NAME MATCHES "Linux") diff --git a/CMakePresets.json b/CMakePresets.json index 32ba2f5b..14b700d1 100644 --- a/CMakePresets.json +++ b/CMakePresets.json @@ -24,6 +24,20 @@ "cacheVariables": { "SEMBA_FDTD_ENABLE_MTLN": "OFF" } + }, + { + "name": "intel2025.1-debug", + "displayName": "Intel 2025.1 Debug", + "description": "Configure proyect for Intel oneAPI 2025.1 y OpenMP", + "generator": "Ninja", + "binaryDir": "${sourceDir}/build-dbg", + "cacheVariables": { + "CMAKE_BUILD_TYPE": "Debug", + "CMAKE_C_COMPILER": "/opt/intel/oneapi/compiler/2025.1/bin/icx", + "CMAKE_CXX_COMPILER": "/opt/intel/oneapi/compiler/2025.1/bin/icpx", + "CMAKE_Fortran_COMPILER": "/opt/intel/oneapi/compiler/2025.1/bin/ifx", + "CMAKE_EXPORT_COMPILE_COMMANDS": "YES" + } } ] } diff --git a/src_output/pointProbeOutput.F90 b/src_output/pointProbeOutput.F90 index 0c06fd67..f4a29ba6 100644 --- a/src_output/pointProbeOutput.F90 +++ b/src_output/pointProbeOutput.F90 @@ -118,7 +118,7 @@ subroutine flush_time_domain(this) print *, "No data to write." return end if - + open (unit=unit, file=this%filePathTime, status="old", action="write", position="append") do i = 1, this%nTime diff --git a/src_utils/directoryUtils.F90 b/src_utils/directoryUtils.F90 index cf1829f7..9581c4a7 100644 --- a/src_utils/directoryUtils.F90 +++ b/src_utils/directoryUtils.F90 @@ -42,8 +42,11 @@ function folder_exists(path) result(exists) else p = trim(p)//"/" end if - +#ifdef GNUCompiler inquire (file=p, exist=exists) +#else + inquire (directory=p, exist=exists) +#endif end function folder_exists !------------------------------------------------------------ @@ -129,7 +132,7 @@ subroutine create_folder(path, ios) return end if -#ifdef _WIN32 +#ifdef __WIN32__ call execute_command_line("mkdir """//trim(path)//"""", exitstat=ios) #else call execute_command_line("mkdir -p "//trim(path), exitstat=ios) @@ -148,7 +151,7 @@ subroutine remove_folder(path, ios) return end if -#ifdef _WIN32 +#ifdef __WIN32__ call execute_command_line("rmdir /S /Q """//trim(path)//"""", exitstat=ios) #else call execute_command_line("rm -rf "//trim(path), exitstat=ios) @@ -178,7 +181,7 @@ subroutine delete_file(path, ios) return end if -#ifdef _WIN32 +#ifdef __WIN32__ call execute_command_line("del /Q """//trim(path)//"""", exitstat=ios) #else call execute_command_line("rm -f "//trim(path), exitstat=ios) @@ -208,7 +211,7 @@ subroutine list_files(path, files, nfiles, ios) return end if -#ifdef _WIN32 +#ifdef __WIN32__ cmd = 'dir /B "'//trim(path)//'"' #else cmd = 'ls -1 "'//trim(path)//'"' @@ -264,7 +267,7 @@ end subroutine create_file_with_path function get_path_separator() result(sep) character(len=1) :: sep -#ifdef _WIN32 +#ifdef __WIN32__ sep = '\' #else sep = '/' diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 2c837e08..4c8ea357 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -360,6 +360,9 @@ integer function test_init_movie_probe() bind(c) result(err) type(SGGFDTDINFO) :: dummysgg type(sim_control_t) :: dummyControl type(bounds_t) :: dummyBound + type(XYZlimit_t) :: dummySweep(6) + type(XYZlimit_t) :: dummySinpmlSweep(6) + type(XYZlimit_t) :: allocationRange(6) type(solver_output_t), pointer :: outputs(:) type(media_matrices_t), target :: media @@ -412,11 +415,13 @@ integer function test_init_movie_probe() bind(c) result(err) 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)) + dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Sweep(dummysgg, dummySweep) + dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) + call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) call sgg_set_NumPlaneWaves(dummysgg, 1) - call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Alloc(dummysgg, allocationRange) movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, movieObservable) @@ -486,6 +491,10 @@ integer function test_update_movie_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) + type(XYZlimit_t) :: dummySweep(6) + type(XYZlimit_t) :: dummySinpmlSweep(6) + type(XYZlimit_t) :: allocationRange(6) + type(Obses_t) :: movieObservable real(kind=RKIND_tiempo), pointer :: timeArray(:) @@ -522,10 +531,13 @@ integer function test_update_movie_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)) + dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Sweep(dummysgg, dummySweep) + dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) + call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) call sgg_set_NumPlaneWaves(dummysgg, 1) - call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Alloc(dummysgg, allocationRange) movieObservable = create_movie_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, movieObservable) @@ -618,6 +630,10 @@ integer function test_flush_movie_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) + type(XYZlimit_t) :: dummySweep(6) + type(XYZlimit_t) :: dummySinpmlSweep(6) + type(XYZlimit_t) :: allocationRange(6) + type(Obses_t) :: movieCurrentObservable type(Obses_t) :: movieElectricXObservable type(Obses_t) :: movieMagneticYObservable @@ -656,10 +672,13 @@ integer function test_flush_movie_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)) + dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Sweep(dummysgg, dummySweep) + dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) + call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) call sgg_set_NumPlaneWaves(dummysgg, 1) - call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Alloc(dummysgg, allocationRange) movieCurrentObservable = create_movie_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, movieCurrentObservable) @@ -784,6 +803,10 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) + type(XYZlimit_t) :: dummySweep(6) + type(XYZlimit_t) :: dummySinpmlSweep(6) + type(XYZlimit_t) :: allocationRange(6) + type(Obses_t) :: frequencySliceObservation real(kind=RKIND_tiempo), pointer :: timeArray(:) @@ -822,10 +845,13 @@ integer function test_init_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)) + dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Sweep(dummysgg, dummySweep) + dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) + call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) call sgg_set_NumPlaneWaves(dummysgg, 1) - call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Alloc(dummysgg, allocationRange) frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, frequencySliceObservation) @@ -906,6 +932,10 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) + type(XYZlimit_t) :: dummySweep(6) + type(XYZlimit_t) :: dummySinpmlSweep(6) + type(XYZlimit_t) :: allocationRange(6) + type(Obses_t) :: frequencySliceObservation real(kind=RKIND_tiempo), pointer :: timeArray(:) @@ -944,10 +974,13 @@ integer function test_update_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)) + dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Sweep(dummysgg, dummySweep) + dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) + call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) call sgg_set_NumPlaneWaves(dummysgg, 1) - call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Alloc(dummysgg, allocationRange) frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, frequencySliceObservation) @@ -1039,6 +1072,10 @@ 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(XYZlimit_t) :: dummySweep(6) + type(XYZlimit_t) :: dummySinpmlSweep(6) + type(XYZlimit_t) :: allocationRange(6) + type(Obses_t) :: frequencySliceCurrentObservable type(Obses_t) :: frequencySliceElectricXObservable type(Obses_t) :: frequencySliceMagneticHObservable @@ -1082,10 +1119,13 @@ 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)) + dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Sweep(dummysgg, dummySweep) + dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) + call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) call sgg_set_NumPlaneWaves(dummysgg, 1) - call sgg_set_Alloc(dummysgg, create_xyz_limit_array(0, 0, 0, 6, 6, 6)) + allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Alloc(dummysgg, allocationRange) frequencySliceCurrentObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) call sgg_add_observation(dummysgg, frequencySliceCurrentObservable) From b741415a0523b73757bc6b3f84af1df972d303ab Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 16 Feb 2026 16:03:52 +0100 Subject: [PATCH 72/96] Extract perform flush field and syncroniceflushflags from solver_run main loop --- src_main_pub/timestepping.F90 | 64 +++++++++++++++++++---------------- 1 file changed, 35 insertions(+), 29 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index fe007161..c2bc9581 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -1857,38 +1857,11 @@ subroutine solver_run(this) endif end do #ifdef CompileWithMPI - l_aux=this%perform%flushVTK - call MPI_AllReduce( l_aux, this%perform%flushVTK, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - ! - l_aux=this%perform%flushXdmf - call MPI_AllReduce( l_aux, this%perform%flushXdmf, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - ! - l_aux=this%perform%flushDATA - call MPI_AllReduce( l_aux, this%perform%flushDATA, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - ! - l_aux=this%perform%flushFIELDS - call MPI_AllReduce( l_aux, this%perform%flushFIELDS, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - ! - l_aux=this%perform%postprocess - call MPI_AllReduce( l_aux, this%perform%postprocess, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + call syncroniceFlushFlags(this%perform, ierr) #endif !!!!!!!!!!!! if (this%perform%flushFIELDS) then - write(dubuf,*) SEPARADOR,trim(adjustl(this%control%nentradaroot)),separador - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) 'INIT FLUSHING OF RESTARTING FIELDS n=',this%n - call print11(this%control%layoutnumber,dubuf) - call flush_and_save_resume(this%sgg, this%bounds, this%control%layoutnumber, this%control%size, this%control%nentradaroot, this%control%nresumeable2, this%thereare, this%n,this%eps0,this%mu0, this%everflushed, & - Ex, Ey, Ez, Hx, Hy, Hz,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic) -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) 'DONE FLUSHING OF RESTARTING FIELDS n=',this%n - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) + call performFlushField() endif if (this%perform%isFlush()) then ! @@ -2051,6 +2024,39 @@ subroutine solver_run(this) end do ciclo_temporal ! End of the time-stepping loop contains + subroutine syncroniceFlushFlags(performFlags, integerError) + type(perform_t), intent(inout) :: performFlags + integer, intent(inout) :: integerError + logical :: logicalAux + logicalAux=performFlags%flushVTK + call MPI_AllReduce( logicalAux, performFlags%flushVTK, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, integerError) + logicalAux=performFlags%flushXdmf + call MPI_AllReduce( logicalAux, performFlags%flushXdmf, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, integerError) + logicalAux=performFlags%flushDATA + call MPI_AllReduce( logicalAux, performFlags%flushDATA, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, integerError) + logicalAux=performFlags%flushFIELDS + call MPI_AllReduce( logicalAux, performFlags%flushFIELDS, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, integerError) + logicalAux=performFlags%postprocess + call MPI_AllReduce( logicalAux, performFlags%postprocess, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, integerError) + end subroutine syncroniceFlushFlags + + subroutine performFlushField() + write(dubuf,*) SEPARADOR,trim(adjustl(this%control%nentradaroot)),SEPARADOR + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) 'INIT FLUSHING OF RESTARTING FIELDS n=',this%n + call print11(this%control%layoutnumber,dubuf) + call flush_and_save_resume(this%sgg, this%bounds, this%control%layoutnumber, this%control%size, this%control%nentradaroot, this%control%nresumeable2, this%thereare, this%n,this%eps0,this%mu0, this%everflushed, & + Ex, Ey, Ez, Hx, Hy, Hz,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + write(dubuf,*) SEPARADOR//SEPARADOR//SEPARADOR + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) 'DONE FLUSHING OF RESTARTING FIELDS n=',this%n + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//SEPARADOR//SEPARADOR + call print11(this%control%layoutnumber,dubuf) + end subroutine performFlushField subroutine updateAndFlush() integer(kind=4) :: mindum IF (this%thereAre%Observation) then From 61ef861a9f98f5226b947da75664176ec23320d1 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 16 Feb 2026 16:38:52 +0100 Subject: [PATCH 73/96] Create logUtils and reduce log logic from timestep --- CMakeLists.txt | 1 + src_main_pub/timestepping.F90 | 75 +++++++++-------------------- src_utils/CMakeLists.txt | 1 + src_utils/logUtils.F90 | 90 +++++++++++++++++++++++++++++++++++ 4 files changed, 115 insertions(+), 52 deletions(-) create mode 100644 src_utils/logUtils.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index beb0db9a..cce65ca8 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -293,6 +293,7 @@ if(SEMBA_FDTD_MAIN_LIB) ) target_link_libraries(semba-main semba-outputs + fdtd-utils ${OUTPUT_LIBRARIES} ${SMBJSON_LIBRARIES} ${MTLN_LIBRARIES}) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index c2bc9581..7c96adeb 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -15,7 +15,7 @@ !________________________________________________________________________________________ module Solver_mod - + use mod_logUtils use fdetypes use report use PostProcessing @@ -1871,9 +1871,7 @@ subroutine solver_run(this) else write(dubuf,'(a,i9)') ' INIT OBSERVATION DATA FLUSHING n= ',this%n endif - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call printMessageWithSeparator(this%control%layoutnumber,dubuf) #ifdef CompileWithNewOutputModule if (this%thereAre%Observation) call flush_outputs(this%sgg%tiempo, this%n, this%control, fieldReference, this%bounds, flushFF) #else @@ -1887,15 +1885,11 @@ subroutine solver_run(this) else write(dubuf,'(a,i9)') ' Done OBSERVATION DATA FLUSHED n= ',this%n endif - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call printMessageWithSeparator(this%control%layoutnumber,dubuf) ! if (this%perform%postprocess) then write(dubuf,'(a,i9)') 'Postprocessing frequency domain probes, if any, at n= ',this%n - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) + call printMessageWithEndingSeparator(this%control%layoutnumber,dubuf) somethingdone=.false. at=this%n*this%sgg%dt if (this%thereAre%Observation) call PostProcessOnthefly(this%control%layoutnumber,this%control%size,this%sgg,this%control%nentradaroot,at,somethingdone,this%control%niapapostprocess,this%control%forceresampled) @@ -1906,22 +1900,16 @@ subroutine solver_run(this) #endif if (somethingdone) then write(dubuf,*) 'End Postprocessing frequency domain probes.' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) + call printMessageWithEndingSeparator(this%control%layoutnumber,dubuf) else write(dubuf,*) 'No frequency domain probes snapshots found to be postrocessed' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) + call printMessageWithEndingSeparator(this%control%layoutnumber,dubuf) endif endif !! if (this%perform%flushvtk) then write(dubuf,'(a,i9)') ' Post-processing .vtk files n= ',this%n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call printMessageWithSeparator(this%control%layoutnumber,dubuf) somethingdone=.false. if (this%thereAre%Observation) call createvtkOnTheFly(this%control%layoutnumber,this%control%size,this%sgg,this%control%vtkindex,somethingdone,this%control%mpidir,this%media%sggMtag,this%control%dontwritevtk) #ifdef CompileWithMPI @@ -1931,21 +1919,15 @@ subroutine solver_run(this) #endif if (somethingdone) then write(dubuf,*) 'End flushing .vtk snapshots' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) + call printMessageWithEndingSeparator(this%control%layoutnumber,dubuf) else write(dubuf,*) 'No .vtk snapshots found to be flushed' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) + call printMessageWithEndingSeparator(this%control%layoutnumber,dubuf) endif endif if (this%perform%flushXdmf) then write(dubuf,'(a,i9)') ' Post-processing .xdmf files n= ',this%n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call printMessageWithSeparator(this%control%layoutnumber,dubuf) somethingdone=.false. if (this%thereAre%Observation) call createxdmfOnTheFly(this%sgg,this%control%layoutnumber,this%control%size,this%control%vtkindex,this%control%createh5bin,somethingdone,this%control%mpidir) @@ -1958,14 +1940,10 @@ subroutine solver_run(this) #endif if (somethingdone) then write(dubuf,*) 'End flushing .xdmf snapshots' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) + call printMessageWithEndingSeparator(this%control%layoutnumber,dubuf) else write(dubuf,*) 'No .xdmf snapshots found to be flushed' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) + call printMessageWithEndingSeparator(this%control%layoutnumber,dubuf) endif endif @@ -1974,14 +1952,10 @@ subroutine solver_run(this) #endif endif !del if (this%performflushDATA.or.... ! - - if (this%control%singlefilewrite.and.this%perform%Unpack) call singleUnpack() if ((this%control%singlefilewrite.and.this%perform%Unpack).or.this%perform%isFlush()) then write(dubuf,'(a,i9)') ' Continuing simulation at n= ',this%n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call printMessageWithSeparator(this%control%layoutnumber,dubuf) endif endif !!!del if (.not.this%parar) @@ -2024,6 +1998,7 @@ subroutine solver_run(this) end do ciclo_temporal ! End of the time-stepping loop contains +#ifdef CompileWithMPI subroutine syncroniceFlushFlags(performFlags, integerError) type(perform_t), intent(inout) :: performFlags integer, intent(inout) :: integerError @@ -2039,23 +2014,22 @@ subroutine syncroniceFlushFlags(performFlags, integerError) logicalAux=performFlags%postprocess call MPI_AllReduce( logicalAux, performFlags%postprocess, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, integerError) end subroutine syncroniceFlushFlags +#endif subroutine performFlushField() write(dubuf,*) SEPARADOR,trim(adjustl(this%control%nentradaroot)),SEPARADOR - call print11(this%control%layoutnumber,dubuf) + call printMessage(this%control%layoutnumber,dubuf) write(dubuf,*) 'INIT FLUSHING OF RESTARTING FIELDS n=',this%n - call print11(this%control%layoutnumber,dubuf) + call printMessage(this%control%layoutnumber,dubuf) + call flush_and_save_resume(this%sgg, this%bounds, this%control%layoutnumber, this%control%size, this%control%nentradaroot, this%control%nresumeable2, this%thereare, this%n,this%eps0,this%mu0, this%everflushed, & Ex, Ey, Ez, Hx, Hy, Hz,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic) #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - write(dubuf,*) SEPARADOR//SEPARADOR//SEPARADOR - call print11(this%control%layoutnumber,dubuf) write(dubuf,*) 'DONE FLUSHING OF RESTARTING FIELDS n=',this%n - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//SEPARADOR//SEPARADOR - call print11(this%control%layoutnumber,dubuf) + call printMessageWithSeparator(this%control%layoutnumber, dubuf) + end subroutine performFlushField subroutine updateAndFlush() integer(kind=4) :: mindum @@ -2085,10 +2059,9 @@ subroutine singleUnpack() #ifdef CompileWithMPI integer(kind=4) :: ierr #endif - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) write(dubuf,'(a,i9)') ' Unpacking .bin files and prostprocessing them at n= ',this%n - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call printMessageWithSeparator(this%control%layoutnumber, dubuf) + if (this%thereAre%Observation) call unpacksinglefiles(this%sgg,this%control%layoutnumber,this%control%size,this%control%singlefilewrite,this%initialtimestep,this%control%resume) !dump the remaining to disk somethingdone=.false. if (this%control%singlefilewrite.and.this%perform%Unpack) then @@ -2101,9 +2074,7 @@ subroutine singleUnpack() somethingdone=newsomethingdone #endif write(dubuf,'(a,i9)') ' Done Unpacking .bin files and prostprocessing them at n= ',this%n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call printMessageWithSeparator(this%control%layoutnumber, dubuf) end subroutine singleUnpack diff --git a/src_utils/CMakeLists.txt b/src_utils/CMakeLists.txt index 13268e21..06f169cc 100644 --- a/src_utils/CMakeLists.txt +++ b/src_utils/CMakeLists.txt @@ -3,6 +3,7 @@ add_library(fdtd-utils "valueReplacer.F90" "allocationUtils.F90" "directoryUtils.F90" + "logUtils.F90" ) target_link_libraries(fdtd-utils semba-types diff --git a/src_utils/logUtils.F90 b/src_utils/logUtils.F90 new file mode 100644 index 00000000..b1e2259e --- /dev/null +++ b/src_utils/logUtils.F90 @@ -0,0 +1,90 @@ +module mod_logUtils + implicit none + +contains + subroutine printMessage(layoutNumber, message) + implicit none + integer, intent(in) :: layoutnumber + character(len=*), intent(in) :: message + logical :: printea + printea = .true. + + ! Print into console + if (printea) then + write (*, '(a)') adjustl(message) + end if + + ! Print into unitFile 11 + if (layoutnumber == 0) then + write (11, '(a)') adjustl(message) + end if + end subroutine printMessage + + subroutine printMessageWithSeparator(layoutnumber, message) + implicit none + integer, intent(in) :: layoutnumber + character(len=*), intent(in) :: message + logical :: printea + character(len=50) :: SEPARADOR + SEPARADOR = repeat('_', 50) + printea = .true. + + ! Print into console + if (printea) then + write (*, '(a)') SEPARADOR + write (*, '(a)') adjustl(message) + write (*, '(a)') SEPARADOR + end if + + ! Print into unitFile 11 + if (layoutnumber == 0) then + write (11, '(a)') SEPARADOR + write (11, '(a)') adjustl(message) + write (11, '(a)') SEPARADOR + end if + + end subroutine printMessageWithSeparator + + subroutine printMessageWithEndingSeparator(layoutNumber, message) + implicit none + integer, intent(in) :: layoutnumber + character(len=*), intent(in) :: message + logical :: printea + character(len=50) :: SEPARADOR + SEPARADOR = repeat('_', 50) + printea = .true. + + ! Print into console + if (printea) then + write (*, '(a)') SEPARADOR + write (*, '(a)') adjustl(message) + write (*, '(a)') SEPARADOR + end if + + ! Print into unitFile 11 + if (layoutnumber == 0) then + write (11, '(a)') SEPARADOR + write (11, '(a)') adjustl(message) + write (11, '(a)') SEPARADOR + end if + end subroutine printMessageWithEndingSeparator + + subroutine printSeparator(layoutnumber) + implicit none + integer, intent(in) :: layoutnumber + logical :: printea + character(len=50) :: SEPARADOR + SEPARADOR = repeat('_', 50) + printea = .true. + + ! Print into console + if (printea) then + write (*, '(a)') SEPARADOR + end if + + ! Print into unitFile 11 + if (layoutnumber == 0) then + write (11, '(a)') SEPARADOR + end if + end subroutine printSeparator +end module mod_logUtils From d1c88431473702fa771e7aa8bdca98815858513d Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 17 Feb 2026 12:34:39 +0100 Subject: [PATCH 74/96] added init mtln solver to new output --- src_output/output.F90 | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src_output/output.F90 b/src_output/output.F90 index e242d8dc..5958d902 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -9,6 +9,8 @@ module output use mod_movieProbeOutput use mod_frequencySliceProbeOutput use mod_farFieldOutput + use mtln_solver_mod + use Wire_bundles_mtln_mod implicit none private @@ -113,6 +115,9 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio integer(kind=SINGLE) :: requestedOutputs character(len=BUFSIZE) :: outputTypeExtension +#ifdef CompileWithMTLN + logical :: thereAreMtlnObservations = .false. +#endif observationsExists = .false. requestedOutputs = get_required_output_count(sgg) @@ -137,6 +142,21 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio !end do !end do +#ifdef CompileWithMTLN + block + type(mtln_t), pointer :: mtln_solver + integer :: i, j + mtln_solver => GetSolverPtr() + do i = 1, ubound(mtln_solver%bundles, 1) + if (ubound(mtln_solver%bundles(i)%probes, 1) /= 0) then + do j = 1, ubound(mtln_solver%bundles(i)%probes, 1) + if (mtln_solver%bundles(i)%probes(j)%in_layer) thereAreMtlnObservations = .true. + end do + end if + end do + end block +#endif + do ii = 1, sgg%NumberRequest domain = preprocess_domain(sgg%Observation(ii), sgg%tiempo, sgg%dt, control%finaltimestep) if (domain%domainType == UNDEFINED_DOMAIN) cycle @@ -225,6 +245,9 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputCount = size(outputs) end if if (outputCount /= 0) observationsExists = .true. +#ifdef CompileWithMTLN + observationsExists = observationsExists .or. thereAreMtlnObservations +#endif return contains subroutine adjust_bound_range() From 2159a67f4deff33e2146492dc088c63de673676f Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 17 Feb 2026 13:31:25 +0100 Subject: [PATCH 75/96] Added headers to tests --- test/output/test_output.F90 | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 4c8ea357..a978f7d0 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -1,4 +1,8 @@ integer function test_init_point_probe() bind(c) result(err) +! This test initializes a single point probe at coordinates (4,4,4). +! It verifies that the probe is correctly registered in the simulation outputs, +! that the output ID matches POINT_PROBE_ID, and that the output paths for +! both the probe and its time data file are correctly set and exist. use FDETYPES use FDETYPES_TOOLS use output @@ -79,6 +83,10 @@ integer function test_init_point_probe() bind(c) result(err) end function integer function test_update_point_probe() bind(c) result(err) +! This test updates the values recorded by a single point probe at (4,4,4) +! over two timesteps. It verifies that the probe correctly stores the time +! steps and associated field values, ensuring proper temporal tracking of +! measured quantities. use FDETYPES use FDETYPES_TOOLS use output @@ -176,6 +184,9 @@ integer function test_update_point_probe() bind(c) result(err) end function integer function test_flush_point_probe() bind(c) result(err) +! This test validates the flush operation for a point probe. It ensures +! that time and frequency data are properly written to files, and that +! internal arrays are cleared/reset after flushing, preserving data integrity. use output use outputTypes use mod_pointProbeOutput @@ -252,6 +263,9 @@ integer function test_flush_point_probe() bind(c) result(err) end function integer function test_multiple_flush_point_probe() bind(c) result(err) +! This test verifies that multiple consecutive flushes of a point probe +! correctly append or overwrite data files without losing previous data. +! It ensures consistency of both time and frequency outputs across multiple flushes. use output use outputTypes use mod_pointProbeOutput @@ -348,6 +362,10 @@ integer function test_multiple_flush_point_probe() bind(c) result(err) end function integer function test_init_movie_probe() bind(c) result(err) +! This test initializes a movie probe over a 3D region from (2,2,2) to (5,5,5). +! It checks that the probe is correctly allocated, that the number of measurement +! points and buffer sizes are correct, and that the output folder and PVD file +! for the movie are properly created. use output use outputTypes use mod_testOutputUtils @@ -468,6 +486,9 @@ integer function test_init_movie_probe() bind(c) result(err) end function integer function test_update_movie_probe() bind(c) result(err) +! This test updates a movie probe with field values at a single timestep. +! It verifies that the probe correctly stores the measured values in the x, y, +! and z components for all points, and that the timestep buffer is properly populated. use output use outputTypes use mod_testOutputUtils @@ -607,6 +628,9 @@ integer function test_update_movie_probe() bind(c) result(err) end function integer function test_flush_movie_probe() bind(c) result(err) +! This test validates flushing movie probes to disk. It ensures that +! VTU files for each timestep and the PVD file are created, confirming that +! the temporal sequence of the movie probe is correctly serialized and saved. use output use outputTypes use mod_testOutputUtils @@ -780,6 +804,9 @@ integer function test_flush_movie_probe() bind(c) result(err) end function integer function test_init_frequency_slice_probe() bind(c) result(err) +! This test initializes a frequency slice probe over a 3D region (2,2,2) to (5,5,5). +! It verifies that the probe is correctly set up, that the expected number of measurement +! points and frequencies are allocated, and that the output folder and PVD file exist. use output use outputTypes use mod_testOutputUtils @@ -909,6 +936,10 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) end function integer function test_update_frequency_slice_probe() bind(c) result(err) +! This test updates a frequency slice probe with field gradients. +! It checks that no current is detected along the X-axis for H-field gradients +! and verifies the correct relation between Y and Z values (Y = -Z), ensuring +! correct handling of field distributions across the frequency slice. use output use outputTypes use mod_testOutputUtils @@ -1049,6 +1080,10 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) end function integer function test_flush_frequency_slice_probe() bind(c) result(err) +! This test validates flushing a frequency slice probe to disk. +! It ensures that all data corresponding to measured points and frequencies +! are correctly written to output files and that the PVD file for visualization +! is properly created. use output use outputTypes use mod_testOutputUtils From 33857862f7f340a2107bf5f169ba62c4ef747005 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 17 Feb 2026 13:57:58 +0100 Subject: [PATCH 76/96] Add register output files to new output workflow --- src_output/output.F90 | 46 ++++++++++++++++++++++++++++++++++++ src_utils/directoryUtils.F90 | 4 +--- 2 files changed, 47 insertions(+), 3 deletions(-) diff --git a/src_output/output.F90 b/src_output/output.F90 index 5958d902..82efb2a7 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -248,6 +248,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio #ifdef CompileWithMTLN observationsExists = observationsExists .or. thereAreMtlnObservations #endif + if (observationsExists) call registerOutputFiles(control, outputCount) return contains subroutine adjust_bound_range() @@ -476,4 +477,49 @@ function get_required_output_count(sgg) result(count) return end function + subroutine registerOutputFiles(control, outputCount) + type(sim_control_t), intent(in) :: control + integer, intent(in) :: outputCount + + character(LEN=BUFSIZE) :: whoami, whoamishort, outputRequestFile + integer :: iostat, i, unit + + write (whoamishort, '(i5)') control%layoutnumber + 1 + write (whoami, '(a,i5,a,i5,a)') '(', control%layoutnumber + 1, '/', control%size, ') ' + write (outputRequestFile, *) trim(adjustl(control%nEntradaRoot))//'_Outputrequests_'//trim(adjustl(whoamishort))//'.txt' + + call create_file_with_path(outputRequestFile, iostat) + if (iostat /= 0) call StopOnError(control%layoutnumber, control%size, 'Error while creating new outputrequestRegister file...') + + open (newunit=unit, file=trim(outputRequestFile), status='old', action='write', position='append', iostat=iostat) + do i=1, outputCount + select case (outputs(i)%outputID) + case (POINT_PROBE_ID) + if (any(outputs(i)%pointProbe%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then + write(unit, *) trim(outputs(i)%pointProbe%filePathTime) + end if + if (any(outputs(i)%pointProbe%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + write(unit, *) trim(outputs(i)%pointProbe%filePathFreq) + end if + case (WIRE_CURRENT_PROBE_ID) + write(unit, *) trim(outputs(i)%wireCurrentProbe%filePathTime) + case (WIRE_CHARGE_PROBE_ID) + write(unit, *) trim(outputs(i)%wireChargeProbe%filePathTime) + case (BULK_PROBE_ID) + write(unit, *) trim(outputs(i)%bulkCurrentProbe%filePathTime) + case (MOVIE_PROBE_ID) + write(unit, *) trim(outputs(i)%movieProbe%filePathTime) + case (FREQUENCY_SLICE_PROBE_ID) + write(unit, *) trim(outputs(i)%frequencySliceProbe%filePathFreq) + case (FAR_FIELD_PROBE_ID) + write(unit, *) trim(outputs(i)%farFieldOutput%filePathFreq) + case default + call stoponerror(0, 0, 'Output update not implemented') + end select + end do + + write(unit, *) 'END!' + close(unit) + end subroutine + end module output diff --git a/src_utils/directoryUtils.F90 b/src_utils/directoryUtils.F90 index 9581c4a7..3c3324db 100644 --- a/src_utils/directoryUtils.F90 +++ b/src_utils/directoryUtils.F90 @@ -249,7 +249,6 @@ subroutine create_file_with_path(fullpath, ios) integer :: pos ios = 0 - ! Find last slash or backslash pos = index(fullpath, get_path_separator()) @@ -258,8 +257,7 @@ subroutine create_file_with_path(fullpath, ios) call create_folder(trim(folder), ios) if (ios /= 0) return end if - - open (newunit=unit, file=trim(fullpath), status='replace', action='write', iostat=ios) + open (newunit=unit, file=trim(adjustl(fullpath)), status='replace', iostat=ios) if (ios == 0) close (unit) end subroutine create_file_with_path From fb299b1b62380d4965a63070bb9afe65351c8037 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 17 Feb 2026 14:11:54 +0100 Subject: [PATCH 77/96] wip --- setup_intel_build.sh | 53 +++++++++++++++++++++++++++ src_pyWrapper/pyWrapper.py | 9 ++++- test/pyWrapper/test_script.py | 69 +++++++++++++++++++++++++++++++++++ test/pyWrapper/utils.py | 2 + 4 files changed, 131 insertions(+), 2 deletions(-) create mode 100755 setup_intel_build.sh create mode 100644 test/pyWrapper/test_script.py diff --git a/setup_intel_build.sh b/setup_intel_build.sh new file mode 100755 index 00000000..3895230e --- /dev/null +++ b/setup_intel_build.sh @@ -0,0 +1,53 @@ +#!/bin/bash +# ======================================================== +# Script para limpiar CMake y configurar Intel 2025.3 +# ======================================================== + +# -------------------------- +# ConfiguraciĆ³n del proyecto +# -------------------------- +SRC_DIR="/home/username/elemwave/fdtd" +BUILD_DIR="$SRC_DIR/build-dbg" + +# -------------------------- +# Carga Intel oneAPI 2025.3 +# -------------------------- +echo "Cargando Intel oneAPI 2025.1..." +source /opt/intel/oneapi/setvars.sh intel64 --force --compiler-version=2025.1 + +# -------------------------- +# Definir compiladores Intel +# -------------------------- +export CC=/opt/intel/oneapi/compiler/2025.1/bin/icx +export CXX=/opt/intel/oneapi/compiler/2025.1/bin/icpx +export FC=/opt/intel/oneapi/compiler/2025.1/bin/ifx + +echo "Compiladores configurados:" +echo " CC = $CC" +echo " CXX = $CXX" +echo " FC = $FC" + +# -------------------------- +# Limpiar build anterior +# -------------------------- +if [ -d "$BUILD_DIR" ]; then + echo "Eliminando cache de CMake y archivos previos..." + rm -rf "$BUILD_DIR/CMakeCache.txt" "$BUILD_DIR/CMakeFiles" +else + mkdir -p "$BUILD_DIR" +fi + +# -------------------------- +# Ejecutar CMake con Ninja +# -------------------------- +echo "Ejecutando CMake con Intel..." +cmake -G Ninja \ + -DCMAKE_BUILD_TYPE=Debug \ + -DCMAKE_C_COMPILER=$CC \ + -DCMAKE_CXX_COMPILER=$CXX \ + -DCMAKE_Fortran_COMPILER=$FC \ + -S "$SRC_DIR" \ + -B "$BUILD_DIR" + +echo "Ā”ConfiguraciĆ³n completa! Ahora puedes compilar con:" +echo " ninja -C $BUILD_DIR" diff --git a/src_pyWrapper/pyWrapper.py b/src_pyWrapper/pyWrapper.py index 6eeaacdf..838c8b3b 100644 --- a/src_pyWrapper/pyWrapper.py +++ b/src_pyWrapper/pyWrapper.py @@ -4,6 +4,7 @@ import shutil import glob import re +import warnings import pandas as pd import numpy as np @@ -305,8 +306,12 @@ def getUsedFiles(self): return res def _setNewFolder(self, newFolder): - assert os.path.isdir(newFolder) - + if not os.path.isdir(newFolder): + warnings.warn( + f"Folder does not exist, creating it: {newFolder}", + UserWarning + ) + os.makedirs(newFolder, exist_ok=True) oldCaseFolder = self.getFolder() usedFiles = self.getUsedFiles() for usedFile in usedFiles: diff --git a/test/pyWrapper/test_script.py b/test/pyWrapper/test_script.py new file mode 100644 index 00000000..c1c7d6a1 --- /dev/null +++ b/test/pyWrapper/test_script.py @@ -0,0 +1,69 @@ +from utils import * +from typing import Dict +import os +from sys import platform +from scipy import signal +import sys +from io import StringIO +import time + +LOG_FILE = os.path.join(os.path.dirname(__file__), 'test_log.txt') + +def printList(listObject:list, listName:str): + print(f'List from {listName}') + for element in listObject: + print(str(element)) + print(f'End of list {listName}') + +def test_compareOutput(tmp_path): + # Delete log file if it exists + if os.path.exists(LOG_FILE): + os.remove(LOG_FILE) + + # Redirect stdout to both console and log file + class Tee: + def __init__(self, *files): + self.files = files + def write(self, obj): + for f in self.files: + f.write(obj) + f.flush() + def flush(self): + for f in self.files: + f.flush() + + with open(LOG_FILE, 'w') as log: + sys.stdout = Tee(sys.stdout, log) + print(os.path.join(tmp_path, 'rls')) + fn = CASES_FOLDER + 'coated_antenna/coated_antenna.fdtd.json' + rlsFolder = os.path.join(tmp_path, 'rls') + solverrls = FDTD( + input_filename=fn, + path_to_exe=DEBUG_SEMBA_EXE, + run_in_folder=rlsFolder + ) + startTime = time.time() + solverrls.run() + endTime = time.time() + print(f'Release version time spent {endTime-startTime}') + + fn = CASES_FOLDER + 'coated_antenna/coated_antenna.fdtd.json' + dbgFolder = os.path.join(tmp_path, 'dbg') + solverdbg = FDTD( + input_filename=fn, + path_to_exe=SEMBA_EXE, + run_in_folder=dbgFolder + ) + startTime = time.time() + solverdbg.run() + endTime = time.time() + print(f'Debug version time spent {endTime-startTime}') + + rlsFiles = os.listdir(rlsFolder) + printList(rlsFiles, 'Release') + dbgFiles = os.listdir(dbgFolder) + printList(dbgFiles, 'Debug') + assert len(rlsFiles) == len(dbgFiles), 'Missing files' + + + sys.stdout = sys.__stdout__ # Restore stdout \ No newline at end of file diff --git a/test/pyWrapper/utils.py b/test/pyWrapper/utils.py index 7f1d1857..02d34a8c 100644 --- a/test/pyWrapper/utils.py +++ b/test/pyWrapper/utils.py @@ -35,6 +35,8 @@ # Use of absolute path to avoid conflicts when changing directory. if platform == "linux": SEMBA_EXE = os.path.join(os.getcwd(), 'build', 'bin', 'semba-fdtd') + RELEASE_SEMBA_EXE = os.path.join(os.getcwd(), 'build-rls', 'bin', 'semba-fdtd') + DEBUG_SEMBA_EXE = os.path.join(os.getcwd(), 'build-dbg', 'bin', 'semba-fdtd') elif platform == "win32": SEMBA_EXE = os.path.join(os.getcwd(), 'build', 'bin', 'semba-fdtd.exe') From 0024c66810e5f3be282f990a14eb557a41f5e401 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 18 Feb 2026 09:39:55 +0100 Subject: [PATCH 78/96] Fix out of bounds error when checking observation request for old observation. Revised logicfor output request. --- src_main_pub/observation.F90 | 16 ++++---- src_output/output.F90 | 78 +++++++++++++++++++----------------- 2 files changed, 50 insertions(+), 44 deletions(-) diff --git a/src_main_pub/observation.F90 b/src_main_pub/observation.F90 index 5a0384f0..451031a2 100755 --- a/src_main_pub/observation.F90 +++ b/src_main_pub/observation.F90 @@ -743,13 +743,15 @@ subroutine InitObservation(sgg, media, tag_numbers, & type(mtln_solver_t), pointer :: mtln_solver integer :: i, j mtln_solver => GetSolverPtr() - do i = 1, ubound(mtln_solver%bundles, 1) - if (ubound(mtln_solver%bundles(i)%probes, 1) /= 0) then - do j = 1, ubound(mtln_solver%bundles(i)%probes, 1) - if (mtln_solver%bundles(i)%probes(j)%in_layer) ThereAreObservation = .true. - end do - end if - end do + if (mtln_solver%number_of_bundles > 0) then + do i = 1, ubound(mtln_solver%bundles, 1) + if (ubound(mtln_solver%bundles(i)%probes, 1) /= 0) then + do j = 1, ubound(mtln_solver%bundles(i)%probes, 1) + if (mtln_solver%bundles(i)%probes(j)%in_layer) ThereAreObservation = .true. + end do + end if + end do + end if end block #endif ! diff --git a/src_output/output.F90 b/src_output/output.F90 index 82efb2a7..3fecc597 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -9,8 +9,9 @@ module output use mod_movieProbeOutput use mod_frequencySliceProbeOutput use mod_farFieldOutput - use mtln_solver_mod - use Wire_bundles_mtln_mod + use mtln_solver_mod, only: mtln_solver_t => mtln_t + use Wire_bundles_mtln_mod, only: GetSolverPtr + implicit none private @@ -35,7 +36,7 @@ module output private :: get_required_output_count !=========================== - integer(kind=SINGLE), parameter :: UNDEFINED_PROBE = -1, & + integer(kind=SINGLE), parameter :: UNDEFINED_PROBE = -1, & POINT_PROBE_ID = 0, & WIRE_CURRENT_PROBE_ID = 1, & WIRE_CHARGE_PROBE_ID = 2, & @@ -144,16 +145,18 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio #ifdef CompileWithMTLN block - type(mtln_t), pointer :: mtln_solver - integer :: i, j - mtln_solver => GetSolverPtr() - do i = 1, ubound(mtln_solver%bundles, 1) - if (ubound(mtln_solver%bundles(i)%probes, 1) /= 0) then - do j = 1, ubound(mtln_solver%bundles(i)%probes, 1) - if (mtln_solver%bundles(i)%probes(j)%in_layer) thereAreMtlnObservations = .true. + type(mtln_solver_t), pointer :: mtln_solver + integer :: i, j + mtln_solver => GetSolverPtr() + if (mtln_solver%number_of_bundles > 0) then + do i = 1, ubound(mtln_solver%bundles, 1) + if (ubound(mtln_solver%bundles(i)%probes, 1) /= 0) then + do j = 1, ubound(mtln_solver%bundles(i)%probes, 1) + if (mtln_solver%bundles(i)%probes(j)%in_layer) thereAreMtlnObservations = .true. + end do + end if end do - end if - end do + end if end block #endif @@ -174,8 +177,8 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputRequestType = sgg%observation(ii)%P(i)%what select case (outputRequestType) - !case (mapvtk) - ! call create_geometry_simulation_vtk(lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, problemInfo, control) + !case (mapvtk) + ! call create_geometry_simulation_vtk(lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, problemInfo, control) case (iEx, iEy, iEz, iHx, iHy, iHz) outputCount = outputCount + 1 @@ -363,6 +366,7 @@ subroutine update_outputs(control, discreteTimeArray, timeIndx, fieldsReference) end subroutine update_outputs subroutine flush_outputs(simulationTimeArray, simulationTimeIndex, control, fields, bounds, farFieldFlushRequested) + implicit none type(fields_reference_t), target :: fields type(fields_reference_t), pointer :: fieldsPtr type(sim_control_t), intent(in) :: control @@ -370,26 +374,26 @@ subroutine flush_outputs(simulationTimeArray, simulationTimeIndex, control, fiel logical, intent(in) :: farFieldFlushRequested real(KIND=RKIND_tiempo), pointer, dimension(:), intent(in) :: simulationTimeArray integer, intent(in) :: simulationTimeIndex - integer :: i + integer :: outIdx fieldsPtr => fields - do i = 1, size(outputs) - select case (outputs(i)%outputID) + do outIdx = 1, size(outputs) + select case (outputs(outIdx)%outputID) case (POINT_PROBE_ID) - call flush_solver_output(outputs(i)%pointProbe) + call flush_solver_output(outputs(outIdx)%pointProbe) case (WIRE_CURRENT_PROBE_ID) - call flush_solver_output(outputs(i)%wireCurrentProbe) + call flush_solver_output(outputs(outIdx)%wireCurrentProbe) case (WIRE_CHARGE_PROBE_ID) - call flush_solver_output(outputs(i)%wireChargeProbe) + call flush_solver_output(outputs(outIdx)%wireChargeProbe) case (BULK_PROBE_ID) - call flush_solver_output(outputs(i)%bulkCurrentProbe) + call flush_solver_output(outputs(outIdx)%bulkCurrentProbe) case (MOVIE_PROBE_ID) - call flush_solver_output(outputs(i)%movieProbe) + call flush_solver_output(outputs(outIdx)%movieProbe) case (FREQUENCY_SLICE_PROBE_ID) - call flush_solver_output(outputs(i)%frequencySliceProbe) + call flush_solver_output(outputs(outIdx)%frequencySliceProbe) case (FAR_FIELD_PROBE_ID) - if (farFieldFlushRequested) call flush_solver_output(outputs(i)%farFieldOutput, simulationTimeArray, simulationTimeIndex, control, fieldsPtr, bounds) + if (farFieldFlushRequested) call flush_solver_output(outputs(outIdx)%farFieldOutput, simulationTimeArray, simulationTimeIndex, control, fieldsPtr, bounds) case default end select end do @@ -452,7 +456,7 @@ subroutine create_pvd(pvdPath) write (unit, *) '' write (unit, *) '' write (unit, *) ' ' - close(unit) + close (unit) end subroutine create_pvd subroutine close_pvd(pvdPath) @@ -491,35 +495,35 @@ subroutine registerOutputFiles(control, outputCount) call create_file_with_path(outputRequestFile, iostat) if (iostat /= 0) call StopOnError(control%layoutnumber, control%size, 'Error while creating new outputrequestRegister file...') - open (newunit=unit, file=trim(outputRequestFile), status='old', action='write', position='append', iostat=iostat) - do i=1, outputCount + open (newunit=unit, file=trim(adjustl(outputRequestFile)), status='replace', action='write', position='append', iostat=iostat) + do i = 1, outputCount select case (outputs(i)%outputID) case (POINT_PROBE_ID) if (any(outputs(i)%pointProbe%domain%domainType == (/TIME_DOMAIN, BOTH_DOMAIN/))) then - write(unit, *) trim(outputs(i)%pointProbe%filePathTime) + write (unit, *) trim(adjustl(outputs(i)%pointProbe%filePathTime)) end if if (any(outputs(i)%pointProbe%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then - write(unit, *) trim(outputs(i)%pointProbe%filePathFreq) + write (unit, *) trim(adjustl(outputs(i)%pointProbe%filePathFreq)) end if case (WIRE_CURRENT_PROBE_ID) - write(unit, *) trim(outputs(i)%wireCurrentProbe%filePathTime) + write (unit, *) trim(adjustl(outputs(i)%wireCurrentProbe%filePathTime)) case (WIRE_CHARGE_PROBE_ID) - write(unit, *) trim(outputs(i)%wireChargeProbe%filePathTime) + write (unit, *) trim(adjustl(outputs(i)%wireChargeProbe%filePathTime)) case (BULK_PROBE_ID) - write(unit, *) trim(outputs(i)%bulkCurrentProbe%filePathTime) + write (unit, *) trim(adjustl(outputs(i)%bulkCurrentProbe%filePathTime)) case (MOVIE_PROBE_ID) - write(unit, *) trim(outputs(i)%movieProbe%filePathTime) + write (unit, *) trim(adjustl(outputs(i)%movieProbe%filePathTime)) case (FREQUENCY_SLICE_PROBE_ID) - write(unit, *) trim(outputs(i)%frequencySliceProbe%filePathFreq) + write (unit, *) trim(adjustl(outputs(i)%frequencySliceProbe%filePathFreq)) case (FAR_FIELD_PROBE_ID) - write(unit, *) trim(outputs(i)%farFieldOutput%filePathFreq) + write (unit, *) trim(adjustl(outputs(i)%farFieldOutput%filePathFreq)) case default call stoponerror(0, 0, 'Output update not implemented') end select end do - write(unit, *) 'END!' - close(unit) + write (unit, *) 'END!' + close (unit) end subroutine end module output From fd04696ae02ef0ebc5745c70991b86651f00fbc4 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 19 Feb 2026 10:54:31 +0100 Subject: [PATCH 79/96] Implement mapVTK output functionality and integrate with existing output module --- src_output/CMakeLists.txt | 1 + src_output/mapVTKOutput.F90 | 256 +++++++++++++++++++++++++++++++++++- src_output/output.F90 | 17 ++- src_output/outputTypes.F90 | 7 +- 4 files changed, 271 insertions(+), 10 deletions(-) diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index 33389f7d..73ca99f6 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -10,6 +10,7 @@ add_library(fdtd-output "movieProbeOutput.F90" "frequencySliceProbeOutput.F90" "farFieldProbeOutput.F90" + "mapVTKOutput.F90" ) target_link_libraries(fdtd-output semba-types diff --git a/src_output/mapVTKOutput.F90 b/src_output/mapVTKOutput.F90 index c3ba170e..3dcdb373 100644 --- a/src_output/mapVTKOutput.F90 +++ b/src_output/mapVTKOutput.F90 @@ -1,11 +1,259 @@ module mod_mapVTKOutput - implicit none use FDETYPES + use outputTypes + use mod_outputUtils + use vtk_fortran + use mod_directoryUtils + use mod_allocationUtils + implicit none contains + subroutine init_mapvtk_output(this, lowerBound, upperBound, field, outputTypeExtension, mpidir, problemInfo) + type(mapvtk_output_t), intent(out) :: this + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound + type(problem_info_t), intent(in) :: problemInfo + integer(kind=SINGLE), intent(in) :: mpidir, field + character(len=BUFSIZE), intent(in) :: outputTypeExtension + + integer(kind=SINGLE) :: i + + this%mainCoords = lowerBound + this%auxCoords = upperBound + this%component = field + + this%path = get_output_path() + call store_relevant_coordinates(this, problemInfo) + + contains + + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_coordinates_extension(this%mainCoords, this%auxCoords, mpidir) + prefixFieldExtension = get_prefix_extension(field, mpidir) + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) + return + end function + + subroutine store_media_tag() + end subroutine store_media_tag + end subroutine init_mapvtk_output + + subroutine store_relevant_coordinates(this, problemInfo) + type(mapvtk_output_t), intent(out) :: this + type(problem_info_t), intent(in) :: problemInfo + + integer :: i, j, k, Hfield, counter + counter = 0 + do k = this%mainCoords%Z, this%auxCoords%Z + do j = this%mainCoords%Y, this%auxCoords%Y + do i = this%mainCoords%X, this%auxCoords%X + do Hfield = iHx, iHz + if (isWithinBounds(Hfield, i, j, k, problemInfo)) then + if isMaterialExceptPML(Hfield, i, j, k, problemInfo) then + counter = counter + 1 + end if + if (problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k) < 0 & + .and. (btest(iabs(problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k)), Hfield - 1)) & + .and. .not. isPML(Hfield, i, j, k, problemInfo)) then + counter = counter + 1 + end if + end do + end do + end do + end do + this%nPoints = counter + call alloc_and_init(this%coords, 3, this%nPoints, -99) + call alloc_and_init(this%tagNumbers, this%nPoints, -1) + + counter = 0 + do k = this%mainCoords%Z, this%auxCoords%Z + do j = this%mainCoords%Y, this%auxCoords%Y + do i = this%mainCoords%X, this%auxCoords%X + do Hfield = iHx, iHz + if (isWithinBounds(Hfield, i, j, k, problemInfo)) then + if isMaterialExceptPML(Hfield, i, j, k, problemInfo) then + counter = counter + 1 + call writeTagInfo(this, counter, i, j, k, problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k)) + end if + if (problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k) < 0 & + .and. (btest(iabs(problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k)), Hfield - 1)) & + .and. .not. isPML(Hfield, i, j, k, problemInfo)) then + counter = counter + 1 + call writeTagInfo(this, counter, i, j, k, problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k)) + end if + end do + end do + end do + end do + end subroutine store_relevant_coordinates + + logical function isMaterialExceptPML(field, i, j, k, problemInfo) + integer, intent(in) :: field, i, j, k + type(problem_info_t), intent(in):: problemInfo + isMaterialExceptPML = .not. isMediaVacuum(field, i, j, k, problemInfo) + isMaterialExceptPML = isMaterialExceptPML .and. (.not. isPML(Hfield, i, j, k, problemInfo)) + end function isMaterialExceptPML + + subroutine writeFaceTagInfo(this, counter, i, j, k, tag) + type(mapvtk_output_t), intent(inout) :: this + integer, intent(in) :: i, j, k, counter, tag + this%coords(1, counter) = i + this%coords(2, counter) = j + this%coords(3, counter) = k + this%materialTag(counter) = tag + end subroutine + + subroutine create_geometry_simulation_vtk(this, problemInfo, control) + implicit none + + type(mapvtk_output_t), intent(in) :: this + type(problem_info_t), intent(in) :: problemInfo + type(sim_control_t), intent(in) :: control + + type(vtk_file) :: vtk + + integer :: ierr + integer :: i, nCells, nPoints + + integer, allocatable :: connectivity(:) + integer, allocatable :: offsets(:) + integer, allocatable :: celltypes(:) + + real(RKIND), allocatable :: points(:, :) + real(RKIND), allocatable :: media(:) + real(RKIND), allocatable :: tags(:) + + character(len=BUFSIZE) :: info_str + + !--------------------------------------------- + ! Initialize + !--------------------------------------------- + + ierr = vtk%initialize( & + format='ASCII', & + filename=trim(this%path), & + mesh_topology='UnstructuredGrid') + + if (ierr /= 0) then + call StopOnError(control%layoutnumber, control%size, & + 'Error initializing VTK') + end if + + !--------------------------------------------- + ! MetaData + !--------------------------------------------- + info_str = 'PEC=0, already_YEEadvanced_byconformal=5, NOTOUCHNOUSE=6, WIRE=7, WIRE-COLISION=8, COMPO=3, DISPER=1, DIEL=2, SLOT=4, CONF=5/6, OTHER=-1 (ADD +0.5 for borders)' + call vtk%write_field_data('Metadata', info_str) + + !--------------------------------------------- + ! Points + !--------------------------------------------- + + nPoints = this%nPoints + 1 + + allocate (points(3, nPoints)) + + do i = 0, this%nPoints + points(1, i + 1) = this%coords(1, i) + points(2, i + 1) = this%coords(2, i) + points(3, i + 1) = this%coords(3, i) + end do + + call vtk%write_points(points) + + deallocate (points) + + !--------------------------------------------- + ! Cells + !--------------------------------------------- + + nCells = numberOfSerialized + + allocate (offsets(nCells)) + allocate (celltypes(nCells)) + + ! Maximum possible size + allocate (connectivity(5*nCells)) + + integer :: pos + pos = 0 + + do i = 1, nCells + + if (Elems(i, 3) == -1) then + ! + ! Edge ā†’ VTK_LINE = 3 + ! + + connectivity(pos + 1) = Elems(i, 1) + connectivity(pos + 2) = Elems(i, 2) + + pos = pos + 2 + + offsets(i) = pos + celltypes(i) = 3 + + else + ! + ! Quad ā†’ VTK_QUAD = 9 + ! + + connectivity(pos + 1) = Elems(i, 1) + connectivity(pos + 2) = Elems(i, 2) + connectivity(pos + 3) = Elems(i, 3) + connectivity(pos + 4) = Elems(i, 4) + + pos = pos + 4 + + offsets(i) = pos + celltypes(i) = 9 + + end if + + end do + + call vtk%write_cells(connectivity(1:pos), offsets) + call vtk%write_cell_types(celltypes) + + deallocate (connectivity, offsets, celltypes) + + !--------------------------------------------- + ! Cell data: mediatype + !--------------------------------------------- + + allocate (media(nCells)) + + do i = 1, nCells + media(i) = Serialized%valor(1, i) + end do + + call vtk%write_cell_data('mediatype', media) + + deallocate (media) + + !--------------------------------------------- + ! Cell data: tagnumber + !--------------------------------------------- + + allocate (tags(nCells)) + + do i = 1, nCells + tags(i) = real(Serialized%sggMtag(i), RKIND) + end do + + call vtk%write_cell_data('tagnumber', tags) + + deallocate (tags) + + !--------------------------------------------- + ! Finalize + !--------------------------------------------- + + call vtk%finalize() - subroutine create_geometry_simulation_vtk() - end subroutine + end subroutine create_geometry_simulation_vtk -end module mod_mapVTKOutput + end module mod_mapVTKOutput diff --git a/src_output/output.F90 b/src_output/output.F90 index 3fecc597..023cc117 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -11,6 +11,7 @@ module output use mod_farFieldOutput use mtln_solver_mod, only: mtln_solver_t => mtln_t use Wire_bundles_mtln_mod, only: GetSolverPtr + use mod_mapVTKOutput implicit none @@ -45,6 +46,7 @@ module output MOVIE_PROBE_ID = 5, & FREQUENCY_SLICE_PROBE_ID = 6, & FAR_FIELD_PROBE_ID = 7 + MAPVTK_ID = 8 REAL(KIND=RKIND), save :: eps0, mu0 REAL(KIND=RKIND), pointer, dimension(:), save :: InvEps, InvMu @@ -59,7 +61,8 @@ module output init_bulk_probe_output, & init_movie_probe_output, & init_frequency_slice_probe_output, & - init_farField_probe_output + init_farField_probe_output, & + init_mapvtk_output end interface interface update_solver_output @@ -103,6 +106,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio type(media_matrices_t), target, intent(in) :: media type(limit_t), dimension(:), target, intent(in) :: SINPML_fullsize type(bounds_t), target :: bounds + type(taglist_t), target :: tagNumbers type(sim_control_t), intent(in) :: control logical, intent(inout) :: wiresExists logical, intent(out) :: observationsExists @@ -126,6 +130,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio problemInfo%materialList => sgg%Med problemInfo%simulationBounds => bounds problemInfo%problemDimension => SINPML_fullsize + problemInfo%tagNumbers => tagNumbers outputs => NULL() allocate (outputs(requestedOutputs)) @@ -177,8 +182,12 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio outputRequestType = sgg%observation(ii)%P(i)%what select case (outputRequestType) - !case (mapvtk) - ! call create_geometry_simulation_vtk(lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, problemInfo, control) + case (mapvtk) + outputCount = outputCount + 1 + outputs(outputCount)%outputID = MAPVTK_ID + call init_solver_output(outputs(outputCount)%mapvtkOutput, lowerBound, upperBound, outputRequestType, outputTypeExtension, control%mpidir, problemInfo) + call create_geometry_simulation_vtk(outputs(outputCount)%mapvtkOutput, problemInfo, control) + !! call adjust_computation_range --- Required due to issues in mpi region edges case (iEx, iEy, iEz, iHx, iHy, iHz) outputCount = outputCount + 1 @@ -236,8 +245,6 @@ 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 diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 58542444..b27f1304 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -90,7 +90,6 @@ module outputTypes integer(kind=SINGLE) :: component character(len=BUFSIZE) :: path end type abstract_probe_t - type, extends(abstract_probe_t) :: abstract_time_probe_t character(len=BUFSIZE) :: filePathTime integer(kind=SINGLE) :: nTime = 0_SINGLE @@ -115,6 +114,11 @@ module outputTypes !===================================================== ! Concrete probe types !===================================================== + + type, extends(abstract_probe_t) :: mapvtk_output_t + type(cell_coordinate_t) :: auxCoords + end type mapvtk_output_t + type, extends(abstract_time_frequency_probe_t) :: point_probe_output_t real(kind=RKIND), allocatable :: valueForTime(:) complex(kind=CKIND), allocatable :: valueForFreq(:) @@ -183,6 +187,7 @@ module outputTypes type(movie_probe_output_t), allocatable :: movieProbe type(frequency_slice_probe_output_t), allocatable :: frequencySliceProbe type(far_field_probe_output_t), allocatable :: farFieldOutput + type(mapvtk_output_t), allocatable :: mapvtkOutput #ifdef CompileWithMPI integer(kind=4) :: MPISubcomm, MPIRoot, MPIGroupIndex integer(kind=4) :: ZIorig, ZEorig From 8524611d4cf5f20f857fe1e8f453b0853727e314 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 19 Feb 2026 12:34:29 +0100 Subject: [PATCH 80/96] update test_script --- test/pyWrapper/test_script.py | 179 ++++++++++++++++++++++++---------- 1 file changed, 126 insertions(+), 53 deletions(-) diff --git a/test/pyWrapper/test_script.py b/test/pyWrapper/test_script.py index c1c7d6a1..e016c369 100644 --- a/test/pyWrapper/test_script.py +++ b/test/pyWrapper/test_script.py @@ -6,64 +6,137 @@ import sys from io import StringIO import time +import matplotlib.pyplot as plt +import numpy as np LOG_FILE = os.path.join(os.path.dirname(__file__), 'test_log.txt') -def printList(listObject:list, listName:str): - print(f'List from {listName}') - for element in listObject: - print(str(element)) - print(f'End of list {listName}') +def printList(listObject: list, listName: str): + print(f'List from {listName}') + for element in listObject: + print(str(element)) + print(f'End of list {listName}') -def test_compareOutput(tmp_path): - # Delete log file if it exists - if os.path.exists(LOG_FILE): - os.remove(LOG_FILE) - - # Redirect stdout to both console and log file - class Tee: - def __init__(self, *files): - self.files = files - def write(self, obj): - for f in self.files: - f.write(obj) - f.flush() - def flush(self): - for f in self.files: - f.flush() - - with open(LOG_FILE, 'w') as log: - sys.stdout = Tee(sys.stdout, log) - print(os.path.join(tmp_path, 'rls')) - fn = CASES_FOLDER + 'coated_antenna/coated_antenna.fdtd.json' - rlsFolder = os.path.join(tmp_path, 'rls') - solverrls = FDTD( - input_filename=fn, - path_to_exe=DEBUG_SEMBA_EXE, - run_in_folder=rlsFolder - ) - startTime = time.time() - solverrls.run() - endTime = time.time() - print(f'Release version time spent {endTime-startTime}') +def read_xy_file(file_path): + """ + Reads a file with two columns (x and y) and returns as numpy arrays. + Skips the first row assuming it's a header. + """ + data = np.loadtxt(file_path, delimiter=None, skiprows=1) + if data.shape[1] != 2: + raise ValueError(f"File {file_path} does not have two columns after skipping header.") + x, y = data[:, 0], data[:, 1] + return x, y - fn = CASES_FOLDER + 'coated_antenna/coated_antenna.fdtd.json' - dbgFolder = os.path.join(tmp_path, 'dbg') - solverdbg = FDTD( - input_filename=fn, - path_to_exe=SEMBA_EXE, - run_in_folder=dbgFolder - ) - startTime = time.time() - solverdbg.run() - endTime = time.time() - print(f'Debug version time spent {endTime-startTime}') +def plot_comparison(rls_folder, dbg_folder, output_folder): + """ + Plot comparison between files in Release and Debug folders. + Matches files by name. + """ + rls_files = sorted(os.listdir(rls_folder)) + dbg_files = sorted(os.listdir(dbg_folder)) + skip_labels = ["Outputrequests", "Warnings", "Energy", "Report", "json", "paraviewfilters", ".exc"] + for rls_file, dbg_file in zip(rls_files, dbg_files): + if rls_file != dbg_file: + print(f"Warning: file names do not match: {rls_file} vs {dbg_file}") + continue - rlsFiles = os.listdir(rlsFolder) - printList(rlsFiles, 'Release') - dbgFiles = os.listdir(dbgFolder) - printList(dbgFiles, 'Debug') - assert len(rlsFiles) == len(dbgFiles), 'Missing files' + if any(label in rls_file for label in skip_labels): + print(f"Warning: file name to be skipped detected: {rls_file}") + continue + if any(label in dbg_file for label in skip_labels): + print(f"Warning: file name to be skipped detected: {dbg_file}") + continue + rls_path = os.path.join(rls_folder, rls_file) + dbg_path = os.path.join(dbg_folder, dbg_file) + + x_rls, y_rls = read_xy_file(rls_path) + x_dbg, y_dbg = read_xy_file(dbg_path) + + plt.figure(figsize=(8, 5)) + plt.plot(x_rls, y_rls, label='Release', linestyle='-', color='blue', alpha=0.7) + plt.plot(x_dbg, y_dbg, label='Debug', linestyle='--', color='red', alpha=0.7) + plt.title(f"Comparison: {rls_file}") + plt.xlabel('X') + plt.ylabel('Y') + plt.legend() + plt.grid(True) + plt.tight_layout() + # Save plot + os.makedirs(output_folder, exist_ok=True) + plt.savefig(os.path.join(output_folder, f"{rls_file}_comparison.png")) + plt.close() - sys.stdout = sys.__stdout__ # Restore stdout \ No newline at end of file +def test_compareOutput(): + # Carpeta raĆ­z para la prueba + base_test_folder = os.path.join(os.path.dirname(__file__), 'test') + rlsFolder = os.path.join(base_test_folder, 'rls') + dbgFolder = os.path.join(base_test_folder, 'dbg') + + # Crear carpetas si no existen + os.makedirs(rlsFolder, exist_ok=True) + os.makedirs(dbgFolder, exist_ok=True) + + # Archive old log if it exists + if os.path.exists(LOG_FILE): + old_log = os.path.join(os.path.dirname(LOG_FILE), 'test_log.old.txt') + import shutil + shutil.copy(LOG_FILE, old_log) + print(f"Archived previous log to {old_log}") + + # Delete current log + if os.path.exists(LOG_FILE): + os.remove(LOG_FILE) + + # Redirect stdout to both console and log + class Tee: + def __init__(self, *files): + self.files = files + def write(self, obj): + for f in self.files: + f.write(obj) + f.flush() + def flush(self): + for f in self.files: + f.flush() + + with open(LOG_FILE, 'w') as log: + sys.stdout = Tee(sys.stdout, log) + + fn = CASES_FOLDER + 'dielectric/dielectricTransmission.fdtd.json' + + # Release version + solverrls = FDTD( + input_filename=fn, + path_to_exe=DEBUG_SEMBA_EXE, + run_in_folder=rlsFolder + ) + startTime = time.time() + solverrls.run() + endTime = time.time() + print(f'Release version time spent {endTime-startTime}') + + # Debug version + solverdbg = FDTD( + input_filename=fn, + path_to_exe=SEMBA_EXE, + run_in_folder=dbgFolder + ) + startTime = time.time() + solverdbg.run() + endTime = time.time() + print(f'Debug version time spent {endTime-startTime}') + + rlsFiles = os.listdir(rlsFolder) + printList(rlsFiles, 'Release') + dbgFiles = os.listdir(dbgFolder) + printList(dbgFiles, 'Debug') + assert len(rlsFiles) == len(dbgFiles), 'Missing files' + + # Plot comparison + plot_output_folder = os.path.join(base_test_folder, 'plots') + plot_comparison(rlsFolder, dbgFolder, plot_output_folder) + print(f"Plots saved in: {plot_output_folder}") + + sys.stdout = sys.__stdout__ # Restore stdout From 603d30cd248ff990426427ecaaae9d13c3f23feb Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 19 Feb 2026 12:35:51 +0100 Subject: [PATCH 81/96] Refactor output initialization and update related functions to separate material tags and enhance VTK output handling --- src_main_pub/timestepping.F90 | 2 +- src_output/mapVTKOutput.F90 | 297 +++++++++++++--------------------- src_output/output.F90 | 15 +- src_output/outputTypes.F90 | 11 +- src_output/outputUtils.F90 | 9 ++ test/output/test_output.F90 | 30 +++- 6 files changed, 166 insertions(+), 198 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 7c96adeb..0e1a1805 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -1510,7 +1510,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%bounds, this%control, this%thereAre%Observation, this%thereAre%wires) + call init_outputs(this%sgg, this%media, this%sinPML_fullsize, this%tag_numbers, 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/mapVTKOutput.F90 b/src_output/mapVTKOutput.F90 index 3dcdb373..fdfc3993 100644 --- a/src_output/mapVTKOutput.F90 +++ b/src_output/mapVTKOutput.F90 @@ -5,6 +5,7 @@ module mod_mapVTKOutput use vtk_fortran use mod_directoryUtils use mod_allocationUtils + use Report implicit none contains @@ -41,31 +42,34 @@ end subroutine store_media_tag end subroutine init_mapvtk_output subroutine store_relevant_coordinates(this, problemInfo) - type(mapvtk_output_t), intent(out) :: this + type(mapvtk_output_t), intent(inout) :: this type(problem_info_t), intent(in) :: problemInfo integer :: i, j, k, Hfield, counter + counter = 0 do k = this%mainCoords%Z, this%auxCoords%Z do j = this%mainCoords%Y, this%auxCoords%Y do i = this%mainCoords%X, this%auxCoords%X do Hfield = iHx, iHz if (isWithinBounds(Hfield, i, j, k, problemInfo)) then - if isMaterialExceptPML(Hfield, i, j, k, problemInfo) then - counter = counter + 1 - end if - if (problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k) < 0 & - .and. (btest(iabs(problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k)), Hfield - 1)) & - .and. .not. isPML(Hfield, i, j, k, problemInfo)) then - counter = counter + 1 + if (isMaterialExceptPML(Hfield, i, j, k, problemInfo)) then + counter = counter + 1 + end if + if (problemInfo%materialTag%getFaceTag(Hfield, i, j, k) < 0 & + .and. (btest(iabs(problemInfo%materialTag%getFaceTag(Hfield, i, j, k)), Hfield - 1)) & + .and. (.not. isPML(Hfield, i, j, k, problemInfo))) then + counter = counter + 1 + end if end if end do end do end do end do + this%nPoints = counter call alloc_and_init(this%coords, 3, this%nPoints, -99) - call alloc_and_init(this%tagNumbers, this%nPoints, -1) + call alloc_and_init(this%materialTag, this%nPoints, -1) counter = 0 do k = this%mainCoords%Z, this%auxCoords%Z @@ -73,187 +77,118 @@ subroutine store_relevant_coordinates(this, problemInfo) do i = this%mainCoords%X, this%auxCoords%X do Hfield = iHx, iHz if (isWithinBounds(Hfield, i, j, k, problemInfo)) then - if isMaterialExceptPML(Hfield, i, j, k, problemInfo) then - counter = counter + 1 - call writeTagInfo(this, counter, i, j, k, problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k)) - end if - if (problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k) < 0 & - .and. (btest(iabs(problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k)), Hfield - 1)) & - .and. .not. isPML(Hfield, i, j, k, problemInfo)) then - counter = counter + 1 - call writeTagInfo(this, counter, i, j, k, problemInfo%tagNumbers%getFaceTag(Hfield, i, j, k)) + if (isMaterialExceptPML(Hfield, i, j, k, problemInfo)) then + counter = counter + 1 + call writeFaceTagInfo(this, counter, i, j, k, problemInfo%materialTag%getFaceTag(Hfield, i, j, k)) + end if + if (problemInfo%materialTag%getFaceTag(Hfield, i, j, k) < 0 & + .and. (btest(iabs(problemInfo%materialTag%getFaceTag(Hfield, i, j, k)), Hfield - 1)) & + .and. .not. isPML(Hfield, i, j, k, problemInfo)) then + counter = counter + 1 + call writeFaceTagInfo(this, counter, i, j, k, problemInfo%materialTag%getFaceTag(Hfield, i, j, k)) + end if end if end do end do end do end do - end subroutine store_relevant_coordinates - - logical function isMaterialExceptPML(field, i, j, k, problemInfo) - integer, intent(in) :: field, i, j, k - type(problem_info_t), intent(in):: problemInfo - isMaterialExceptPML = .not. isMediaVacuum(field, i, j, k, problemInfo) - isMaterialExceptPML = isMaterialExceptPML .and. (.not. isPML(Hfield, i, j, k, problemInfo)) - end function isMaterialExceptPML - - subroutine writeFaceTagInfo(this, counter, i, j, k, tag) - type(mapvtk_output_t), intent(inout) :: this - integer, intent(in) :: i, j, k, counter, tag - this%coords(1, counter) = i - this%coords(2, counter) = j - this%coords(3, counter) = k - this%materialTag(counter) = tag - end subroutine - - subroutine create_geometry_simulation_vtk(this, problemInfo, control) - implicit none - - type(mapvtk_output_t), intent(in) :: this - type(problem_info_t), intent(in) :: problemInfo - type(sim_control_t), intent(in) :: control - - type(vtk_file) :: vtk - - integer :: ierr - integer :: i, nCells, nPoints - - integer, allocatable :: connectivity(:) - integer, allocatable :: offsets(:) - integer, allocatable :: celltypes(:) - - real(RKIND), allocatable :: points(:, :) - real(RKIND), allocatable :: media(:) - real(RKIND), allocatable :: tags(:) - - character(len=BUFSIZE) :: info_str - - !--------------------------------------------- - ! Initialize - !--------------------------------------------- - - ierr = vtk%initialize( & - format='ASCII', & - filename=trim(this%path), & - mesh_topology='UnstructuredGrid') - - if (ierr /= 0) then - call StopOnError(control%layoutnumber, control%size, & - 'Error initializing VTK') - end if - - !--------------------------------------------- - ! MetaData - !--------------------------------------------- - info_str = 'PEC=0, already_YEEadvanced_byconformal=5, NOTOUCHNOUSE=6, WIRE=7, WIRE-COLISION=8, COMPO=3, DISPER=1, DIEL=2, SLOT=4, CONF=5/6, OTHER=-1 (ADD +0.5 for borders)' - call vtk%write_field_data('Metadata', info_str) - - !--------------------------------------------- - ! Points - !--------------------------------------------- - - nPoints = this%nPoints + 1 - - allocate (points(3, nPoints)) - - do i = 0, this%nPoints - points(1, i + 1) = this%coords(1, i) - points(2, i + 1) = this%coords(2, i) - points(3, i + 1) = this%coords(3, i) - end do - - call vtk%write_points(points) - - deallocate (points) - - !--------------------------------------------- - ! Cells - !--------------------------------------------- - - nCells = numberOfSerialized - - allocate (offsets(nCells)) - allocate (celltypes(nCells)) - - ! Maximum possible size - allocate (connectivity(5*nCells)) - - integer :: pos - pos = 0 - - do i = 1, nCells - - if (Elems(i, 3) == -1) then - ! - ! Edge ā†’ VTK_LINE = 3 - ! - - connectivity(pos + 1) = Elems(i, 1) - connectivity(pos + 2) = Elems(i, 2) - - pos = pos + 2 - - offsets(i) = pos - celltypes(i) = 3 - - else - ! - ! Quad ā†’ VTK_QUAD = 9 - ! - - connectivity(pos + 1) = Elems(i, 1) - connectivity(pos + 2) = Elems(i, 2) - connectivity(pos + 3) = Elems(i, 3) - connectivity(pos + 4) = Elems(i, 4) - - pos = pos + 4 - - offsets(i) = pos - celltypes(i) = 9 - - end if - - end do - - call vtk%write_cells(connectivity(1:pos), offsets) - call vtk%write_cell_types(celltypes) - - deallocate (connectivity, offsets, celltypes) - - !--------------------------------------------- - ! Cell data: mediatype - !--------------------------------------------- - - allocate (media(nCells)) - - do i = 1, nCells - media(i) = Serialized%valor(1, i) - end do - - call vtk%write_cell_data('mediatype', media) - - deallocate (media) - - !--------------------------------------------- - ! Cell data: tagnumber - !--------------------------------------------- - - allocate (tags(nCells)) - - do i = 1, nCells - tags(i) = real(Serialized%sggMtag(i), RKIND) - end do + end subroutine store_relevant_coordinates + + logical function isMaterialExceptPML(field, i, j, k, problemInfo) + integer, intent(in) :: field, i, j, k + type(problem_info_t), intent(in):: problemInfo + isMaterialExceptPML = .not. isMediaVacuum(field, i, j, k, problemInfo) + isMaterialExceptPML = isMaterialExceptPML .and. (.not. isPML(field, i, j, k, problemInfo)) + end function isMaterialExceptPML + + subroutine writeFaceTagInfo(this, counter, i, j, k, tag) + type(mapvtk_output_t), intent(inout) :: this + integer, intent(in) :: i, j, k, counter, tag + this%coords(1, counter) = i + this%coords(2, counter) = j + this%coords(3, counter) = k + this%materialTag(counter) = tag + end subroutine + + subroutine create_geometry_simulation_vtk(this, problemInfo, control) + implicit none + + type(mapvtk_output_t), intent(in) :: this + type(problem_info_t), intent(in) :: problemInfo + type(sim_control_t), intent(in) :: control + type(vtk_file) :: vtkOutput + + integer :: ierr, i, npts, unit + real(RKIND), allocatable :: x(:), y(:), z(:), materialTag(:) + character(len=BUFSIZE) :: info_str + character(len=BUFSIZE) :: metadata_filename, vtkPath + + !--------------------------------------------- + ! Initialize VTK file + !--------------------------------------------- + call create_folder(this%path, ierr) + vtkPath = join_path(this%path, get_last_component(this%path))//vtkFileExtension + ierr = vtkOutput%initialize(format='ASCII', filename=trim(vtkPath), mesh_topology='UnstructuredGrid') + if (ierr /= 0) call StopOnError(control%layoutnumber, control%size, 'Error initializing VTK') + + !--------------------------------------------- + ! Points + !--------------------------------------------- + npts = this%nPoints + 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 - call vtk%write_cell_data('tagnumber', tags) + !--------------------------------------------- + ! Metadata: write to .txt file + !--------------------------------------------- + info_str = 'PEC=0, already_YEEadvanced_byconformal=5, NOTOUCHNOUSE=6, '// & + 'WIRE=7, WIRE-COLISION=8, COMPO=3, DISPER=1, DIEL=2, SLOT=4, '// & + 'CONF=5/6, OTHER=-1 (ADD +0.5 for borders)' + + ! Create .txt file with same base name as VTK file + metadata_filename = trim(this%path)//'.txt' + open (newunit=unit, file=metadata_filename, status='replace', action='write', iostat=ierr) + if (ierr /= 0) then + print *, 'Error opening metadata file: ', metadata_filename + else + write (unit, '(A)') trim(info_str) + close (unit) + end if + + !--------------------------------------------- + ! Write geometry to VTK + !--------------------------------------------- + ierr = vtkOutput%xml_writer%write_geo(n=npts, x=x, y=y, z=z) + + !--------------------------------------------- + ! Node data: material tags + !--------------------------------------------- + allocate (materialTag(npts)) + do i = 1, npts + materialTag(i) = this%materialTag(i) + end do - deallocate (tags) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') + ierr = vtkOutput%xml_writer%write_dataarray(data_name='TagNumber', x=materialTag) + ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - !--------------------------------------------- - ! Finalize - !--------------------------------------------- + !--------------------------------------------- + ! Clean up + !--------------------------------------------- + deallocate (materialTag) + deallocate (x, y, z) - call vtk%finalize() + !--------------------------------------------- + ! Finalize VTK file + !--------------------------------------------- + ierr = vtkOutput%xml_writer%finalize() - end subroutine create_geometry_simulation_vtk + end subroutine create_geometry_simulation_vtk - end module mod_mapVTKOutput +end module mod_mapVTKOutput diff --git a/src_output/output.F90 b/src_output/output.F90 index 023cc117..bab565d1 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -45,7 +45,7 @@ module output VOLUMIC_CURRENT_PROBE_ID = 4, & MOVIE_PROBE_ID = 5, & FREQUENCY_SLICE_PROBE_ID = 6, & - FAR_FIELD_PROBE_ID = 7 + FAR_FIELD_PROBE_ID = 7, & MAPVTK_ID = 8 REAL(KIND=RKIND), save :: eps0, mu0 @@ -101,12 +101,12 @@ function GetProblemInfo() result(r) return end function - subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observationsExists, wiresExists) + subroutine init_outputs(sgg, media, sinpml_fullsize, materialTags, bounds, control, observationsExists, wiresExists) type(SGGFDTDINFO), intent(in) :: sgg type(media_matrices_t), target, intent(in) :: media type(limit_t), dimension(:), target, intent(in) :: SINPML_fullsize - type(bounds_t), target :: bounds - type(taglist_t), target :: tagNumbers + type(bounds_t),intent(in), target :: bounds + type(taglist_t),intent(in), target :: materialTags type(sim_control_t), intent(in) :: control logical, intent(inout) :: wiresExists logical, intent(out) :: observationsExists @@ -130,7 +130,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio problemInfo%materialList => sgg%Med problemInfo%simulationBounds => bounds problemInfo%problemDimension => SINPML_fullsize - problemInfo%tagNumbers => tagNumbers + problemInfo%materialTag => materialTags outputs => NULL() allocate (outputs(requestedOutputs)) @@ -185,6 +185,8 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, bounds, control, observatio case (mapvtk) outputCount = outputCount + 1 outputs(outputCount)%outputID = MAPVTK_ID + + allocate (outputs(outputCount)%mapvtkOutput) call init_solver_output(outputs(outputCount)%mapvtkOutput, lowerBound, upperBound, outputRequestType, outputTypeExtension, control%mpidir, problemInfo) call create_geometry_simulation_vtk(outputs(outputCount)%mapvtkOutput, problemInfo, control) !! call adjust_computation_range --- Required due to issues in mpi region edges @@ -365,6 +367,7 @@ subroutine update_outputs(control, discreteTimeArray, timeIndx, 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%simulationBounds, fieldsReference) + case(MAPVTK_ID) case default call stoponerror(0, 0, 'Output update not implemented') end select @@ -524,6 +527,8 @@ subroutine registerOutputFiles(control, outputCount) write (unit, *) trim(adjustl(outputs(i)%frequencySliceProbe%filePathFreq)) case (FAR_FIELD_PROBE_ID) write (unit, *) trim(adjustl(outputs(i)%farFieldOutput%filePathFreq)) + case (MAPVTK_ID) + write (unit, *) trim(adjustl(outputs(i)%mapvtkOutput%path)) case default call stoponerror(0, 0, 'Output update not implemented') end select diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index b27f1304..18bba416 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -23,6 +23,7 @@ module outputTypes character(len=4), parameter :: pvdExtension = '.pvd' character(len=4), parameter :: datFileExtension = '.dat' + character(len=4), parameter :: vtkFileExtension = '.vtk' character(len=2), parameter :: timeExtension = 'tm' character(len=2), parameter :: frequencyExtension = 'fq' character(len=1), parameter :: wordseparation = '_' @@ -117,6 +118,9 @@ module outputTypes type, extends(abstract_probe_t) :: mapvtk_output_t type(cell_coordinate_t) :: auxCoords + integer(kind=SINGLE), allocatable :: coords(:, :) + integer(kind=SINGLE), allocatable :: materialTag(:) + integer :: nPoints = -1 end type mapvtk_output_t type, extends(abstract_time_frequency_probe_t) :: point_probe_output_t @@ -150,14 +154,14 @@ module outputTypes 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) :: nPoints = -1 integer(kind=SINGLE), allocatable :: coords(:, :) complex(kind=CKIND), allocatable :: valueForFreq(:, :) end type far_field_probe_output_t type, extends(abstract_time_probe_t) :: movie_probe_output_t type(cell_coordinate_t) :: auxCoords - integer(kind=SINGLE) :: nPoints + integer(kind=SINGLE) :: nPoints = -1 integer(kind=SINGLE), allocatable :: coords(:, :) real(kind=RKIND), allocatable :: xValueForTime(:, :) real(kind=RKIND), allocatable :: yValueForTime(:, :) @@ -167,7 +171,7 @@ module outputTypes type, extends(abstract_frequency_probe_t) :: frequency_slice_probe_output_t type(cell_coordinate_t) :: auxCoords - integer(kind=SINGLE) :: nPoints + integer(kind=SINGLE) :: nPoints = -1 integer(kind=SINGLE), allocatable :: coords(:, :) complex(kind=CKIND), allocatable :: xValueForFreq(:, :) complex(kind=CKIND), allocatable :: yValueForFreq(:, :) @@ -199,6 +203,7 @@ module outputTypes type(limit_t), pointer :: problemDimension(:) type(bounds_t), pointer :: simulationBounds type(MediaData_t), pointer :: materialList(:) + type(taglist_t), pointer :: materialTag end type problem_info_t contains diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index f3850dfd..40ab8c1c 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -19,6 +19,7 @@ module mod_outputUtils public :: init_frequency_slice public :: getBlockCurrentDirection public :: isPEC + public :: isPML public :: isSplitOrAdvanced public :: isThinWire public :: isMediaVacuum @@ -393,6 +394,14 @@ logical function isPEC(field, i, j, k, problem) isPEC = problem%materialList(mediaIndex)%is%PEC end function + logical function isPML(field, i, j, k, problem) + integer(kind=4) :: field, i, j, k + integer(kind=SINGLE) :: mediaIndex + type(problem_info_t), intent(in) :: problem + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) + isPML = problem%materialList(mediaIndex)%is%PML + end function + logical function isSurface(field, i, j, k, problem) integer(kind=4), intent(in) :: field, i, j, k type(problem_info_t), intent(in) :: problem diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index a978f7d0..958ff878 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -32,6 +32,7 @@ integer function test_init_point_probe() bind(c) result(err) type(solver_output_t), pointer :: outputs(:) type(MediaData_t), allocatable, target :: materials(:) type(MediaData_t), pointer :: materialsPtr(:) + type(taglist_t) :: tagNumbers real(kind=RKIND_tiempo), pointer :: timeArray(:) real(kind=RKIND_tiempo) :: dt = 0.1_RKIND_tiempo @@ -61,7 +62,7 @@ integer function test_init_point_probe() bind(c) result(err) control = create_control_flags(mpidir=3, nEntradaRoot=trim(nEntrada), wiresflavor='holland') ! Action - call init_outputs(sgg, media, sinpml, bounds, control, outputRequested, hasWires) + call init_outputs(sgg, media, sinpml, tagNumbers, bounds, control, outputRequested, hasWires) outputs => GetOutputs() ! Assertions @@ -114,6 +115,7 @@ integer function test_update_point_probe() bind(c) result(err) type(solver_output_t), pointer :: outputs(:) type(MediaData_t), allocatable, target :: materials(:) type(MediaData_t), pointer :: materialsPtr(:) + type(taglist_t) :: tagNumbers type(dummyFields_t), target :: dummyFields type(fields_reference_t) :: fields @@ -144,7 +146,7 @@ integer function test_update_point_probe() bind(c) result(err) call sgg_set_Med(sgg, materialsPtr) control = create_control_flags(mpidir=3, nEntradaRoot=nEntrada, wiresflavor='holland') - call init_outputs(sgg, media, sinpml, bounds, control, outputRequested, hasWires) + call init_outputs(sgg, media, sinpml, tagNumbers, bounds, control, outputRequested, hasWires) call create_dummy_fields(dummyFields, 1, 10, 0.01_RKIND) @@ -389,6 +391,8 @@ integer function test_init_movie_probe() bind(c) result(err) type(MediaData_t), allocatable, target :: simulationMaterials(:) type(MediaData_t), pointer :: simulationMaterialsPtr(:) + type(taglist_t) :: tagNumbers + type(limit_t) :: sinpml(6) type(Obses_t) :: movieObservable @@ -460,7 +464,7 @@ integer function test_init_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) - call init_outputs(dummysgg, media, sinpml, dummyBound, dummyControl, & + call init_outputs(dummysgg, media, sinpml, tagNumbers, dummyBound, dummyControl, & outputRequested, ThereAreWires) outputs => GetOutputs() @@ -512,6 +516,8 @@ integer function test_update_movie_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) + type(taglist_t) :: tagNumbers + type(XYZlimit_t) :: dummySweep(6) type(XYZlimit_t) :: dummySinpmlSweep(6) type(XYZlimit_t) :: allocationRange(6) @@ -580,7 +586,7 @@ integer function test_update_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) - call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + call init_outputs(dummysgg, media, sinpml_fullsize, tagNumbers, dummyBound, dummyControl, & outputRequested, ThereAreWires) outputs => GetOutputs() @@ -654,6 +660,8 @@ integer function test_flush_movie_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) + type(taglist_t) :: tagNumbers + type(XYZlimit_t) :: dummySweep(6) type(XYZlimit_t) :: dummySinpmlSweep(6) type(XYZlimit_t) :: allocationRange(6) @@ -741,7 +749,7 @@ integer function test_flush_movie_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) - call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + call init_outputs(dummysgg, media, sinpml_fullsize, tagNumbers, dummyBound, dummyControl, & outputRequested, ThereAreWires) outputs => GetOutputs() @@ -827,6 +835,8 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) type(MediaData_t), allocatable, target :: simulationMaterials(:) type(MediaData_t), pointer :: simulationMaterialsPtr(:) + type(taglist_t) :: tagNumbers + type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) @@ -902,7 +912,7 @@ integer function test_init_frequency_slice_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) - call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + call init_outputs(dummysgg, media, sinpml_fullsize, tagNumbers, dummyBound, dummyControl, & outputRequested, ThereAreWires) outputs => GetOutputs() @@ -963,6 +973,8 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) type(limit_t), target :: sinpml_fullsize(6) type(limit_t), pointer :: sinpml_fullsizePtr(:) + type(taglist_t) :: tagNumbers + type(XYZlimit_t) :: dummySweep(6) type(XYZlimit_t) :: dummySinpmlSweep(6) type(XYZlimit_t) :: allocationRange(6) @@ -1033,7 +1045,7 @@ integer function test_update_frequency_slice_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) - call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + call init_outputs(dummysgg, media, sinpml_fullsize, tagNumbers, dummyBound, dummyControl, & outputRequested, ThereAreWires) outputs => GetOutputs() @@ -1107,6 +1119,8 @@ 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(taglist_t) :: tagNumbers + type(XYZlimit_t) :: dummySweep(6) type(XYZlimit_t) :: dummySinpmlSweep(6) type(XYZlimit_t) :: allocationRange(6) @@ -1189,7 +1203,7 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) - call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + call init_outputs(dummysgg, media, sinpml_fullsize, tagNumbers, dummyBound, dummyControl, & outputRequested, ThereAreWires) outputs => GetOutputs() From ad2fef327f7b7d468d8993f046b0d247fee30c78 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Fri, 20 Feb 2026 10:09:03 +0100 Subject: [PATCH 82/96] VTKAPI | #236 | Create vtkAPI for mapvtk output as a replacement for external submodule --- CMakeLists.txt | 2 + src_output/CMakeLists.txt | 9 +- src_output/vtkAPI.F90 | 356 +++++++++++++++++++++++++++++ test/CMakeLists.txt | 6 +- test/fdtd_tests.cpp | 2 +- test/output/CMakeLists.txt | 19 +- test/output/test_output.F90 | 4 +- test/output/test_vtkAPI.F90 | 396 +++++++++++++++++++++++++++++++++ test/output/vtkAPI_tests.cpp | 1 + test/output/vtkAPI_tests.h | 27 +++ test/utils/assertion_tools.F90 | 109 ++++++--- test/vtk/CMakeLists.txt | 18 -- test/vtk/test_vtk.F90 | 8 - test/vtk/vtk_tests.cpp | 1 - test/vtk/vtk_tests.h | 7 - 15 files changed, 884 insertions(+), 81 deletions(-) create mode 100644 src_output/vtkAPI.F90 create mode 100644 test/output/test_vtkAPI.F90 create mode 100644 test/output/vtkAPI_tests.cpp create mode 100644 test/output/vtkAPI_tests.h delete mode 100644 test/vtk/CMakeLists.txt delete mode 100644 test/vtk/test_vtk.F90 delete mode 100644 test/vtk/vtk_tests.cpp delete mode 100644 test/vtk/vtk_tests.h diff --git a/CMakeLists.txt b/CMakeLists.txt index cce65ca8..ad227d1e 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -219,6 +219,7 @@ if (SEMBA_FDTD_ENABLE_OUTPUT_MODULE) add_subdirectory(external/VTKFortran) add_subdirectory(src_output) set(OUTPUT_LIBRARIES fdtd-output) + set(VTK_API_LIBRARIES vtkAPI) endif() add_subdirectory(src_conformal) set(CONFORMAL_LIBRARIES conformal) @@ -295,6 +296,7 @@ if(SEMBA_FDTD_MAIN_LIB) semba-outputs fdtd-utils ${OUTPUT_LIBRARIES} + ${VTK_API_LIBRARIES} ${SMBJSON_LIBRARIES} ${MTLN_LIBRARIES}) endif() diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index 73ca99f6..aefb517c 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -12,9 +12,16 @@ add_library(fdtd-output "farFieldProbeOutput.F90" "mapVTKOutput.F90" ) +add_library(vtkAPI + "vtkAPI.F90" +) target_link_libraries(fdtd-output semba-types semba-components fdtd-utils VTKFortran::VTKFortran -) \ No newline at end of file +) +target_link_libraries(vtkAPI + fdtd-utils +) + diff --git a/src_output/vtkAPI.F90 b/src_output/vtkAPI.F90 new file mode 100644 index 00000000..8c058280 --- /dev/null +++ b/src_output/vtkAPI.F90 @@ -0,0 +1,356 @@ +module mod_vtkAPI + implicit none + private + public :: vtk_data_array, vtk_grid, vtk_structured_grid, vtk_unstructured_grid + + !========================== + ! Data array type + !========================== + type :: vtk_data_array + character(len=:), allocatable :: name + character(len=:), allocatable :: type + integer :: num_components + real, allocatable :: data(:) + end type vtk_data_array + + !========================== + ! Base abstract class + !========================== + type, abstract :: vtk_grid + real, allocatable :: points(:, :) + type(vtk_data_array), allocatable :: scalars(:) + type(vtk_data_array), allocatable :: vectors(:) + type(vtk_data_array), allocatable :: cell_scalars(:) + type(vtk_data_array), allocatable :: cell_vectors(:) + contains + procedure(add_points_generic), deferred :: add_points + procedure(add_scalar_generic), deferred :: add_scalar + procedure(add_vector_generic), deferred :: add_vector + procedure(add_cell_scalar_generic), deferred :: add_cell_scalar + procedure(add_cell_vector_generic), deferred :: add_cell_vector + procedure(write_file_generic), deferred :: write_file + end type vtk_grid + + !========================== + ! Structured Grid (VTS) + !========================== + type, extends(vtk_grid) :: vtk_structured_grid + integer :: nx = 0, ny = 0, nz = 0 + contains + procedure :: add_points => add_points_structured + procedure :: add_scalar => add_scalar_structured + procedure :: add_vector => add_vector_structured + procedure :: add_cell_scalar => add_cell_scalar_structured + procedure :: add_cell_vector => add_cell_vector_structured + procedure :: write_file => write_vts_file + end type vtk_structured_grid + + !========================== + ! Unstructured Grid (VTU) + !========================== + type, extends(vtk_grid) :: vtk_unstructured_grid + integer :: num_points = 0 + integer :: num_cells = 0 + integer, allocatable :: connectivity(:) + integer, allocatable :: offsets(:) + integer, allocatable :: types(:) + contains + procedure :: add_points => add_points_unstructured + procedure :: add_scalar => add_scalar_unstructured + procedure :: add_vector => add_vector_unstructured + procedure :: add_cell_scalar => add_cell_scalar_unstructured + procedure :: add_cell_vector => add_cell_vector_unstructured + procedure :: add_cell_connectivity + procedure :: write_file => write_vtu_file + end type vtk_unstructured_grid + + !========================== + ! Generic deferred interfaces + !========================== + abstract interface + subroutine add_points_generic(this, pts) + import :: vtk_grid + class(vtk_grid), intent(inout) :: this + real, intent(in) :: pts(:, :) + end subroutine add_points_generic + + subroutine add_scalar_generic(this, name, data) + import :: vtk_grid + class(vtk_grid), intent(inout) :: this + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + end subroutine add_scalar_generic + + subroutine add_vector_generic(this, name, data) + import :: vtk_grid + class(vtk_grid), intent(inout) :: this + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + end subroutine add_vector_generic + + subroutine add_cell_scalar_generic(this, name, data) + import :: vtk_grid + class(vtk_grid), intent(inout) :: this + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + end subroutine add_cell_scalar_generic + + subroutine add_cell_vector_generic(this, name, data) + import :: vtk_grid + class(vtk_grid), intent(inout) :: this + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + end subroutine add_cell_vector_generic + + subroutine write_file_generic(this, filename) + import :: vtk_grid + class(vtk_grid), intent(in) :: this + character(len=*), intent(in) :: filename + end subroutine write_file_generic + end interface + +contains + !========================== + !==== Structured Grid Methods ==== + !========================== + + subroutine add_points_structured(this, pts) + class(vtk_structured_grid), intent(inout) :: this + real, intent(in) :: pts(:, :) + integer :: npts + npts = this%nx*this%ny*this%nz + if (size(pts, 1) /= 3) error stop 'add_points_structured: first dim must be 3' + if (size(pts, 2) /= npts) error stop 'add_points_structured: wrong number of points' + if (allocated(this%points)) deallocate (this%points) + allocate (this%points(3, npts)) + this%points = pts + end subroutine add_points_structured + + subroutine add_scalar_structured(this, name, data) + class(vtk_structured_grid), intent(inout) :: this + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + call add_array_generic(this%scalars, name, data, 1) + end subroutine add_scalar_structured + + subroutine add_vector_structured(this, name, data) + class(vtk_structured_grid), intent(inout) :: this + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + call add_array_generic(this%vectors, name, data, 3) + end subroutine add_vector_structured + + subroutine add_cell_scalar_structured(this, name, data) + class(vtk_structured_grid), intent(inout) :: this + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + call add_array_generic(this%cell_scalars, name, data, 1) + end subroutine add_cell_scalar_structured + + subroutine add_cell_vector_structured(this, name, data) + class(vtk_structured_grid), intent(inout) :: this + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + call add_array_generic(this%cell_vectors, name, data, 3) + end subroutine add_cell_vector_structured + + !========================== + ! Write VTS + !========================== + subroutine write_vts_file(this, filename) + class(vtk_structured_grid), intent(in) :: this + character(len=*), intent(in) :: filename + integer :: iunit + open (newunit=iunit, file=filename, status='replace', action='write', form='formatted') + write (iunit, *) '' + write (iunit, *) ' ' + write (iunit, *) ' ' + call write_pointdata(iunit, this%scalars, this%vectors) + call write_celldata(iunit, this%cell_scalars, this%cell_vectors) + call write_points(iunit, this%points) + write (iunit, *) ' ' + write (iunit, *) ' ' + write (iunit, *) '' + close (iunit) + end subroutine write_vts_file + + !========================== + !==== Unstructured Grid Methods ==== + !========================== + subroutine add_points_unstructured(this, pts) + real, intent(in) :: pts(:, :) + class(vtk_unstructured_grid), intent(inout) :: this + if (size(pts, 1) /= 3) error stop 'add_points_unstructured: first dim must be 3' + this%num_points = size(pts, 2) + if (allocated(this%points)) deallocate (this%points) + allocate (this%points(3, this%num_points)) + this%points = pts + end subroutine add_points_unstructured + + subroutine add_scalar_unstructured(this, name, data) + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + class(vtk_unstructured_grid), intent(inout) :: this + call add_array_generic(this%scalars, name, data, 1) + end subroutine add_scalar_unstructured + + subroutine add_vector_unstructured(this, name, data) + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + class(vtk_unstructured_grid), intent(inout) :: this + call add_array_generic(this%vectors, name, data, 3) + end subroutine add_vector_unstructured + + subroutine add_cell_scalar_unstructured(this, name, data) + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + class(vtk_unstructured_grid), intent(inout) :: this + call add_array_generic(this%cell_scalars, name, data, 1) + end subroutine add_cell_scalar_unstructured + + subroutine add_cell_vector_unstructured(this, name, data) + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + class(vtk_unstructured_grid), intent(inout) :: this + call add_array_generic(this%cell_vectors, name, data, 3) + end subroutine add_cell_vector_unstructured + + subroutine add_cell_connectivity(this, conn, offsets, types) + class(vtk_unstructured_grid), intent(inout) :: this + integer, intent(in) :: conn(:), offsets(:), types(:) + this%num_cells = size(offsets) + if (allocated(this%connectivity)) deallocate (this%connectivity) + if (allocated(this%offsets)) deallocate (this%offsets) + if (allocated(this%types)) deallocate (this%types) + allocate (this%connectivity(size(conn))) + allocate (this%offsets(size(offsets))) + allocate (this%types(size(types))) + this%connectivity = conn + this%offsets = offsets + this%types = types + end subroutine add_cell_connectivity + + !========================== + ! Write VTU + !========================== + subroutine write_vtu_file(this, filename) + character(len=*), intent(in) :: filename + class(vtk_unstructured_grid), intent(in) :: this + integer :: iunit + open (newunit=iunit, file=filename, status='replace', action='write', form='formatted') + write (iunit, *) '' + write (iunit, *) ' ' + write (iunit, *) ' ' + call write_pointdata(iunit, this%scalars, this%vectors) + call write_celldata(iunit, this%cell_scalars, this%cell_vectors) + call write_cells(iunit, this%connectivity, this%offsets, this%types) + call write_points(iunit, this%points) + write (iunit, *) ' ' + write (iunit, *) ' ' + write (iunit, *) '' + close (iunit) + end subroutine write_vtu_file + +!========================== +!==== Shared helper routines ==== +!========================== + subroutine add_array_generic(array_list, name, data, ncomp) + type(vtk_data_array), allocatable, intent(inout) :: array_list(:) + character(len=*), intent(in) :: name + real, intent(in) :: data(:) + integer, intent(in) :: ncomp + type(vtk_data_array), allocatable :: tmp(:) + integer :: n + if (.not. allocated(array_list)) then + allocate (array_list(1)) + n = 1 + else + n = size(array_list) + 1 + allocate (tmp(n)) + tmp(1:n - 1) = array_list + call move_alloc(tmp, array_list) + end if + array_list(n)%name = name + array_list(n)%type = 'Float32' + array_list(n)%num_components = ncomp + array_list(n)%data = data + end subroutine add_array_generic + + subroutine write_pointdata(iunit, scalars, vectors) + integer, intent(in) :: iunit + type(vtk_data_array), allocatable, intent(in) :: scalars(:) + type(vtk_data_array), allocatable, intent(in) :: vectors(:) + integer :: i + write (iunit, *) ' ' + if (allocated(scalars)) then + do i = 1, size(scalars) + write (iunit, '(A)') ' ' + write (iunit, '(1000(F12.6,1X))') scalars(i)%data + write (iunit, '(A)') ' ' + end do + end if + if (allocated(vectors)) then + do i = 1, size(vectors) + write (iunit, '(A)') ' ' + write (iunit, '(1000(F12.6,1X))') vectors(i)%data + write (iunit, '(A)') ' ' + end do + end if + write (iunit, *) ' ' + end subroutine write_pointdata + + subroutine write_celldata(iunit, scalars, vectors) + integer, intent(in) :: iunit + type(vtk_data_array), allocatable, intent(in) :: scalars(:) + type(vtk_data_array), allocatable, intent(in) :: vectors(:) + integer :: i + if (.not. allocated(scalars) .and. .not. allocated(vectors)) then + write (iunit, *) ' ' + write (iunit, *) ' ' + return + end if + write (iunit, *) ' ' + if (allocated(scalars)) then + do i = 1, size(scalars) + write (iunit, '(A)') ' ' + write (iunit, '(1000(F12.6,1X))') scalars(i)%data + write (iunit, '(A)') ' ' + end do + end if + if (allocated(vectors)) then + do i = 1, size(vectors) + write (iunit, '(A)') ' ' + write (iunit, '(1000(F12.6,1X))') vectors(i)%data + write (iunit, '(A)') ' ' + end do + end if + write (iunit, *) ' ' + end subroutine write_celldata + + subroutine write_points(iunit, pts) + integer, intent(in) :: iunit + real, intent(in) :: pts(:, :) + write (iunit, *) ' ' + write (iunit, *) ' ' + write (iunit, '(1000(F12.6,1X))') pts + write (iunit, *) ' ' + write (iunit, *) ' ' + end subroutine write_points + + subroutine write_cells(iunit, conn, offsets, types) + integer, intent(in) :: iunit + integer, intent(in) :: conn(:), offsets(:), types(:) + write (iunit, *) ' ' + write (iunit, *) ' ' + write (iunit, '(1000(I8,1X))') conn + write (iunit, *) ' ' + write (iunit, *) ' ' + write (iunit, '(1000(I8,1X))') offsets + write (iunit, *) ' ' + write (iunit, *) ' ' + write (iunit, '(1000(I3,1X))') types + write (iunit, *) ' ' + write (iunit, *) ' ' + end subroutine write_cells + +end module mod_vtkAPI diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 233504d1..4e57caaf 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -21,12 +21,11 @@ if (SEMBA_FDTD_ENABLE_SMBJSON) set(SMBJSON_TESTS_LIBRARY smbjson_tests) add_subdirectory(rotate) set(ROTATE_TESTS_LIBRARY rotate_tests) - add_subdirectory(vtk) - set(VTK_TESTS_LIBRARY vtk_tests) if (SEMBA_FDTD_ENABLE_OUTPUT_MODULE) add_subdirectory(output) set(OUPUT_TESTS_LIBRARY output_tests) + set(VTK_API_TESTS_LIBRARY vtkAPI_tests) endif() if (NOT SEMBA_FDTD_ENABLE_MPI) @@ -50,7 +49,8 @@ target_link_libraries(fdtd_tests ${HDF_TESTS_LIBRARY} ${VTK_TESTS_LIBRARY} ${SYSTEM_TESTS_LIBRARY} - ${OBSERVATION_TESTS_LIBRARY} + ${VTK_API_TESTS_LIBRARY} ${OUPUT_TESTS_LIBRARY} + ${OBSERVATION_TESTS_LIBRARY} GTest::gtest_main ) \ No newline at end of file diff --git a/test/fdtd_tests.cpp b/test/fdtd_tests.cpp index b1675710..080f93f8 100644 --- a/test/fdtd_tests.cpp +++ b/test/fdtd_tests.cpp @@ -7,8 +7,8 @@ #ifdef CompileWithSMBJSON #include "smbjson/smbjson_tests.h" #include "rotate/rotate_tests.h" - #include "vtk/vtk_tests.h" #include "output/output_tests.h" + #include "output/vtkAPI_tests.h" #endif #ifndef CompileWithMPI #include "observation/observation_tests.h" diff --git a/test/output/CMakeLists.txt b/test/output/CMakeLists.txt index 03cc0733..59d9fb96 100644 --- a/test/output/CMakeLists.txt +++ b/test/output/CMakeLists.txt @@ -7,15 +7,28 @@ add_library( "test_volumic_utils.F90" ) +add_library( + vtkAPI_test_fortran + "test_vtkAPI.F90" +) + +add_library(output_tests "output_tests.cpp") +add_library(vtkAPI_tests "vtkAPI_tests.cpp") + target_link_libraries(output_test_fortran semba-outputs fdtd-output test_utils_fortran ) - -add_library(output_tests "output_tests.cpp") - target_link_libraries(output_tests output_test_fortran GTest::gtest +) +target_link_libraries(vtkAPI_test_fortran + vtkAPI + test_utils_fortran +) +target_link_libraries(vtkAPI_tests + vtkAPI_test_fortran + GTest::gtest ) \ No newline at end of file diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 958ff878..a090b4ec 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -170,13 +170,13 @@ integer function test_update_point_probe() bind(c) result(err) 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%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(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%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') !Cleanup diff --git a/test/output/test_vtkAPI.F90 b/test/output/test_vtkAPI.F90 new file mode 100644 index 00000000..f94514a7 --- /dev/null +++ b/test/output/test_vtkAPI.F90 @@ -0,0 +1,396 @@ +!============================== +! mod_vtkAPI extended testsuite (class-based) +!============================== + +!============================== +! Test 1: Structured grid basic allocation +!============================== +integer function test_vtkAPI_points_allocation() bind(C) result(error_cnt) + use mod_vtkAPI + implicit none + type(vtk_structured_grid), target :: grid + class(vtk_grid), pointer :: grid_base + real, allocatable :: points(:, :) + integer :: nx, ny, nz + + error_cnt = 0 + nx = 2; ny = 2; nz = 2 + grid%nx = nx; grid%ny = ny; grid%nz = nz + grid_base => grid + + allocate(points(3, nx*ny*nz)) + points = 0.0 + call grid_base%add_points(points) + + if (.not. allocated(grid%points)) error_cnt = error_cnt + 1 + if (size(grid%points,1) /= 3) error_cnt = error_cnt + 1 + if (size(grid%points,2) /= nx*ny*nz) error_cnt = error_cnt + 1 +end function + +!============================== +! Test 2: Point scalar assignment +!============================== +integer function test_vtkAPI_point_scalar() bind(C) result(error_cnt) + use mod_vtkAPI + implicit none + type(vtk_structured_grid), target :: grid + class(vtk_grid), pointer :: grid_base + real, allocatable :: scalars(:) + integer :: nx=2, ny=2, nz=2, i + + error_cnt = 0 + grid%nx=nx; grid%ny=ny; grid%nz=nz + grid_base => grid + + allocate(scalars(nx*ny*nz)) + do i=1,nx*ny*nz + scalars(i) = real(i) + end do + call grid_base%add_scalar('Density', scalars) + + if (.not. allocated(grid%scalars)) error_cnt = error_cnt + 1 + if (grid%scalars(1)%data(1) /= 1.0) error_cnt = error_cnt + 1 +end function + +!============================== +! Test 3: Point vector assignment +!============================== +integer function test_vtkAPI_point_vector() bind(C) result(error_cnt) + use mod_vtkAPI + implicit none + type(vtk_structured_grid), target :: grid + class(vtk_grid), pointer :: grid_base + real, allocatable :: vec(:) + integer :: nx=2, ny=2, nz=2, i + + error_cnt = 0 + grid%nx=nx; grid%ny=ny; grid%nz=nz + grid_base => grid + + allocate(vec(3*nx*ny*nz)) + do i=1,nx*ny*nz + vec(3*i-2) = real(i) + vec(3*i-1) = real(i*10) + vec(3*i) = real(i*100) + end do + call grid_base%add_vector('Momentum', vec) + + if (.not. allocated(grid%vectors)) error_cnt = error_cnt + 1 + if (grid%vectors(1)%data(2) /= 10.0) error_cnt = error_cnt + 1 +end function + +!============================== +! Test 4: Cell scalar assignment +!============================== +integer function test_vtkAPI_cell_scalar() bind(C) result(error_cnt) + use mod_vtkAPI + implicit none + type(vtk_structured_grid), target :: grid + class(vtk_grid), pointer :: grid_base + real, allocatable :: cell_data(:) + integer :: nx=2, ny=2, nz=2, n + + error_cnt = 0 + grid%nx=nx; grid%ny=ny; grid%nz=nz + grid_base => grid + + allocate(cell_data((nx-1)*(ny-1)*(nz-1))) + do n=1,(nx-1)*(ny-1)*(nz-1) + cell_data(n) = real(n) + end do + call grid_base%add_cell_scalar('Pressure', cell_data) + + if (.not. allocated(grid%cell_scalars)) error_cnt = error_cnt + 1 + if (grid%cell_scalars(1)%data(1) /= 1.0) error_cnt = error_cnt + 1 +end function + +!============================== +! Test 5: Cell vector assignment +!============================== +integer function test_vtkAPI_cell_vector() bind(C) result(error_cnt) + use mod_vtkAPI + implicit none + type(vtk_structured_grid), target :: grid + class(vtk_grid), pointer :: grid_base + real, allocatable :: vec(:) + integer :: nx=2, ny=2, nz=2, n + + error_cnt = 0 + grid%nx=nx; grid%ny=ny; grid%nz=nz + grid_base => grid + + allocate(vec(3*(nx-1)*(ny-1)*(nz-1))) + do n=1,(nx-1)*(ny-1)*(nz-1) + vec(3*n-2) = real(n) + vec(3*n-1) = real(n*10) + vec(3*n) = real(n*100) + end do + call grid_base%add_cell_vector('Flux', vec) + + if (.not. allocated(grid%cell_vectors)) error_cnt = error_cnt + 1 + if (grid%cell_vectors(1)%data(3) /= 100.0) error_cnt = error_cnt + 1 +end function + +!============================== +! Test 6: VTS file creation +!============================== +integer function test_vtkAPI_vts_file_creation() bind(C) result(error_cnt) + use mod_vtkAPI + use mod_directoryUtils + implicit none + type(vtk_structured_grid), target :: grid + class(vtk_grid), pointer :: grid_base + real, allocatable :: points(:, :), scalars(:) + integer :: nx=2, ny=2, nz=2 + integer :: ierr + character(len=14), parameter :: folder='testing_folder' + character(len=1024) :: file + + error_cnt = 0 + grid%nx=nx; grid%ny=ny; grid%nz=nz + grid_base => grid + + allocate(points(3, nx*ny*nz)); points = 0.0 + call grid_base%add_points(points) + + allocate(scalars(nx*ny*nz)); scalars = 1.0 + call grid_base%add_scalar('Density', scalars) + + file = join_path(folder, 'test.vts') + call create_folder(folder, ierr) + call grid_base%write_file(file) + + open(unit=10, file=file, status='old', action='read', iostat=ierr) + if (ierr /= 0) then + error_cnt = error_cnt + 1 + else + close(10) + end if + call remove_folder(folder, ierr) +end function + +!============================== +! Test 7: VTU file creation with cells and point data +!============================== +integer function test_vtkAPI_vtu_file_creation() bind(C) result(error_cnt) + use mod_vtkAPI + use mod_directoryUtils + implicit none + type(vtk_unstructured_grid), target :: ugrid + class(vtk_grid), pointer :: grid_base + real, allocatable :: points(:, :), scalars(:) + integer, allocatable :: conn(:), offsets(:), types(:) + integer :: ierr + character(len=14), parameter :: folder='testing_folder' + character(len=1024) :: file + + error_cnt = 0 + grid_base => ugrid + + ! Points + ugrid%num_points = 4 + allocate(points(3,4)) + points(:,1)=(/0.0,0.0,0.0/) + points(:,2)=(/1.0,0.0,0.0/) + points(:,3)=(/0.0,1.0,0.0/) + points(:,4)=(/0.0,0.0,1.0/) + call grid_base%add_points(points) + + ! Cells + allocate(conn(4)); conn = (/0,1,2,3/) + allocate(offsets(1)); offsets = (/4/) + allocate(types(1)); types = (/10/) + call ugrid%add_cell_connectivity(conn, offsets, types) + + ! Scalars + allocate(scalars(4)); scalars = (/1.0,2.0,3.0,4.0/) + call grid_base%add_scalar('Velocity', scalars) + + file = join_path(folder, 'test.vtu') + call create_folder(folder, ierr) + call grid_base%write_file(file) + + open(unit=10, file=file, status='old', action='read', iostat=ierr) + if (ierr /= 0) then + error_cnt = error_cnt + 1 + else + close(10) + end if + call remove_folder(folder, ierr) +end function + +!============================== +! Test 8: VTU file with cell data +!============================== +integer function test_vtkAPI_vtu_cell_data() bind(C) result(error_cnt) + use mod_vtkAPI + implicit none + type(vtk_unstructured_grid), target :: ugrid + class(vtk_grid), pointer :: grid_base + real, allocatable :: cell_scalars(:), cell_vectors(:) + integer, allocatable :: conn(:), offsets(:), types(:) + + error_cnt = 0 + grid_base => ugrid + + ! Cells + ugrid%num_cells = 1 + allocate(conn(4)); conn = (/0,1,2,3/) + allocate(offsets(1)); offsets = (/4/) + allocate(types(1)); types = (/10/) + call ugrid%add_cell_connectivity(conn, offsets, types) + + ! Cell scalar + allocate(cell_scalars(1)); cell_scalars(1) = 5.0 + call grid_base%add_cell_scalar('Pressure', cell_scalars) + if (ugrid%cell_scalars(1)%data(1) /= 5.0) error_cnt = error_cnt + 1 + + ! Cell vector + allocate(cell_vectors(3*1)); cell_vectors = (/1.0,2.0,3.0/) + call grid_base%add_cell_vector('Flux', cell_vectors) + if (ugrid%cell_vectors(1)%data(3) /= 3.0) error_cnt = error_cnt + 1 +end function + +!============================== +! Test 9: VerificaciĆ³n de VTS contenido +!============================== +integer function test_vtkAPI_vts_content() bind(C) result(error_cnt) + use mod_vtkAPI + use mod_directoryUtils + implicit none + type(vtk_structured_grid), target :: grid + class(vtk_grid), pointer :: grid_base + real, allocatable :: points(:, :), scalars(:), vectors(:) + integer :: nx=2, ny=2, nz=2 + integer :: ierr, i + character(len=14), parameter :: folder='testing_folder' + character(len=1024) :: file + character(len=256) :: line + logical :: found_scalar, found_vector + + error_cnt = 0 + grid%nx=nx; grid%ny=ny; grid%nz=nz + grid_base => grid + + ! Points + allocate(points(3, nx*ny*nz)); points=0.0 + call grid_base%add_points(points) + + ! Scalar + allocate(scalars(nx*ny*nz)) + do i=1,nx*ny*nz + scalars(i) = real(i) + end do + call grid_base%add_scalar('Density', scalars) + + ! Vector + allocate(vectors(3*nx*ny*nz)) + do i=1,nx*ny*nz + vectors(3*i-2) = real(i) + vectors(3*i-1) = real(i*10) + vectors(3*i) = real(i*100) + end do + call grid_base%add_vector('Momentum', vectors) + + ! Create VTS file + file = join_path(folder,'test_content.vts') + call create_folder(folder,ierr) + call grid_base%write_file(file) + + ! Read file and verify PointData + found_scalar = .false.; found_vector = .false. + open(unit=10, file=file, status='old', action='read', iostat=ierr) + if (ierr /= 0) then + error_cnt = error_cnt + 1 + return + end if + + do + read(10,'(A)', iostat=ierr) line + if (ierr /= 0) exit + if (index(line,'Scalars="Density"') /= 0) found_scalar = .true. + if (index(line,'Vectors="Momentum"') /= 0) found_vector = .true. + if (found_scalar .and. found_vector) exit + end do + close(10) + + if (.not. found_scalar) error_cnt = error_cnt + 1 + if (.not. found_vector) error_cnt = error_cnt + 1 + + call remove_folder(folder, ierr) +end function + +!============================== +! Test 10: VerificaciĆ³n de VTU contenido +!============================== +integer function test_vtkAPI_vtu_content() bind(C) result(error_cnt) + use mod_vtkAPI + use mod_directoryUtils + implicit none + type(vtk_unstructured_grid), target :: ugrid + class(vtk_grid), pointer :: grid_base + real, allocatable :: points(:, :), scalars(:), cell_scalars(:) + integer, allocatable :: conn(:), offsets(:), types(:) + integer :: ierr + character(len=14), parameter :: folder='testing_folder' + character(len=1024) :: file + character(len=256) :: line + logical :: found_point_scalar, found_cell_scalar, found_cells, found_points + + error_cnt = 0 + grid_base => ugrid + + ! Points + ugrid%num_points = 4 + allocate(points(3,4)) + points(:,1)=(/0.0,0.0,0.0/); points(:,2)=(/1.0,0.0,0.0/) + points(:,3)=(/0.0,1.0,0.0/); points(:,4)=(/0.0,0.0,1.0/) + call grid_base%add_points(points) + + ! Cells + ugrid%num_cells = 1 + allocate(conn(4)); conn=(/0,1,2,3/) + allocate(offsets(1)); offsets=(/4/) + allocate(types(1)); types=(/10/) + call ugrid%add_cell_connectivity(conn, offsets, types) + + ! Point scalar + allocate(scalars(4)); scalars=(/1.0,2.0,3.0,4.0/) + call grid_base%add_scalar('Velocity', scalars) + + ! Cell scalar + allocate(cell_scalars(1)); cell_scalars=(/5.0/) + call grid_base%add_cell_scalar('Pressure', cell_scalars) + + ! Create VTU file + file = join_path(folder,'test_content.vtu') + call create_folder(folder,ierr) + call grid_base%write_file(file) + + ! Read file + found_point_scalar = .false.; found_cell_scalar = .false. + found_cells = .false.; found_points = .false. + open(unit=10, file=file, status='old', action='read', iostat=ierr) + if (ierr /= 0) then + error_cnt = error_cnt + 1 + return + end if + + do + read(10,'(A)', iostat=ierr) line + if (ierr /= 0) exit + if (index(line,'PointData') /= 0) found_point_scalar = .true. + if (index(line,'CellData') /= 0) found_cell_scalar = .true. + if (index(line,'') /= 0) found_cells = .true. + if (index(line,'') /= 0) found_points = .true. + if (found_point_scalar .and. found_cell_scalar .and. found_cells .and. found_points) exit + end do + close(10) + + if (.not. found_point_scalar) error_cnt = error_cnt + 1 + if (.not. found_cell_scalar) error_cnt = error_cnt + 1 + if (.not. found_cells) error_cnt = error_cnt + 1 + if (.not. found_points) error_cnt = error_cnt + 1 + + call remove_folder(folder, ierr) +end function \ No newline at end of file diff --git a/test/output/vtkAPI_tests.cpp b/test/output/vtkAPI_tests.cpp new file mode 100644 index 00000000..01684e2b --- /dev/null +++ b/test/output/vtkAPI_tests.cpp @@ -0,0 +1 @@ +#include "vtkAPI_tests.h" \ No newline at end of file diff --git a/test/output/vtkAPI_tests.h b/test/output/vtkAPI_tests.h new file mode 100644 index 00000000..814c0944 --- /dev/null +++ b/test/output/vtkAPI_tests.h @@ -0,0 +1,27 @@ +#ifdef CompileWithNewOutputModule +#include + +extern "C" int test_vtkapi_points_allocation(); +extern "C" int test_vtkapi_point_scalar(); +extern "C" int test_vtkapi_point_vector(); +extern "C" int test_vtkapi_cell_scalar(); +extern "C" int test_vtkapi_cell_vector(); +extern "C" int test_vtkapi_vts_file_creation(); +extern "C" int test_vtkapi_vtu_file_creation(); +extern "C" int test_vtkapi_vtu_cell_data(); +extern "C" int test_vtkapi_vts_content(); +extern "C" int test_vtkapi_vtu_content(); + +TEST(vtkapi, test_points_allocation) {EXPECT_EQ(0, test_vtkapi_points_allocation());} +TEST(vtkapi, test_point_scalar) {EXPECT_EQ(0, test_vtkapi_point_scalar());} +TEST(vtkapi, test_point_vector) {EXPECT_EQ(0, test_vtkapi_point_vector());} +TEST(vtkapi, test_cell_scalar) {EXPECT_EQ(0, test_vtkapi_cell_scalar());} +TEST(vtkapi, test_cell_vector) {EXPECT_EQ(0, test_vtkapi_cell_vector());} +TEST(vtkapi, test_vts_file_creation) {EXPECT_EQ(0, test_vtkapi_vts_file_creation());} +TEST(vtkapi, test_vtu_file_creation) {EXPECT_EQ(0, test_vtkapi_vtu_file_creation());} +TEST(vtkapi, test_vtu_cell_data) {EXPECT_EQ(0, test_vtkapi_vtu_cell_data());} +TEST(vtkapi, test_vts_content) {EXPECT_EQ(0, test_vtkapi_vts_content());} +TEST(vtkapi, test_vtu_content) {EXPECT_EQ(0, test_vtkapi_vtu_content());} + + +#endif diff --git a/test/utils/assertion_tools.F90 b/test/utils/assertion_tools.F90 index b125187b..4a6051e4 100644 --- a/test/utils/assertion_tools.F90 +++ b/test/utils/assertion_tools.F90 @@ -1,9 +1,28 @@ module mod_assertionTools use FDETYPES use mod_arrayAssertionTools + use iso_fortran_env, only: real32, real64 implicit none + private :: assert_real_equal_impl + private :: assert_real_RKIND_equal_impl +#ifndef CompileWithReal8 + private :: assert_real_time_equal_impl +#endif + ! Generic interface for real assertions + interface assert_real_equal + module procedure assert_real_equal_impl + module procedure assert_real_RKIND_equal_impl +#ifndef CompileWithReal8 + module procedure assert_real_time_equal_impl +#endif + end interface + contains + + !--------------------------------------- + ! Logical assertion + !--------------------------------------- function assert_true(boolean, errorMessage) result(err) logical, intent(in) :: boolean character(*), intent(in) :: errorMessage @@ -15,13 +34,14 @@ function assert_true(boolean, errorMessage) result(err) print *, 'ASSERTION FAILED: ', trim(errorMessage) end if end function - function assert_integer_equal(val, expected, errorMessage) result(err) - integer, intent(in) :: val - integer, intent(in) :: expected + !--------------------------------------- + ! Integer equality + !--------------------------------------- + function assert_integer_equal(val, expected, errorMessage) result(err) + integer, intent(in) :: val, expected character(*), intent(in) :: errorMessage integer :: err - if (val == expected) then err = 0 else @@ -29,48 +49,58 @@ function assert_integer_equal(val, expected, errorMessage) result(err) 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) + end function - real(kind=rkind), intent(in) :: val - real(kind=rkind), intent(in) :: expected - real(kind=rkind), intent(in) :: tolerance + !--------------------------------------- + ! Real equality implementations + !--------------------------------------- + function assert_real_equal_impl(val, expected, tolerance, errorMessage) result(err) + real(real32), intent(in) :: val, expected, 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 + print *, 'ASSERTION FAILED (real32): ', 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) + end function - real(kind=RKIND_tiempo), intent(in) :: val - real(kind=RKIND_tiempo), intent(in) :: expected - real(kind=RKIND_tiempo), intent(in) :: tolerance + function assert_real_RKIND_equal_impl(val, expected, tolerance, errorMessage) result(err) + real(RKIND), intent(in) :: val, expected, tolerance character(*), intent(in) :: errorMessage integer :: err + if (abs(val - expected) <= tolerance) then + err = 0 + else + err = 1 + print *, 'ASSERTION FAILED (RKIND): ', trim(errorMessage) + print *, ' Value: ', val, '. Expected: ', expected, '. Tolerance: ', tolerance + end if + end function + function assert_real_time_equal_impl(val, expected, tolerance, errorMessage) result(err) + real(kind=RKIND_tiempo), intent(in) :: val, expected, 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 + print *, 'ASSERTION FAILED (time): ', trim(errorMessage) + print *, ' Value: ', val, '. Expected: ', expected, '. Tolerance: ', tolerance end if - end function assert_real_time_equal + end function + !--------------------------------------- + ! Complex equality + !--------------------------------------- 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 + character(len=*), intent(in) :: errorMessage integer :: err - if (abs(val - expected) <= tolerance) then err = 0 else @@ -81,15 +111,15 @@ function assert_complex_equal(val, expected, tolerance, errorMessage) result(err print *, ' Delta: ', abs(val - expected) print *, ' Tolerance:', tolerance end if - end function assert_complex_equal + end function + !--------------------------------------- + ! String equality + !--------------------------------------- function assert_string_equal(val, expected, errorMessage) result(err) - - character(*), intent(in) :: val - character(*), intent(in) :: expected + character(*), intent(in) :: val, expected character(*), intent(in) :: errorMessage integer :: err - if (trim(val) == trim(expected)) then err = 0 else @@ -97,18 +127,17 @@ function assert_string_equal(val, expected, errorMessage) result(err) print *, 'ASSERTION FAILED: ', trim(errorMessage) print *, ' Value: "', trim(val), '". Expected: "', trim(expected), '"' end if - end function assert_string_equal + end function + !--------------------------------------- + ! Check if file was written + !--------------------------------------- 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 @@ -116,10 +145,12 @@ integer function assert_written_output_file(filename) result(code) print *, "ERROR: Output file is empty:", trim(filename) code = 2 end if - end function assert_written_output_file + end function + !--------------------------------------- + ! Check file content + !--------------------------------------- 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 @@ -147,8 +178,11 @@ integer function assert_file_content(unit, expectedValues, nRows, nCols, toleran end if end do end do - end function assert_file_content + end function + !--------------------------------------- + ! Check file exists + !--------------------------------------- integer function assert_file_exists(fileName) result(err) character(len=*), intent(in) :: filename integer :: unit, ios @@ -157,4 +191,5 @@ integer function assert_file_exists(fileName) result(err) close (unit) if (ios /= 0) err = 1 end function + end module mod_assertionTools diff --git a/test/vtk/CMakeLists.txt b/test/vtk/CMakeLists.txt deleted file mode 100644 index 0d96a902..00000000 --- a/test/vtk/CMakeLists.txt +++ /dev/null @@ -1,18 +0,0 @@ -message(STATUS "Creating build system for test/vtk") - -add_library( - vtk_test_fortran - "test_vtk.F90" - -) - -target_link_libraries(vtk_test_fortran - semba-outputs -) - -add_library(vtk_tests "vtk_tests.cpp") - -target_link_libraries(vtk_tests - vtk_test_fortran - GTest::gtest -) \ No newline at end of file diff --git a/test/vtk/test_vtk.F90 b/test/vtk/test_vtk.F90 deleted file mode 100644 index 8821caf3..00000000 --- a/test/vtk/test_vtk.F90 +++ /dev/null @@ -1,8 +0,0 @@ -module test_vtk_m - use VTK - implicit none - contains - integer function test_init_vtk() bind(C) result(err) - err = 0 - end function test_init_vtk -end module \ No newline at end of file diff --git a/test/vtk/vtk_tests.cpp b/test/vtk/vtk_tests.cpp deleted file mode 100644 index 4f145344..00000000 --- a/test/vtk/vtk_tests.cpp +++ /dev/null @@ -1 +0,0 @@ -#include "vtk_tests.h" \ No newline at end of file diff --git a/test/vtk/vtk_tests.h b/test/vtk/vtk_tests.h deleted file mode 100644 index 77e9dc92..00000000 --- a/test/vtk/vtk_tests.h +++ /dev/null @@ -1,7 +0,0 @@ -#include - -//extern "C" int test_init_vtk(); - -//TEST(vtk, test_initialize_vtk) { EXPECT_EQ(0, test_init_vtk()); } - - From d98a95006f42e7ee338df9bb0e6a13dff28c769a Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 24 Feb 2026 10:41:29 +0100 Subject: [PATCH 83/96] Refactor flush handling in timestepping module and improve logging message formatting --- src_main_pub/timestepping.F90 | 34 ++++++++++++++++++-------------- src_output/outputTypes.F90 | 17 ++++++++-------- src_output/volumicProbeUtils.F90 | 8 ++++---- src_utils/logUtils.F90 | 12 +++++------ 4 files changed, 38 insertions(+), 33 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 0e1a1805..705df207 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -1849,21 +1849,13 @@ subroutine solver_run(this) Ex,Ey,Ez,this%everflushed,this%control%nentradaroot,this%control%maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) if (.not.this%parar) then !!! si es por parada se gestiona al final -!!!!! si esta hecho lo flushea todo pero poniendo de acuerdo a todos los mpi - do i=1,this%sgg%NumberRequest - if (this%sgg%Observation(i)%done.and.(.not.this%sgg%Observation(i)%flushed)) then - this%perform%flushXdmf=.true. - this%perform%flushVTK=.true. - endif - end do -#ifdef CompileWithMPI - call syncroniceFlushFlags(this%perform, ierr) -#endif -!!!!!!!!!!!! - if (this%perform%flushFIELDS) then + call request_flush_if_any_observation_is_done() + + if (this%perform%flushFIELDS) then call performFlushField() - endif - if (this%perform%isFlush()) then + endif + + if (this%perform%isFlush()) then ! flushFF=this%perform%postprocess if (this%thereAre%FarFields.and.flushFF) then @@ -1951,7 +1943,6 @@ subroutine solver_run(this) call MPI_Barrier(SUBCOMM_MPI,ierr) #endif endif !del if (this%performflushDATA.or.... - ! if (this%control%singlefilewrite.and.this%perform%Unpack) call singleUnpack() if ((this%control%singlefilewrite.and.this%perform%Unpack).or.this%perform%isFlush()) then write(dubuf,'(a,i9)') ' Continuing simulation at n= ',this%n @@ -1998,6 +1989,19 @@ subroutine solver_run(this) end do ciclo_temporal ! End of the time-stepping loop contains + + subroutine request_flush_if_any_observation_is_done() + do i=1,this%sgg%NumberRequest + if (this%sgg%Observation(i)%done.and.(.not.this%sgg%Observation(i)%flushed)) then + this%perform%flushXdmf=.true. + this%perform%flushVTK=.true. + endif + end do +#ifdef CompileWithMPI + call syncroniceFlushFlags(this%perform, ierr) +#endif + end subroutine + #ifdef CompileWithMPI subroutine syncroniceFlushFlags(performFlags, integerError) type(perform_t), intent(inout) :: performFlags diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 18bba416..a307330c 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -21,6 +21,7 @@ module outputTypes integer, parameter :: BOTH_DOMAIN = 2 + character(len=4), parameter :: binaryExtension = '.bin' character(len=4), parameter :: pvdExtension = '.pvd' character(len=4), parameter :: datFileExtension = '.dat' character(len=4), parameter :: vtkFileExtension = '.vtk' @@ -162,20 +163,20 @@ module outputTypes type, extends(abstract_time_probe_t) :: movie_probe_output_t type(cell_coordinate_t) :: auxCoords integer(kind=SINGLE) :: nPoints = -1 - integer(kind=SINGLE), allocatable :: coords(:, :) - real(kind=RKIND), allocatable :: xValueForTime(:, :) - real(kind=RKIND), allocatable :: yValueForTime(:, :) - real(kind=RKIND), allocatable :: zValueForTime(:, :) + integer(kind=SINGLE), allocatable :: coords(:, :) !(3, coordIdx) + real(kind=RKIND), allocatable :: xValueForTime(:, :) !(time, coordIdx) + real(kind=RKIND), allocatable :: yValueForTime(:, :) !(time, coordIdx) + real(kind=RKIND), allocatable :: zValueForTime(:, :) !(time, coordIdx) character(len=BUFSIZE) :: pvdPath end type movie_probe_output_t type, extends(abstract_frequency_probe_t) :: frequency_slice_probe_output_t type(cell_coordinate_t) :: auxCoords integer(kind=SINGLE) :: nPoints = -1 - integer(kind=SINGLE), allocatable :: coords(:, :) - complex(kind=CKIND), allocatable :: xValueForFreq(:, :) - complex(kind=CKIND), allocatable :: yValueForFreq(:, :) - complex(kind=CKIND), allocatable :: zValueForFreq(:, :) + integer(kind=SINGLE), allocatable :: coords(:, :) !(3, coordIdx) + complex(kind=CKIND), allocatable :: xValueForFreq(:, :) !(time, coordIdx) + complex(kind=CKIND), allocatable :: yValueForFreq(:, :) !(time, coordIdx) + complex(kind=CKIND), allocatable :: zValueForFreq(:, :) !(time, coordIdx) character(len=BUFSIZE) :: pvdPath end type frequency_slice_probe_output_t diff --git a/src_output/volumicProbeUtils.F90 b/src_output/volumicProbeUtils.F90 index 8db59a66..4a6f37a9 100644 --- a/src_output/volumicProbeUtils.F90 +++ b/src_output/volumicProbeUtils.F90 @@ -46,9 +46,9 @@ subroutine count_required_coords(lowerBound, upperBound, requestComponent, probl 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 + do j = lowerBound%y, upperBound%y + do i = lowerBound%x, upperBound%x if (checker(component, i, j, k, problemInfo)) count = count + 1 end do end do @@ -68,9 +68,9 @@ subroutine store_required_coords(lowerBound, upperBound, requestComponent, probl 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 + do j = lowerBound%y, upperBound%y + do i = lowerBound%x, upperBound%x if (checker(component, i, j, k, problemInfo)) then count = count + 1 coords(1, count) = i diff --git a/src_utils/logUtils.F90 b/src_utils/logUtils.F90 index b1e2259e..6fb0bbc8 100644 --- a/src_utils/logUtils.F90 +++ b/src_utils/logUtils.F90 @@ -11,12 +11,12 @@ subroutine printMessage(layoutNumber, message) ! Print into console if (printea) then - write (*, '(a)') adjustl(message) + write (*, '(a)') trim(adjustl(message)) end if ! Print into unitFile 11 if (layoutnumber == 0) then - write (11, '(a)') adjustl(message) + write (11, '(a)') trim(adjustl(message)) end if end subroutine printMessage @@ -32,14 +32,14 @@ subroutine printMessageWithSeparator(layoutnumber, message) ! Print into console if (printea) then write (*, '(a)') SEPARADOR - write (*, '(a)') adjustl(message) + write (*, '(a)') trim(adjustl(message)) write (*, '(a)') SEPARADOR end if ! Print into unitFile 11 if (layoutnumber == 0) then write (11, '(a)') SEPARADOR - write (11, '(a)') adjustl(message) + write (11, '(a)') trim(adjustl(message)) write (11, '(a)') SEPARADOR end if @@ -57,14 +57,14 @@ subroutine printMessageWithEndingSeparator(layoutNumber, message) ! Print into console if (printea) then write (*, '(a)') SEPARADOR - write (*, '(a)') adjustl(message) + write (*, '(a)') trim(adjustl(message)) write (*, '(a)') SEPARADOR end if ! Print into unitFile 11 if (layoutnumber == 0) then write (11, '(a)') SEPARADOR - write (11, '(a)') adjustl(message) + write (11, '(a)') trim(adjustl(message)) write (11, '(a)') SEPARADOR end if end subroutine printMessageWithEndingSeparator From 697eaf487601c6e6d72a1f34fae471de08127d9c Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 24 Feb 2026 13:07:40 +0100 Subject: [PATCH 84/96] Added create unstructure logic --- src_main_pub/observation.F90 | 4 +- src_output/movieProbeOutput.F90 | 71 ++++++++++++----- src_output/outputTypes.F90 | 4 + src_output/volumicProbeUtils.F90 | 132 +++++++++++++++++++++++++++++++ test/output/test_vtkAPI.F90 | 2 +- 5 files changed, 192 insertions(+), 21 deletions(-) diff --git a/src_main_pub/observation.F90 b/src_main_pub/observation.F90 index 451031a2..b65b1b9f 100755 --- a/src_main_pub/observation.F90 +++ b/src_main_pub/observation.F90 @@ -1791,13 +1791,13 @@ subroutine InitObservation(sgg, media, tag_numbers, & if ((SGG%Observation(ii)%TimeDomain) .and. (sgg%observation(ii)%P(1)%what /= mapvtk)) then ! read (output(ii)%item(i)%unit) ndum - if (output(ii)%item(i)%columnas /= ndum) call stoponerror(layoutnumber, size, 'BUGGYError reading resuming files () ') + if (output(ii)%item(i)%columnas /= ndum) call stoponerror(layoutnumber, size, 'BUGGYError reading resuming files () ') do conta = 1, output(ii)%item(i)%columnas read (output(ii)%item(i)%unit) ndum, ndum, ndum, ndum, ndum end do cutting3: do read (output(ii)%item(i)%unit, end=699) at - if (output(ii)%item(i)%columnas /= 0) read (output(ii)%item(i)%unit, end=699) (rdum, conta=1, output(ii)%item(i)%columnas) + if (output(ii)%item(i)%columnas /= 0) read (output(ii)%item(i)%unit, end=699) (rdum, conta=1, output(ii)%item(i)%columnas) output(ii)%TimesWritten = output(ii)%TimesWritten + 1 if (at > lastexecutedtime) then print '(i4,a,a,2e19.9e3)', quienmpi, 'Cutting 3 ', trim(adjustl(output(ii)%item(i)%path)), at, lastexecutedtime diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 47604426..a35c804f 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -53,24 +53,15 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, this%pvdPath = join_path(this%path, pdvFileName) call create_folder(this%path, error) + call create_file_with_path(add_extension(this%path, binaryExtension), 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) ! 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 - call StopOnError(control%layoutnumber, control%size, "Unexpected output type for movie probe") - end if end subroutine init_movie_probe_output subroutine update_movie_probe_output(this, step, fieldsReference, control, problemInfo) @@ -136,6 +127,8 @@ subroutine flush_movie_probe_output(this) type(movie_probe_output_t), intent(inout) :: this integer :: i + call write_bin_file(this) + do i = 1, this%nTime call update_pvd(this, i, this%pvdPath) end do @@ -147,6 +140,48 @@ end subroutine flush_movie_probe_output ! Private routines !=========================== + subroutine write_bin_file(this) + type(movie_probe_output_t), intent(inout) :: this + integer :: i, t, unit + + open(unit=unit, file=add_extension(this%path, binaryExtension), & + status='old', form='unformatted', position='append', access='stream') + do t=1, this%nTime + do i=1, this%nPoints + write(unit) this%timeStep(t), this%coords(1,i), this%coords(2,i), this%coords(3,i), this%xValueForTime(t,i), this%yValueForTime(t,i), this%zValueForTime(t,i) + end do + end do + close(unit) + call read_bin_file(this) + end subroutine + + subroutine read_bin_file(this) + type(movie_probe_output_t), intent(inout) :: this + integer :: unit + integer :: iostat + real(kind=RKIND_tiempo) timeStamp + integer(kind=SINGLE) :: x, y, z + real(kind=RKIND) :: xVal, yVal, zVal + integer(kind=4) :: dataSize + + ! Open the file for reading + open(unit=unit, file=add_extension(this%path, binaryExtension), & + status='old', form='unformatted', access='stream', iostat=iostat) + if (iostat /= 0) then + print *, 'Error opening file!' + return + end if + + ! Read until end-of-file + do + read(unit, iostat=iostat) timeStamp, x, y, z, xVal, yVal, zVal + if (iostat /= 0) exit ! EOF or error + print *, timeStamp, x, y, z, xVal, yVal, zVal + end do + + close(unit) + end subroutine + function get_output_path(this, outputTypeExtension, field, mpidir) result(path) type(movie_probe_output_t), intent(in) :: this character(len=*), intent(in) :: outputTypeExtension @@ -168,9 +203,9 @@ subroutine save_current_module(this, fieldsReference, 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 do k = this%mainCoords%z, this%auxCoords%z + do j = this%mainCoords%y, this%auxCoords%y + do i = this%mainCoords%x, this%auxCoords%x if (isValidPointForCurrent(iCur, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 call save_current(this%xValueForTime, this%nTime, coordIdx, iEx, i, j, k, fieldsReference) @@ -193,9 +228,9 @@ subroutine save_current_component(this, currentData, fieldsReference, simTime, p 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 + do j = this%mainCoords%y, this%auxCoords%y + do i = this%mainCoords%x, this%auxCoords%x if (isValidPointForCurrent(fieldDir, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 call save_current(currentData, this%nTime, coordIdx, fieldDir, i, j, k, fieldsReference) @@ -223,9 +258,9 @@ subroutine save_field_module(this, field, request, 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 do k = this%mainCoords%z, this%auxCoords%z + do j = this%mainCoords%y, this%auxCoords%y + do i = this%mainCoords%x, this%auxCoords%x if (isValidPointForField(request, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 call save_field(this%xValueForTime, this%nTime, coordIdx, field%x(i,j,k)) @@ -248,9 +283,9 @@ subroutine save_field_component(this, fieldData, fieldComponent, simTime, proble 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 + do j = this%mainCoords%y, this%auxCoords%y + do i = this%mainCoords%x, this%auxCoords%x if (isValidPointForField(fieldDir, i, j, k, problemInfo)) then coordIdx = coordIdx + 1 call save_field(fieldData, this%nTime, coordIdx, fieldComponent(i,j,k)) diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index a307330c..7401de5f 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -120,6 +120,7 @@ module outputTypes type, extends(abstract_probe_t) :: mapvtk_output_t type(cell_coordinate_t) :: auxCoords integer(kind=SINGLE), allocatable :: coords(:, :) + integer(kind=SINGLE), allocatable :: currentType(:) integer(kind=SINGLE), allocatable :: materialTag(:) integer :: nPoints = -1 end type mapvtk_output_t @@ -148,6 +149,7 @@ module outputTypes end type wire_current_probe_output_t type, extends(abstract_time_probe_t) :: bulk_current_probe_output_t + !Binary format: timeStamp, Val. Total register size: 16 type(cell_coordinate_t) :: auxCoords real(kind=RKIND), allocatable :: valueForTime(:) end type bulk_current_probe_output_t @@ -161,6 +163,7 @@ module outputTypes end type far_field_probe_output_t type, extends(abstract_time_probe_t) :: movie_probe_output_t + !Binary format: timeStamp, x, y, z, xVal, yVal, zVal. Total register size: 44 type(cell_coordinate_t) :: auxCoords integer(kind=SINGLE) :: nPoints = -1 integer(kind=SINGLE), allocatable :: coords(:, :) !(3, coordIdx) @@ -171,6 +174,7 @@ module outputTypes end type movie_probe_output_t type, extends(abstract_frequency_probe_t) :: frequency_slice_probe_output_t + !Binary format: frequencySlice, x, y, z, xVal, yVal, zVal. Total register size: 44 type(cell_coordinate_t) :: auxCoords integer(kind=SINGLE) :: nPoints = -1 integer(kind=SINGLE), allocatable :: coords(:, :) !(3, coordIdx) diff --git a/src_output/volumicProbeUtils.F90 b/src_output/volumicProbeUtils.F90 index 4a6f37a9..3c769865 100644 --- a/src_output/volumicProbeUtils.F90 +++ b/src_output/volumicProbeUtils.F90 @@ -82,6 +82,138 @@ subroutine store_required_coords(lowerBound, upperBound, requestComponent, probl end do end subroutine store_required_coords + subroutine createUnstructuredDataForVTU(counter, coords, currentType, materialTag, Nodes, Edges, Quads, numNodes, numEdges, numQuads) + integer, intent(in) :: counter + integer(kind=SINGLE), intent(in) :: coords(:, :), currentType(:), materialTag(:) + + integer(kind=4), intent(out):: numNodes, numQuads, numEdges + real(kind=RKIND), allocatable, dimension(:, :), intent(out) :: Nodes + integer(kind=4), allocatable, dimension(:, :), intent(out) :: Edges, Quads + + if (counter /= 0) then + Allocate (Nodes(3, counter)) + else + return + end if + + call countElements(counter, currentType, numEdges, numQuads) + + allocate (Edges(2, numEdges)) + allocate (Quads(4, numQuads)) + allocate (Nodes(3, counter*(numEdges + numQuads))) + + call registerElements(counter, coords, currentType, Nodes, Edges, Quads) + + end subroutine + + subroutine registerNode(nodes, nodeIx, x, y, z) + real(kind=RKIND), dimension(:, :), intent(inout) :: nodes + integer(kind=SINGLE), intent(in) :: nodeIx, x, y, z + + nodes(1, nodeIx) = x*1.0_RKIND + nodes(2, nodeIx) = y*1.0_RKIND + nodes(3, nodeIx) = z*1.0_RKIND + end subroutine + + subroutine registerEdge(edges, edgeIdx, startNodeIdx, endNodeIdx) + integer(kind=SINGLE), dimension(:, :), intent(inout) :: edges + integer(kind=SINGLE), intent(in) :: edgeIdx, startNodeIdx, endNodeIdx + + edges(1, edgeIdx) = startNodeIdx + edges(2, edgeIdx) = endNodeIdx + end subroutine + + subroutine registerQuad(quads, quadIdx, firstNodeIdx, secondNodeIdx, thirdNodeIdx, fourthNodeIdx) + integer(kind=SINGLE), dimension(:, :), intent(inout) :: quads + integer(kind=SINGLE), intent(in) :: quadIdx, firstNodeIdx, secondNodeIdx, thirdNodeIdx, fourthNodeIdx + + quads(1, quadIdx) = firstNodeIdx + quads(2, quadIdx) = secondNodeIdx + quads(2, quadIdx) = thirdNodeIdx + quads(2, quadIdx) = fourthNodeIdx + end subroutine + + subroutine countElements(counter, currentType, numEdges, numQuads) + integer, intent(in) :: counter + integer(kind=SINGLE), intent(in) :: currentType(:) + integer(kind=4), intent(out) :: numEdges, numQuads + integer :: i + + numEdges = 0 + numQuads = 0 + + do i = 1, counter + if ((currentType(i) == iJx) .or. (currentType(i) == iJy) .or. (currentType(i) == iJz)) numEdges = numEdges + 1 + if ((currentType(i) == iBloqueJx) .or. (currentType(i) == iBloqueJy) .or. (currentType(i) == iBloqueJz)) numQuads = numQuads + 1 + end do + end subroutine + + subroutine registerElements(counter, coords, currentType, Nodes, Edges, Quads) + integer, intent(in) :: counter + integer(kind=SINGLE), intent(in) :: coords(:, :), currentType(:) + real(kind=RKIND), intent(inout) :: Nodes(:, :) + integer(kind=4), intent(inout) :: Edges(:, :), Quads(:, :) + + integer :: nodeIdx, quadIdx, edgeIdx + integer :: i + + nodeIdx = 0 + quadIdx = 0 + edgeIdx = 0 + + do i = 1, counter + select case (currentType(i)) + case (iJx) + nodeIdx = nodeIdx + 2 + call registerNode(Nodes, nodeIdx - 1, coords(1, i) , coords(2, i), coords(3, i) ) + call registerNode(Nodes, nodeIdx , coords(1, i) + 1, coords(2, i), coords(3, i) ) + edgeIdx = edgeIdx + 1 + call registerEdge(Edges, edgeIdx, nodeIdx - 1, nodeIdx) + + case (iJy) + nodeIdx = nodeIdx + 2 + call registerNode(Nodes, nodeIdx - 1, coords(1, i), coords(2, i) , coords(3, i) ) + call registerNode(Nodes, nodeIdx , coords(1, i), coords(2, i) + 1, coords(3, i) ) + edgeIdx = edgeIdx + 1 + call registerEdge(Edges, edgeIdx, nodeIdx - 1, nodeIdx) + + case (iJz) + nodeIdx = nodeIdx + 2 + call registerNode(Nodes, nodeIdx - 1, coords(1, i), coords(2, i) , coords(3, i) ) + call registerNode(Nodes, nodeIdx , coords(1, i), coords(2, i) , coords(3, i) + 1) + edgeIdx = edgeIdx + 1 + call registerEdge(Edges, edgeIdx, nodeIdx - 1, nodeIdx) + + case (iBloqueJx) + nodeIdx = nodeIdx + 4 + call registerNode(Nodes, nodeIdx - 3, coords(1, i), coords(2, i) , coords(3, i) ) + call registerNode(Nodes, nodeIdx - 2, coords(1, i), coords(2, i) + 1, coords(3, i) ) + call registerNode(Nodes, nodeIdx - 1, coords(1, i), coords(2, i) + 1, coords(3, i) + 1) + call registerNode(Nodes, nodeIdx , coords(1, i), coords(2, i) , coords(3, i) + 1) + quadIdx = quadIdx + 1 + call registerQuad(Quads, quadIdx, nodeIdx - 3, nodeIdx - 2, nodeIdx - 1, nodeIdx) + + case (iBloqueJy) + nodeIdx = nodeIdx + 4 + call registerNode(Nodes, nodeIdx - 3, coords(1, i) , coords(2, i), coords(3, i) ) + call registerNode(Nodes, nodeIdx - 2, coords(1, i) + 1, coords(2, i), coords(3, i) ) + call registerNode(Nodes, nodeIdx - 1, coords(1, i) + 1, coords(2, i), coords(3, i) + 1) + call registerNode(Nodes, nodeIdx , coords(1, i) , coords(2, i), coords(3, i) + 1) + quadIdx = quadIdx + 1 + call registerQuad(Quads, quadIdx, nodeIdx - 3, nodeIdx - 2, nodeIdx - 1, nodeIdx) + + case (iBloqueJz) + nodeIdx = nodeIdx + 4 + call registerNode(Nodes, nodeIdx - 3, coords(1, i) , coords(2, i) , coords(3, i)) + call registerNode(Nodes, nodeIdx - 2, coords(1, i) + 1, coords(2, i) , coords(3, i)) + call registerNode(Nodes, nodeIdx - 1, coords(1, i) + 1, coords(2, i) + 1, coords(3, i)) + call registerNode(Nodes, nodeIdx , coords(1, i) , coords(2, i) + 1, coords(3, i)) + quadIdx = quadIdx + 1 + call registerQuad(Quads, quadIdx, nodeIdx - 3, nodeIdx - 2, nodeIdx - 1, nodeIdx) + end select + end do + end subroutine + subroutine get_checker_and_component(request, checker, component) integer(kind=SINGLE), intent(in) :: request procedure(logical_func), pointer, intent(out) :: checker diff --git a/test/output/test_vtkAPI.F90 b/test/output/test_vtkAPI.F90 index f94514a7..ca9e831d 100644 --- a/test/output/test_vtkAPI.F90 +++ b/test/output/test_vtkAPI.F90 @@ -354,7 +354,7 @@ integer function test_vtkAPI_vtu_content() bind(C) result(error_cnt) allocate(types(1)); types=(/10/) call ugrid%add_cell_connectivity(conn, offsets, types) - ! Point scalar + ! Point scalarll allocate(scalars(4)); scalars=(/1.0,2.0,3.0,4.0/) call grid_base%add_scalar('Velocity', scalars) From 4f3921626e1ed7e298998dec316e6b5d8d60e612 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 24 Feb 2026 14:48:08 +0100 Subject: [PATCH 85/96] Refactor VTK output handling to support unstructured grid format and update related utilities --- src_output/mapVTKOutput.F90 | 86 ++++++++++++++------------------ src_output/outputTypes.F90 | 1 + src_output/volumicProbeUtils.F90 | 5 +- 3 files changed, 41 insertions(+), 51 deletions(-) diff --git a/src_output/mapVTKOutput.F90 b/src_output/mapVTKOutput.F90 index fdfc3993..7ebd98c6 100644 --- a/src_output/mapVTKOutput.F90 +++ b/src_output/mapVTKOutput.F90 @@ -5,6 +5,8 @@ module mod_mapVTKOutput use vtk_fortran use mod_directoryUtils use mod_allocationUtils + use mod_vtkAPI + use mod_volumicProbeUtils use Report implicit none @@ -110,39 +112,54 @@ subroutine writeFaceTagInfo(this, counter, i, j, k, tag) this%materialTag(counter) = tag end subroutine - subroutine create_geometry_simulation_vtk(this, problemInfo, control) + subroutine create_geometry_simulation_vtu(this, control) implicit none type(mapvtk_output_t), intent(in) :: this - type(problem_info_t), intent(in) :: problemInfo type(sim_control_t), intent(in) :: control type(vtk_file) :: vtkOutput + type(vtk_unstructured_grid), target :: ugrid integer :: ierr, i, npts, unit real(RKIND), allocatable :: x(:), y(:), z(:), materialTag(:) character(len=BUFSIZE) :: info_str - character(len=BUFSIZE) :: metadata_filename, vtkPath + character(len=BUFSIZE) :: metadata_filename, vtuPath - !--------------------------------------------- - ! Initialize VTK file - !--------------------------------------------- - call create_folder(this%path, ierr) - vtkPath = join_path(this%path, get_last_component(this%path))//vtkFileExtension - ierr = vtkOutput%initialize(format='ASCII', filename=trim(vtkPath), mesh_topology='UnstructuredGrid') - if (ierr /= 0) call StopOnError(control%layoutnumber, control%size, 'Error initializing VTK') + integer, allocatable :: conn(:), offsets(:), types(:) + integer :: numNodes, numEdges, numQuads + real(kind=RKIND), allocatable :: nodes(:, :) + integer(kind=SINGLE), allocatable :: edges(:, :), quads(:, :) - !--------------------------------------------- - ! Points - !--------------------------------------------- - npts = this%nPoints - 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) + call create_folder(this%path, ierr) + vtuPath = join_path(this%path, get_last_component(this%path))//vtuFileExtension + + call createUnstructuredDataForVTU(this%nPoints, this%coords, this%currentType, nodes, edges, quads, numNodes, numEdges, numQuads) + call ugrid%add_points(nodes) + + allocate (conn(2*numEdges + 4*numQuads)) + conn(1:2*numEdges) = reshape(edges, [2*numEdges]) + conn(2*numEdges + 1:2*numEdges + 4*numQuads) = reshape(quads, [4*numQuads]) + + allocate (offsets(numEdges + numQuads)) + do i = 1, numEdges + if (i == 1) then + offsets(i) = 2 + else + offsets(i) = offsets(i - 1) + 2 + end if + end do + do i = 1, numQuads + offsets(numEdges + i) = offsets(numEdges + i - 1) + 4 end do + allocate(types(numEdges+numQuads)) + types(1:numEdges) = 3 + types(numEdges+1:numEdges+numQuads) = 9 + + call ugrid%add_cell_connectivity(conn, offsets, types) + call ugrid%write_file(vtuPath) + !--------------------------------------------- ! Metadata: write to .txt file !--------------------------------------------- @@ -150,7 +167,6 @@ subroutine create_geometry_simulation_vtk(this, problemInfo, control) 'WIRE=7, WIRE-COLISION=8, COMPO=3, DISPER=1, DIEL=2, SLOT=4, '// & 'CONF=5/6, OTHER=-1 (ADD +0.5 for borders)' - ! Create .txt file with same base name as VTK file metadata_filename = trim(this%path)//'.txt' open (newunit=unit, file=metadata_filename, status='replace', action='write', iostat=ierr) if (ierr /= 0) then @@ -160,35 +176,7 @@ subroutine create_geometry_simulation_vtk(this, problemInfo, control) close (unit) end if - !--------------------------------------------- - ! Write geometry to VTK - !--------------------------------------------- - ierr = vtkOutput%xml_writer%write_geo(n=npts, x=x, y=y, z=z) - - !--------------------------------------------- - ! Node data: material tags - !--------------------------------------------- - allocate (materialTag(npts)) - do i = 1, npts - materialTag(i) = this%materialTag(i) - end do - - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='open') - ierr = vtkOutput%xml_writer%write_dataarray(data_name='TagNumber', x=materialTag) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - - !--------------------------------------------- - ! Clean up - !--------------------------------------------- - deallocate (materialTag) - deallocate (x, y, z) - - !--------------------------------------------- - ! Finalize VTK file - !--------------------------------------------- - ierr = vtkOutput%xml_writer%finalize() - - end subroutine create_geometry_simulation_vtk + end subroutine create_geometry_simulation_vtu end module mod_mapVTKOutput diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 7401de5f..65c8c00c 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -25,6 +25,7 @@ module outputTypes character(len=4), parameter :: pvdExtension = '.pvd' character(len=4), parameter :: datFileExtension = '.dat' character(len=4), parameter :: vtkFileExtension = '.vtk' + character(len=4), parameter :: vtuFileExtension = '.vtu' character(len=2), parameter :: timeExtension = 'tm' character(len=2), parameter :: frequencyExtension = 'fq' character(len=1), parameter :: wordseparation = '_' diff --git a/src_output/volumicProbeUtils.F90 b/src_output/volumicProbeUtils.F90 index 3c769865..19ab24d0 100644 --- a/src_output/volumicProbeUtils.F90 +++ b/src_output/volumicProbeUtils.F90 @@ -10,6 +10,7 @@ module mod_volumicProbeUtils public :: find_and_store_important_coords public :: isValidPointForCurrent public :: isValidPointForField + public :: createUnstructuredDataForVTU abstract interface logical function logical_func(component, i, j, k, problemInfo) @@ -82,9 +83,9 @@ subroutine store_required_coords(lowerBound, upperBound, requestComponent, probl end do end subroutine store_required_coords - subroutine createUnstructuredDataForVTU(counter, coords, currentType, materialTag, Nodes, Edges, Quads, numNodes, numEdges, numQuads) + subroutine createUnstructuredDataForVTU(counter, coords, currentType, Nodes, Edges, Quads, numNodes, numEdges, numQuads) integer, intent(in) :: counter - integer(kind=SINGLE), intent(in) :: coords(:, :), currentType(:), materialTag(:) + integer(kind=SINGLE), intent(in) :: coords(:, :), currentType(:) integer(kind=4), intent(out):: numNodes, numQuads, numEdges real(kind=RKIND), allocatable, dimension(:, :), intent(out) :: Nodes From fd0b261697c2bab3b632a00099b0e96eb1b4d566 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 24 Feb 2026 16:23:16 +0100 Subject: [PATCH 86/96] Recover mapvtk funcionality from old observation module --- src_output/mapVTKOutput.F90 | 41 ++++++++++++++++++++++---------- src_output/output.F90 | 2 +- src_output/outputUtils.F90 | 14 +++++++++++ src_output/volumicProbeUtils.F90 | 36 +++++++++++++--------------- 4 files changed, 60 insertions(+), 33 deletions(-) diff --git a/src_output/mapVTKOutput.F90 b/src_output/mapVTKOutput.F90 index 7ebd98c6..43505316 100644 --- a/src_output/mapVTKOutput.F90 +++ b/src_output/mapVTKOutput.F90 @@ -72,6 +72,7 @@ subroutine store_relevant_coordinates(this, problemInfo) this%nPoints = counter call alloc_and_init(this%coords, 3, this%nPoints, -99) call alloc_and_init(this%materialTag, this%nPoints, -1) + call alloc_and_init(this%currentType, this%nPoints, -1) counter = 0 do k = this%mainCoords%Z, this%auxCoords%Z @@ -81,13 +82,13 @@ subroutine store_relevant_coordinates(this, problemInfo) if (isWithinBounds(Hfield, i, j, k, problemInfo)) then if (isMaterialExceptPML(Hfield, i, j, k, problemInfo)) then counter = counter + 1 - call writeFaceTagInfo(this, counter, i, j, k, problemInfo%materialTag%getFaceTag(Hfield, i, j, k)) + call writeFaceTagInfo(this, counter, i, j, k, Hfield, problemInfo%materialTag%getFaceTag(Hfield, i, j, k)) end if if (problemInfo%materialTag%getFaceTag(Hfield, i, j, k) < 0 & .and. (btest(iabs(problemInfo%materialTag%getFaceTag(Hfield, i, j, k)), Hfield - 1)) & .and. .not. isPML(Hfield, i, j, k, problemInfo)) then counter = counter + 1 - call writeFaceTagInfo(this, counter, i, j, k, problemInfo%materialTag%getFaceTag(Hfield, i, j, k)) + call writeFaceTagInfo(this, counter, i, j, k, Hfield, problemInfo%materialTag%getFaceTag(Hfield, i, j, k)) end if end if end do @@ -103,12 +104,13 @@ logical function isMaterialExceptPML(field, i, j, k, problemInfo) isMaterialExceptPML = isMaterialExceptPML .and. (.not. isPML(field, i, j, k, problemInfo)) end function isMaterialExceptPML - subroutine writeFaceTagInfo(this, counter, i, j, k, tag) + subroutine writeFaceTagInfo(this, counter, i, j, k, field, tag) type(mapvtk_output_t), intent(inout) :: this - integer, intent(in) :: i, j, k, counter, tag + integer, intent(in) :: i, j, k, counter, tag, field this%coords(1, counter) = i this%coords(2, counter) = j this%coords(3, counter) = k + this%currentType(counter) = currentType(field) this%materialTag(counter) = tag end subroutine @@ -135,29 +137,44 @@ subroutine create_geometry_simulation_vtu(this, control) vtuPath = join_path(this%path, get_last_component(this%path))//vtuFileExtension call createUnstructuredDataForVTU(this%nPoints, this%coords, this%currentType, nodes, edges, quads, numNodes, numEdges, numQuads) - call ugrid%add_points(nodes) + call ugrid%add_points(real(nodes, 4)) allocate (conn(2*numEdges + 4*numQuads)) conn(1:2*numEdges) = reshape(edges, [2*numEdges]) conn(2*numEdges + 1:2*numEdges + 4*numQuads) = reshape(quads, [4*numQuads]) allocate (offsets(numEdges + numQuads)) - do i = 1, numEdges - if (i == 1) then - offsets(i) = 2 + do i = 1, numEdges + numQuads + if (i <= numEdges) then + if (i == 1) then + offsets(i) = 2 + else + offsets(i) = offsets(i-1) + 2 + end if else - offsets(i) = offsets(i - 1) + 2 + if (i == 1) then + offsets(i) = 4 + else + offsets(i) = offsets(i-1) + 4 + end if end if end do - do i = 1, numQuads - offsets(numEdges + i) = offsets(numEdges + i - 1) + 4 - end do allocate(types(numEdges+numQuads)) types(1:numEdges) = 3 types(numEdges+1:numEdges+numQuads) = 9 call ugrid%add_cell_connectivity(conn, offsets, types) + if (size(offsets) /= numQuads) then + print *, "Problema con offsets" + end if + if (size(types) /= numQuads) then + print *, "Problema con types" + end if + if (offsets(numQuads) /= size(conn)) then + print *, "Tenemos un problema con conn y offset" + end if + call ugrid%write_file(vtuPath) !--------------------------------------------- diff --git a/src_output/output.F90 b/src_output/output.F90 index bab565d1..ba345aab 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -188,7 +188,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, materialTags, bounds, contr allocate (outputs(outputCount)%mapvtkOutput) call init_solver_output(outputs(outputCount)%mapvtkOutput, lowerBound, upperBound, outputRequestType, outputTypeExtension, control%mpidir, problemInfo) - call create_geometry_simulation_vtk(outputs(outputCount)%mapvtkOutput, problemInfo, control) + call create_geometry_simulation_vtu(outputs(outputCount)%mapvtkOutput, control) !! call adjust_computation_range --- Required due to issues in mpi region edges case (iEx, iEy, iEz, iHx, iHy, iHz) diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 40ab8c1c..5e84a213 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -31,6 +31,7 @@ module mod_outputUtils public :: computeJ2 public :: fieldo public :: create_data_file + public :: currentType !=========================== !=========================== @@ -575,6 +576,19 @@ integer function u(field1, field2) end if end function + integer function currentType(field) + integer(kind=4) :: field + select case (field) + case (iEx); currentType = iJx + case (iEy); currentType = iJy + case (iEz); currentType = iJz + case (iHx); currentType = iBloqueJx + case (iHy); currentType = iBloqueJy + case (iHz); currentType = iBloqueJz + case default; call StopOnError(0, 0, 'field is not a E or H field') + end select + end function + function get_field(field, i, j, k, fields_reference) result(res) implicit none real(kind=rkind) :: res diff --git a/src_output/volumicProbeUtils.F90 b/src_output/volumicProbeUtils.F90 index 19ab24d0..2408df58 100644 --- a/src_output/volumicProbeUtils.F90 +++ b/src_output/volumicProbeUtils.F90 @@ -91,47 +91,43 @@ subroutine createUnstructuredDataForVTU(counter, coords, currentType, Nodes, Edg real(kind=RKIND), allocatable, dimension(:, :), intent(out) :: Nodes integer(kind=4), allocatable, dimension(:, :), intent(out) :: Edges, Quads - if (counter /= 0) then - Allocate (Nodes(3, counter)) - else - return - end if + if (counter == 0) return call countElements(counter, currentType, numEdges, numQuads) allocate (Edges(2, numEdges)) allocate (Quads(4, numQuads)) - allocate (Nodes(3, counter*(numEdges + numQuads))) + allocate (Nodes(3, 2*numEdges + 4*numQuads)) call registerElements(counter, coords, currentType, Nodes, Edges, Quads) - + return end subroutine subroutine registerNode(nodes, nodeIx, x, y, z) real(kind=RKIND), dimension(:, :), intent(inout) :: nodes integer(kind=SINGLE), intent(in) :: nodeIx, x, y, z - - nodes(1, nodeIx) = x*1.0_RKIND - nodes(2, nodeIx) = y*1.0_RKIND - nodes(3, nodeIx) = z*1.0_RKIND + !We need to avoid using idx 0 + nodes(1, nodeIx + 1) = x*1.0_RKIND + nodes(2, nodeIx + 1) = y*1.0_RKIND + nodes(3, nodeIx + 1) = z*1.0_RKIND end subroutine subroutine registerEdge(edges, edgeIdx, startNodeIdx, endNodeIdx) integer(kind=SINGLE), dimension(:, :), intent(inout) :: edges integer(kind=SINGLE), intent(in) :: edgeIdx, startNodeIdx, endNodeIdx - edges(1, edgeIdx) = startNodeIdx - edges(2, edgeIdx) = endNodeIdx + edges(1, edgeIdx + 1) = startNodeIdx + edges(2, edgeIdx + 1) = endNodeIdx end subroutine subroutine registerQuad(quads, quadIdx, firstNodeIdx, secondNodeIdx, thirdNodeIdx, fourthNodeIdx) integer(kind=SINGLE), dimension(:, :), intent(inout) :: quads integer(kind=SINGLE), intent(in) :: quadIdx, firstNodeIdx, secondNodeIdx, thirdNodeIdx, fourthNodeIdx - quads(1, quadIdx) = firstNodeIdx - quads(2, quadIdx) = secondNodeIdx - quads(2, quadIdx) = thirdNodeIdx - quads(2, quadIdx) = fourthNodeIdx + quads(1, quadIdx + 1) = firstNodeIdx + quads(2, quadIdx + 1) = secondNodeIdx + quads(3, quadIdx + 1) = thirdNodeIdx + quads(4, quadIdx + 1) = fourthNodeIdx end subroutine subroutine countElements(counter, currentType, numEdges, numQuads) @@ -158,9 +154,9 @@ subroutine registerElements(counter, coords, currentType, Nodes, Edges, Quads) integer :: nodeIdx, quadIdx, edgeIdx integer :: i - nodeIdx = 0 - quadIdx = 0 - edgeIdx = 0 + nodeIdx = -1 + quadIdx = -1 + edgeIdx = -1 do i = 1, counter select case (currentType(i)) From f7b60a2a522907dbc06e0265781504b81f64c282 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 2 Mar 2026 13:51:31 +0100 Subject: [PATCH 87/96] Refactor output handling and enhance geometry simulation for VTK integration --- src_main_pub/timestepping.F90 | 2 +- src_output/mapVTKOutput.F90 | 194 +++++++++++++++++++++++++++---- src_output/movieProbeOutput.F90 | 4 +- src_output/output.F90 | 2 +- src_output/outputUtils.F90 | 70 ++++++++--- src_output/volumicProbeUtils.F90 | 115 +++++++++++++----- 6 files changed, 314 insertions(+), 73 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 705df207..c1a2b679 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -1868,7 +1868,6 @@ subroutine solver_run(this) 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 @@ -1941,6 +1940,7 @@ subroutine solver_run(this) #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif #endif endif !del if (this%performflushDATA.or.... if (this%control%singlefilewrite.and.this%perform%Unpack) call singleUnpack() diff --git a/src_output/mapVTKOutput.F90 b/src_output/mapVTKOutput.F90 index 43505316..547c2f20 100644 --- a/src_output/mapVTKOutput.F90 +++ b/src_output/mapVTKOutput.F90 @@ -14,7 +14,7 @@ module mod_mapVTKOutput subroutine init_mapvtk_output(this, lowerBound, upperBound, field, outputTypeExtension, mpidir, problemInfo) type(mapvtk_output_t), intent(out) :: this type(cell_coordinate_t), intent(in) :: lowerBound, upperBound - type(problem_info_t), intent(in) :: problemInfo + type(problem_info_t), target ,intent(in) :: problemInfo integer(kind=SINGLE), intent(in) :: mpidir, field character(len=BUFSIZE), intent(in) :: outputTypeExtension @@ -45,22 +45,27 @@ end subroutine init_mapvtk_output subroutine store_relevant_coordinates(this, problemInfo) type(mapvtk_output_t), intent(inout) :: this - type(problem_info_t), intent(in) :: problemInfo + type(problem_info_t), pointer, intent(in) :: problemInfo - integer :: i, j, k, Hfield, counter + integer :: i, j, k, field, counter counter = 0 do k = this%mainCoords%Z, this%auxCoords%Z do j = this%mainCoords%Y, this%auxCoords%Y do i = this%mainCoords%X, this%auxCoords%X - do Hfield = iHx, iHz - if (isWithinBounds(Hfield, i, j, k, problemInfo)) then - if (isMaterialExceptPML(Hfield, i, j, k, problemInfo)) then + do field = iEx, iEz + if (isEdge(field, i, j, k, problemInfo)) then + counter = counter + 1 + end if + end do + do field = iHx, iHz + if (isWithinBounds(field, i, j, k, problemInfo)) then + if (isMaterialExceptPML(field, i, j, k, problemInfo)) then counter = counter + 1 end if - if (problemInfo%materialTag%getFaceTag(Hfield, i, j, k) < 0 & - .and. (btest(iabs(problemInfo%materialTag%getFaceTag(Hfield, i, j, k)), Hfield - 1)) & - .and. (.not. isPML(Hfield, i, j, k, problemInfo))) then + if (problemInfo%materialTag%getFaceTag(field, i, j, k) < 0 & + .and. (btest(iabs(problemInfo%materialTag%getFaceTag(field, i, j, k)), field - 1)) & + .and. (.not. isPML(field, i, j, k, problemInfo))) then counter = counter + 1 end if end if @@ -78,17 +83,23 @@ subroutine store_relevant_coordinates(this, problemInfo) do k = this%mainCoords%Z, this%auxCoords%Z do j = this%mainCoords%Y, this%auxCoords%Y do i = this%mainCoords%X, this%auxCoords%X - do Hfield = iHx, iHz - if (isWithinBounds(Hfield, i, j, k, problemInfo)) then - if (isMaterialExceptPML(Hfield, i, j, k, problemInfo)) then + do field = iEx, iEz + if (isEdge(field, i, j, k, problemInfo)) then + counter = counter + 1 + call writeFaceTagInfo(this, counter, i, j, k, field, problemInfo%materialTag%getFaceTag(field, i, j, k)) + end if + end do + do field = iHx, iHz + if (isWithinBounds(field, i, j, k, problemInfo)) then + if (isMaterialExceptPML(field, i, j, k, problemInfo)) then counter = counter + 1 - call writeFaceTagInfo(this, counter, i, j, k, Hfield, problemInfo%materialTag%getFaceTag(Hfield, i, j, k)) + call writeFaceTagInfo(this, counter, i, j, k, field, problemInfo%materialTag%getFaceTag(field, i, j, k)) end if - if (problemInfo%materialTag%getFaceTag(Hfield, i, j, k) < 0 & - .and. (btest(iabs(problemInfo%materialTag%getFaceTag(Hfield, i, j, k)), Hfield - 1)) & - .and. .not. isPML(Hfield, i, j, k, problemInfo)) then + if (problemInfo%materialTag%getFaceTag(field, i, j, k) < 0 & + .and. (btest(iabs(problemInfo%materialTag%getFaceTag(field, i, j, k)), field - 1)) & + .and. .not. isPML(field, i, j, k, problemInfo)) then counter = counter + 1 - call writeFaceTagInfo(this, counter, i, j, k, Hfield, problemInfo%materialTag%getFaceTag(Hfield, i, j, k)) + call writeFaceTagInfo(this, counter, i, j, k, field, problemInfo%materialTag%getFaceTag(field, i, j, k)) end if end if end do @@ -114,11 +125,13 @@ subroutine writeFaceTagInfo(this, counter, i, j, k, field, tag) this%materialTag(counter) = tag end subroutine - subroutine create_geometry_simulation_vtu(this, control) + subroutine create_geometry_simulation_vtu(this, control, realXGrid, realYGrid, realZGrid) implicit none type(mapvtk_output_t), intent(in) :: this type(sim_control_t), intent(in) :: control + real(KIND=RKIND), pointer, dimension(:), intent(in) :: realXGrid, realYGrid, realZGrid + type(vtk_file) :: vtkOutput type(vtk_unstructured_grid), target :: ugrid @@ -132,11 +145,10 @@ subroutine create_geometry_simulation_vtu(this, control) real(kind=RKIND), allocatable :: nodes(:, :) integer(kind=SINGLE), allocatable :: edges(:, :), quads(:, :) - call create_folder(this%path, ierr) vtuPath = join_path(this%path, get_last_component(this%path))//vtuFileExtension - call createUnstructuredDataForVTU(this%nPoints, this%coords, this%currentType, nodes, edges, quads, numNodes, numEdges, numQuads) + call createUnstructuredDataForVTU(this%nPoints, this%coords, this%currentType, nodes, edges, quads, numNodes, numEdges, numQuads, control%vtkindex, realXGrid, realYGrid, realZGrid) call ugrid%add_points(real(nodes, 4)) allocate (conn(2*numEdges + 4*numQuads)) @@ -149,20 +161,20 @@ subroutine create_geometry_simulation_vtu(this, control) if (i == 1) then offsets(i) = 2 else - offsets(i) = offsets(i-1) + 2 + offsets(i) = offsets(i - 1) + 2 end if else if (i == 1) then offsets(i) = 4 else - offsets(i) = offsets(i-1) + 4 + offsets(i) = offsets(i - 1) + 4 end if end if end do - allocate(types(numEdges+numQuads)) + allocate (types(numEdges + numQuads)) types(1:numEdges) = 3 - types(numEdges+1:numEdges+numQuads) = 9 + types(numEdges + 1:numEdges + numQuads) = 9 call ugrid%add_cell_connectivity(conn, offsets, types) if (size(offsets) /= numQuads) then @@ -195,5 +207,139 @@ subroutine create_geometry_simulation_vtu(this, control) end subroutine create_geometry_simulation_vtu + logical function isEdge(campo, iii, jjj, kkk, problemInfo) + integer(4), intent(in) :: campo, iii, jjj, kkk + type(problem_info_t), pointer, intent(in) :: problemInfo + + type(MediaData_t), pointer, dimension(:) :: mData + type(limit_t), pointer, dimension(:) :: problemDimension + + integer(4) :: imed, imed1, imed2, imed3, imed4, contaborde + + mData => problemInfo%materialList + problemDimension => problemInfo%problemDimension + isEdge = .false. + contaborde = 0 + + call get_media_from_coord_and_h_neighbours(campo, iii, jjj, kkk, problemInfo%geometryToMaterialData, imed, imed1, imed2, imed3, imed4) + + if (imed /= 1) then + + if (mData(imed)%is%SGBC) then + + if (mData(imed1)%is%SGBC) then + if (trim(adjustl(mData(imed)%Multiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed1)%Multiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed1 /= 1) then + contaborde = contaborde + 1 + end if + + if (mData(imed2)%is%SGBC) then + if (trim(adjustl(mData(imed)%Multiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed2)%Multiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed2 /= 1) then + contaborde = contaborde + 1 + end if + + if (mData(imed3)%is%SGBC) then + if (trim(adjustl(mData(imed)%Multiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed3)%Multiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed3 /= 1) then + contaborde = contaborde + 1 + end if + + if (mData(imed4)%is%SGBC) then + if (trim(adjustl(mData(imed)%Multiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed4)%Multiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed4 /= 1) then + contaborde = contaborde + 1 + end if + + elseif (mData(imed)%is%Multiport) then + + if (mData(imed1)%is%Multiport) then + if (trim(adjustl(mData(imed)%Multiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed1)%Multiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed1 /= 1) then + contaborde = contaborde + 1 + end if + + if (mData(imed2)%is%Multiport) then + if (trim(adjustl(mData(imed)%Multiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed2)%Multiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed2 /= 1) then + contaborde = contaborde + 1 + end if + + if (mData(imed3)%is%Multiport) then + if (trim(adjustl(mData(imed)%Multiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed3)%Multiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed3 /= 1) then + contaborde = contaborde + 1 + end if + + if (mData(imed4)%is%Multiport) then + if (trim(adjustl(mData(imed)%Multiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed4)%Multiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed4 /= 1) then + contaborde = contaborde + 1 + end if + + elseif (mData(imed)%is%AnisMultiport) then + + if (mData(imed1)%is%AnisMultiport) then + if (trim(adjustl(mData(imed)%AnisMultiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed1)%AnisMultiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed1 /= 1) then + contaborde = contaborde + 1 + end if + + if (mData(imed2)%is%AnisMultiport) then + if (trim(adjustl(mData(imed)%AnisMultiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed2)%AnisMultiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed2 /= 1) then + contaborde = contaborde + 1 + end if + + if (mData(imed3)%is%AnisMultiport) then + if (trim(adjustl(mData(imed)%AnisMultiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed3)%AnisMultiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed3 /= 1) then + contaborde = contaborde + 1 + end if + + if (mData(imed4)%is%AnisMultiport) then + if (trim(adjustl(mData(imed)%AnisMultiport(1)%MultiportFileZ11)) /= & + trim(adjustl(mData(imed4)%AnisMultiport(1)%MultiportFileZ11))) contaborde = contaborde + 1 + elseif (imed4 /= 1) then + contaborde = contaborde + 1 + end if + + else + if ((imed /= imed1) .and. (imed1 /= 1)) contaborde = contaborde + 1 + if ((imed /= imed2) .and. (imed2 /= 1)) contaborde = contaborde + 1 + if ((imed /= imed3) .and. (imed3 /= 1)) contaborde = contaborde + 1 + if ((imed /= imed4) .and. (imed4 /= 1)) contaborde = contaborde + 1 + end if + + if ((imed1 == 1 .and. imed2 == 1 .and. imed3 == 1 .and. imed4 /= 1) .or. & + (imed2 == 1 .and. imed3 == 1 .and. imed4 == 1 .and. imed1 /= 1) .or. & + (imed3 == 1 .and. imed4 == 1 .and. imed1 == 1 .and. imed2 /= 1) .or. & + (imed4 == 1 .and. imed1 == 1 .and. imed2 == 1 .and. imed3 /= 1) .or. & + (imed1 == 1 .and. imed2 == 1 .and. imed3 == 1 .and. imed4 == 1) .or. & + (contaborde > 0)) isEdge = .true. + + if ((iii > problemDimension(campo)%XE) .or. (jjj > problemDimension(campo)%YE) .or. & + (kkk > problemDimension(campo)%ZE)) isEdge = .false. + + if ((iii < problemDimension(campo)%XI) .or. (jjj < problemDimension(campo)%YI) .or. & + (kkk < problemDimension(campo)%ZI)) isEdge = .false. + + else + isEdge = .false. + end if + + end function + end module mod_mapVTKOutput diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index a35c804f..5d4232b3 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -141,6 +141,7 @@ end subroutine flush_movie_probe_output !=========================== subroutine write_bin_file(this) + ! Check type definition for binary format type(movie_probe_output_t), intent(inout) :: this integer :: i, t, unit @@ -152,10 +153,10 @@ subroutine write_bin_file(this) end do end do close(unit) - call read_bin_file(this) end subroutine subroutine read_bin_file(this) + ! Check type definition for binary format type(movie_probe_output_t), intent(inout) :: this integer :: unit integer :: iostat @@ -164,7 +165,6 @@ subroutine read_bin_file(this) real(kind=RKIND) :: xVal, yVal, zVal integer(kind=4) :: dataSize - ! Open the file for reading open(unit=unit, file=add_extension(this%path, binaryExtension), & status='old', form='unformatted', access='stream', iostat=iostat) if (iostat /= 0) then diff --git a/src_output/output.F90 b/src_output/output.F90 index ba345aab..e561df33 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -188,7 +188,7 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, materialTags, bounds, contr allocate (outputs(outputCount)%mapvtkOutput) call init_solver_output(outputs(outputCount)%mapvtkOutput, lowerBound, upperBound, outputRequestType, outputTypeExtension, control%mpidir, problemInfo) - call create_geometry_simulation_vtu(outputs(outputCount)%mapvtkOutput, control) + call create_geometry_simulation_vtu(outputs(outputCount)%mapvtkOutput, control, sgg%LineX, sgg%LineY, sgg%LineZ) !! call adjust_computation_range --- Required due to issues in mpi region edges case (iEx, iEy, iEz, iHx, iHy, iHz) diff --git a/src_output/outputUtils.F90 b/src_output/outputUtils.F90 index 5e84a213..562d4609 100644 --- a/src_output/outputUtils.F90 +++ b/src_output/outputUtils.F90 @@ -32,6 +32,7 @@ module mod_outputUtils public :: fieldo public :: create_data_file public :: currentType + public :: get_media_from_coord_and_h_neighbours !=========================== !=========================== @@ -75,6 +76,39 @@ function getMediaIndex(field, i, j, k, CoordToMaterial) result(res) end function + subroutine get_media_from_coord_and_h_neighbours(field, i, j, k, CoordToMaterial, media, firstPositiveMedia, firstNegativeMedia, secondPositiveMedia, secondNegativeMedia) + !Returns field media and Hmedia from borders of i,j,k + type(media_matrices_t), pointer, intent(in) :: CoordToMaterial + integer(4), intent(in) :: field, i, j, k + integer(4), intent(out) :: media, firstPositiveMedia, firstNegativeMedia, secondPositiveMedia, secondNegativeMedia + integer, parameter :: nFields = 3 + + ! Precomputed shifts for first direction + integer, dimension(nFields) :: shift_i = [0, -1, 0] + integer, dimension(nFields) :: shift_j = [0, 0, -1] + integer, dimension(nFields) :: shift_k = [-1, 0, 0] + + ! Precomputed shifts for second direction + integer, dimension(nFields) :: shift_i2 = [0, 0, -1] + integer, dimension(nFields) :: shift_j2 = [-1, 0, 0] + integer, dimension(nFields) :: shift_k2 = [0, -1, 0] + + ! Precomputed neighbor hfield types + integer, dimension(nFields) :: HFieldTable = [iHy, iHz, iHx] ! returns perpendicular field tags from H + + ! Main mediua + media = getMediaIndex(field, i, j, k, CoordToMaterial) + + ! Neighboring media + !First Direction + firstPositiveMedia = getMediaIndex(HFieldTable(field), i, j, k, CoordToMaterial) + firstNegativeMedia = getMediaIndex(HFieldTable(field), i + shift_i(field), j + shift_j(field), k + shift_k(field), CoordToMaterial) + + !Second Direction + secondPositiveMedia = getMediaIndex(HFieldTable(mod(field, nFields) + 1), i, j, k, CoordToMaterial) + secondNegativeMedia = getMediaIndex(HFieldTable(mod(field, nFields) + 1), i + shift_i2(field), j + shift_j2(field), k + shift_k2(field), CoordToMaterial) + end subroutine + function get_probe_coords_extension(coordinates, mpidir) result(ext) type(cell_coordinate_t) :: coordinates integer(kind=SINGLE), intent(in) :: mpidir @@ -396,11 +430,11 @@ logical function isPEC(field, i, j, k, problem) end function logical function isPML(field, i, j, k, problem) - integer(kind=4) :: field, i, j, k - integer(kind=SINGLE) :: mediaIndex - type(problem_info_t), intent(in) :: problem - mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) - isPML = problem%materialList(mediaIndex)%is%PML + integer(kind=4) :: field, i, j, k + integer(kind=SINGLE) :: mediaIndex + type(problem_info_t), intent(in) :: problem + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) + isPML = problem%materialList(mediaIndex)%is%PML end function logical function isSurface(field, i, j, k, problem) @@ -577,17 +611,17 @@ integer function u(field1, field2) end function integer function currentType(field) - integer(kind=4) :: field - select case (field) - case (iEx); currentType = iJx - case (iEy); currentType = iJy - case (iEz); currentType = iJz - case (iHx); currentType = iBloqueJx - case (iHy); currentType = iBloqueJy - case (iHz); currentType = iBloqueJz - case default; call StopOnError(0, 0, 'field is not a E or H field') - end select - end function + integer(kind=4) :: field + select case (field) + case (iEx); currentType = iJx + case (iEy); currentType = iJy + case (iEz); currentType = iJz + case (iHx); currentType = iBloqueJx + case (iHy); currentType = iBloqueJy + case (iHz); currentType = iBloqueJz + case default; call StopOnError(0, 0, 'field is not a E or H field') + end select + end function function get_field(field, i, j, k, fields_reference) result(res) implicit none @@ -624,13 +658,13 @@ function get_delta(field, i, j, k, fields_reference) result(res) end select end function get_delta - subroutine create_data_file(filePathReference, probePathReference ,domainTypeReference, fileExtension) + 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 diff --git a/src_output/volumicProbeUtils.F90 b/src_output/volumicProbeUtils.F90 index 2408df58..4b251137 100644 --- a/src_output/volumicProbeUtils.F90 +++ b/src_output/volumicProbeUtils.F90 @@ -20,6 +20,12 @@ logical function logical_func(component, i, j, k, problemInfo) end function logical_func end interface + interface registerNode + module procedure & + registerNodeByIndex, & + registerNodeByCoordinate + end interface + contains subroutine find_and_store_important_coords(lowerBound, upperBound, component, problemInfo, nPoints, coords) @@ -83,9 +89,11 @@ subroutine store_required_coords(lowerBound, upperBound, requestComponent, probl end do end subroutine store_required_coords - subroutine createUnstructuredDataForVTU(counter, coords, currentType, Nodes, Edges, Quads, numNodes, numEdges, numQuads) + subroutine createUnstructuredDataForVTU(counter, coords, currentType, Nodes, Edges, Quads, numNodes, numEdges, numQuads, usevtkindex, realXGrid, realYGrid, realZGrid) integer, intent(in) :: counter integer(kind=SINGLE), intent(in) :: coords(:, :), currentType(:) + logical, intent(in) :: usevtkindex + real(KIND=RKIND), pointer, dimension(:), intent(in) :: realXGrid, realYGrid, realZGrid integer(kind=4), intent(out):: numNodes, numQuads, numEdges real(kind=RKIND), allocatable, dimension(:, :), intent(out) :: Nodes @@ -99,17 +107,27 @@ subroutine createUnstructuredDataForVTU(counter, coords, currentType, Nodes, Edg allocate (Quads(4, numQuads)) allocate (Nodes(3, 2*numEdges + 4*numQuads)) - call registerElements(counter, coords, currentType, Nodes, Edges, Quads) + call registerElements(counter, coords, currentType, Nodes, Edges, Quads, usevtkindex, realXGrid, realYGrid, realZGrid) return end subroutine - subroutine registerNode(nodes, nodeIx, x, y, z) + subroutine registerNodeByIndex(nodes, nodeIdx, x, y, z) + real(kind=RKIND), dimension(:, :), intent(inout) :: nodes + integer(kind=SINGLE), intent(in) :: nodeIdx, x, y, z + !We need to avoid using idx 0 + nodes(1, nodeIdx + 1) = x*1.0_RKIND + nodes(2, nodeIdx + 1) = y*1.0_RKIND + nodes(3, nodeIdx + 1) = z*1.0_RKIND + end subroutine + + subroutine registerNodeByCoordinate(nodes, nodeIdx, x, y, z) real(kind=RKIND), dimension(:, :), intent(inout) :: nodes - integer(kind=SINGLE), intent(in) :: nodeIx, x, y, z + integer(kind=SINGLE), intent(in) :: nodeIdx + real(kind=RKIND), intent(in) :: x, y, z !We need to avoid using idx 0 - nodes(1, nodeIx + 1) = x*1.0_RKIND - nodes(2, nodeIx + 1) = y*1.0_RKIND - nodes(3, nodeIx + 1) = z*1.0_RKIND + nodes(1, nodeIdx + 1) = x + nodes(2, nodeIdx + 1) = y + nodes(3, nodeIdx + 1) = z end subroutine subroutine registerEdge(edges, edgeIdx, startNodeIdx, endNodeIdx) @@ -145,66 +163,109 @@ subroutine countElements(counter, currentType, numEdges, numQuads) end do end subroutine - subroutine registerElements(counter, coords, currentType, Nodes, Edges, Quads) + subroutine registerElements(counter, coords, currentType, Nodes, Edges, Quads, usevtkindex, realXGrid, realYGrid, realZGrid) integer, intent(in) :: counter integer(kind=SINGLE), intent(in) :: coords(:, :), currentType(:) real(kind=RKIND), intent(inout) :: Nodes(:, :) integer(kind=4), intent(inout) :: Edges(:, :), Quads(:, :) + logical :: usevtkindex + real(KIND=RKIND), pointer, dimension(:), intent(in) :: realXGrid, realYGrid, realZGrid integer :: nodeIdx, quadIdx, edgeIdx + integer :: xCoord, yCoord, zCoord integer :: i nodeIdx = -1 quadIdx = -1 edgeIdx = -1 - + do i = 1, counter + xCoord = coords(1, i) + yCoord = coords(2, i) + zCoord = coords(3, i) + select case (currentType(i)) case (iJx) nodeIdx = nodeIdx + 2 - call registerNode(Nodes, nodeIdx - 1, coords(1, i) , coords(2, i), coords(3, i) ) - call registerNode(Nodes, nodeIdx , coords(1, i) + 1, coords(2, i), coords(3, i) ) + if (usevtkindex) then + call registerNode(Nodes, nodeIdx - 1, xCoord , yCoord, zCoord ) + call registerNode(Nodes, nodeIdx , xCoord + 1, yCoord, zCoord ) + else + call registerNode(Nodes, nodeIdx - 1, realXGrid(xCoord) , realYGrid(yCoord), realZGrid(zCoord) ) + call registerNode(Nodes, nodeIdx , realXGrid(xCoord + 1), realYGrid(yCoord), realZGrid(zCoord) ) + endif edgeIdx = edgeIdx + 1 call registerEdge(Edges, edgeIdx, nodeIdx - 1, nodeIdx) case (iJy) nodeIdx = nodeIdx + 2 - call registerNode(Nodes, nodeIdx - 1, coords(1, i), coords(2, i) , coords(3, i) ) - call registerNode(Nodes, nodeIdx , coords(1, i), coords(2, i) + 1, coords(3, i) ) + if (usevtkindex) then + call registerNode(Nodes, nodeIdx - 1, xCoord , yCoord , zCoord ) + call registerNode(Nodes, nodeIdx , xCoord , yCoord + 1, zCoord ) + else + call registerNode(Nodes, nodeIdx - 1, realXGrid(xCoord) , realYGrid(yCoord) , realZGrid(zCoord) ) + call registerNode(Nodes, nodeIdx , realXGrid(xCoord) , realYGrid(yCoord + 1), realZGrid(zCoord) ) + endif edgeIdx = edgeIdx + 1 call registerEdge(Edges, edgeIdx, nodeIdx - 1, nodeIdx) case (iJz) nodeIdx = nodeIdx + 2 - call registerNode(Nodes, nodeIdx - 1, coords(1, i), coords(2, i) , coords(3, i) ) - call registerNode(Nodes, nodeIdx , coords(1, i), coords(2, i) , coords(3, i) + 1) + if (usevtkindex) then + call registerNode(Nodes, nodeIdx - 1, xCoord, yCoord , zCoord ) + call registerNode(Nodes, nodeIdx , xCoord, yCoord , zCoord + 1) + else + call registerNode(Nodes, nodeIdx - 1, realXGrid(xCoord) , realYGrid(yCoord) , realZGrid(zCoord) ) + call registerNode(Nodes, nodeIdx , realXGrid(xCoord) , realYGrid(yCoord) , realZGrid(zCoord + 1)) + endif edgeIdx = edgeIdx + 1 call registerEdge(Edges, edgeIdx, nodeIdx - 1, nodeIdx) case (iBloqueJx) nodeIdx = nodeIdx + 4 - call registerNode(Nodes, nodeIdx - 3, coords(1, i), coords(2, i) , coords(3, i) ) - call registerNode(Nodes, nodeIdx - 2, coords(1, i), coords(2, i) + 1, coords(3, i) ) - call registerNode(Nodes, nodeIdx - 1, coords(1, i), coords(2, i) + 1, coords(3, i) + 1) - call registerNode(Nodes, nodeIdx , coords(1, i), coords(2, i) , coords(3, i) + 1) + if (usevtkindex) then + call registerNode(Nodes, nodeIdx - 3, xCoord, yCoord , zCoord ) + call registerNode(Nodes, nodeIdx - 2, xCoord, yCoord + 1, zCoord ) + call registerNode(Nodes, nodeIdx - 1, xCoord, yCoord + 1, zCoord + 1) + call registerNode(Nodes, nodeIdx , xCoord, yCoord , zCoord + 1) + else + call registerNode(Nodes, nodeIdx - 3, realXGrid(xCoord), realYGrid(yCoord) , realZGrid(zCoord) ) + call registerNode(Nodes, nodeIdx - 2, realXGrid(xCoord), realYGrid(yCoord + 1), realZGrid(zCoord) ) + call registerNode(Nodes, nodeIdx - 1, realXGrid(xCoord), realYGrid(yCoord + 1), realZGrid(zCoord + 1)) + call registerNode(Nodes, nodeIdx , realXGrid(xCoord), realYGrid(yCoord) , realZGrid(zCoord + 1)) + endif quadIdx = quadIdx + 1 call registerQuad(Quads, quadIdx, nodeIdx - 3, nodeIdx - 2, nodeIdx - 1, nodeIdx) case (iBloqueJy) nodeIdx = nodeIdx + 4 - call registerNode(Nodes, nodeIdx - 3, coords(1, i) , coords(2, i), coords(3, i) ) - call registerNode(Nodes, nodeIdx - 2, coords(1, i) + 1, coords(2, i), coords(3, i) ) - call registerNode(Nodes, nodeIdx - 1, coords(1, i) + 1, coords(2, i), coords(3, i) + 1) - call registerNode(Nodes, nodeIdx , coords(1, i) , coords(2, i), coords(3, i) + 1) + if (usevtkindex) then + call registerNode(Nodes, nodeIdx - 3, xCoord , yCoord, zCoord ) + call registerNode(Nodes, nodeIdx - 2, xCoord + 1, yCoord, zCoord ) + call registerNode(Nodes, nodeIdx - 1, xCoord + 1, yCoord, zCoord + 1) + call registerNode(Nodes, nodeIdx , xCoord , yCoord, zCoord + 1) + else + call registerNode(Nodes, nodeIdx - 3, realXGrid(xCoord) , realYGrid(yCoord), realZGrid(zCoord) ) + call registerNode(Nodes, nodeIdx - 2, realXGrid(xCoord + 1), realYGrid(yCoord), realZGrid(zCoord) ) + call registerNode(Nodes, nodeIdx - 1, realXGrid(xCoord + 1), realYGrid(yCoord), realZGrid(zCoord + 1)) + call registerNode(Nodes, nodeIdx , realXGrid(xCoord) , realYGrid(yCoord), realZGrid(zCoord + 1)) + endif quadIdx = quadIdx + 1 call registerQuad(Quads, quadIdx, nodeIdx - 3, nodeIdx - 2, nodeIdx - 1, nodeIdx) case (iBloqueJz) nodeIdx = nodeIdx + 4 - call registerNode(Nodes, nodeIdx - 3, coords(1, i) , coords(2, i) , coords(3, i)) - call registerNode(Nodes, nodeIdx - 2, coords(1, i) + 1, coords(2, i) , coords(3, i)) - call registerNode(Nodes, nodeIdx - 1, coords(1, i) + 1, coords(2, i) + 1, coords(3, i)) - call registerNode(Nodes, nodeIdx , coords(1, i) , coords(2, i) + 1, coords(3, i)) + if (usevtkindex) then + call registerNode(Nodes, nodeIdx - 3, xCoord , yCoord , zCoord) + call registerNode(Nodes, nodeIdx - 2, xCoord + 1, yCoord , zCoord) + call registerNode(Nodes, nodeIdx - 1, xCoord + 1, yCoord + 1, zCoord) + call registerNode(Nodes, nodeIdx , xCoord , yCoord + 1, zCoord) + else + call registerNode(Nodes, nodeIdx - 3, realXGrid(xCoord) , realYGrid(yCoord) , realZGrid(zCoord)) + call registerNode(Nodes, nodeIdx - 2, realXGrid(xCoord + 1), realYGrid(yCoord) , realZGrid(zCoord)) + call registerNode(Nodes, nodeIdx - 1, realXGrid(xCoord + 1), realYGrid(yCoord + 1), realZGrid(zCoord)) + call registerNode(Nodes, nodeIdx , realXGrid(xCoord) , realYGrid(yCoord + 1), realZGrid(zCoord)) + endif quadIdx = quadIdx + 1 call registerQuad(Quads, quadIdx, nodeIdx - 3, nodeIdx - 2, nodeIdx - 1, nodeIdx) end select From 0003b7d481311957f0efc95050a10d8da8708a8f Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Tue, 3 Mar 2026 14:31:30 +0100 Subject: [PATCH 88/96] Create xdmf api --- CMakeLists.txt | 11 +- src_output/CMakeLists.txt | 11 +- src_output/mapVTKOutput.F90 | 3 +- src_output/xdmfAPI.F90 | 368 ++++++++++++++++++++++++++++++++++ test/CMakeLists.txt | 2 + test/fdtd_tests.cpp | 1 + test/output/CMakeLists.txt | 24 ++- test/output/test_xdmfAPI.F90 | 258 ++++++++++++++++++++++++ test/output/xdmfAPI_tests.cpp | 1 + test/output/xdmfAPI_tests.h | 18 ++ 10 files changed, 686 insertions(+), 11 deletions(-) create mode 100644 src_output/xdmfAPI.F90 create mode 100644 test/output/test_xdmfAPI.F90 create mode 100644 test/output/xdmfAPI_tests.cpp create mode 100644 test/output/xdmfAPI_tests.h diff --git a/CMakeLists.txt b/CMakeLists.txt index ad227d1e..4775725c 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -216,10 +216,18 @@ endif() add_subdirectory(src_utils) if (SEMBA_FDTD_ENABLE_OUTPUT_MODULE) - add_subdirectory(external/VTKFortran) add_subdirectory(src_output) set(OUTPUT_LIBRARIES fdtd-output) + target_link_libraries(fdtd-output + semba-components + semba-types + fdtd-utils + ${HDF5_LIBRARIES} ${HDF5_HL_LIBRARIES} + ) + + target_include_directories(fdtd-output PRIVATE ${HDF5_INCLUDE_DIRS}) set(VTK_API_LIBRARIES vtkAPI) + set(XDMF_API_LIBRARIES xdmfAPI) endif() add_subdirectory(src_conformal) set(CONFORMAL_LIBRARIES conformal) @@ -297,6 +305,7 @@ if(SEMBA_FDTD_MAIN_LIB) fdtd-utils ${OUTPUT_LIBRARIES} ${VTK_API_LIBRARIES} + ${XDMF_API_LIBRARIES} ${SMBJSON_LIBRARIES} ${MTLN_LIBRARIES}) endif() diff --git a/src_output/CMakeLists.txt b/src_output/CMakeLists.txt index aefb517c..5b727ea8 100644 --- a/src_output/CMakeLists.txt +++ b/src_output/CMakeLists.txt @@ -15,12 +15,13 @@ add_library(fdtd-output add_library(vtkAPI "vtkAPI.F90" ) -target_link_libraries(fdtd-output - semba-types - semba-components - fdtd-utils - VTKFortran::VTKFortran + +add_library(xdmfAPI + "xdmfAPI.F90" ) + +target_include_directories(xdmfAPI PRIVATE ${HDF5_INCLUDE_DIRS}) + target_link_libraries(vtkAPI fdtd-utils ) diff --git a/src_output/mapVTKOutput.F90 b/src_output/mapVTKOutput.F90 index 547c2f20..4c3f36f7 100644 --- a/src_output/mapVTKOutput.F90 +++ b/src_output/mapVTKOutput.F90 @@ -2,7 +2,6 @@ module mod_mapVTKOutput use FDETYPES use outputTypes use mod_outputUtils - use vtk_fortran use mod_directoryUtils use mod_allocationUtils use mod_vtkAPI @@ -132,7 +131,7 @@ subroutine create_geometry_simulation_vtu(this, control, realXGrid, realYGrid, r type(sim_control_t), intent(in) :: control real(KIND=RKIND), pointer, dimension(:), intent(in) :: realXGrid, realYGrid, realZGrid - type(vtk_file) :: vtkOutput + !type(vtk_file) :: vtkOutput type(vtk_unstructured_grid), target :: ugrid integer :: ierr, i, npts, unit diff --git a/src_output/xdmfAPI.F90 b/src_output/xdmfAPI.F90 new file mode 100644 index 00000000..1f380144 --- /dev/null +++ b/src_output/xdmfAPI.F90 @@ -0,0 +1,368 @@ +module mod_xdmfAPI + use HDF5 + implicit none + + ! HDF5 constants + private + integer, parameter :: dp = kind(1.0d0) + public :: dp + public :: xdmf_create_file + public :: xdmf_write_timestep + public :: xdmf_write_step + public :: xdmf_close_file + public :: create_h5_file + public :: h5_close_file + public :: write_dataset + public :: xdmf_write_step_header + public :: xdmf_write_attribute + public :: xdmf_write_step_footer + public :: init_extendable_2d_dataset + public :: append_rows_dataset + + interface write_dataset + module procedure write_1d_dataset + module procedure write_2d_dataset + module procedure write_3d_dataset + end interface + +contains + subroutine xdmf_create_file(filename) + character(len=*), intent(in) :: filename + integer :: unit, ierr + + open (newunit=unit, file=filename, status='replace', action='write', & + form='formatted', iostat=ierr) + if (ierr /= 0) stop "Cannot create XDMF file" + + write (unit, '(A)') '' + write (unit, '(A)') '' + write (unit, '(A)') ' ' + write (unit, '(A)') ' ' + close (unit) + end subroutine xdmf_create_file + + subroutine xdmf_write_timestep(filename, time, dataset_path, grid_name, dims) + implicit none + character(len=*), intent(in) :: filename + real(dp), intent(in) :: time + character(len=*), intent(in) :: dataset_path + character(len=*), intent(in) :: grid_name + integer, dimension(:), intent(in) :: dims + integer :: unit + character(len=50) :: dim_str1, dim_str2 + + ! Convert dimensions to string + write (dim_str1, '(I0," ",I0," ",I0)') dims(3), dims(2), dims(1) + write (dim_str2, '(I0," ",I0," ",I0)') dims(1), dims(2), dims(3) + + open (newunit=unit, file=filename, status='old', action='write', position='append') + + write (unit, '(A)') ' ' + write (unit, '(A,F8.4)') ' ' + + close (unit) + end subroutine xdmf_write_timestep + + subroutine xdmf_write_step_header(filename, t, time, npoints) + character(len=*), intent(in) :: filename + integer, intent(in) :: t + real(8), intent(in) :: time + integer, intent(in) :: npoints + integer :: unit + character(len=20) :: ts + + write (ts, '(I0)') t + + open (newunit=unit, file=filename, position="append") + + write (unit, '(A)') ' ' + write (unit, '(A,F12.6,A)') ' ' + close (unit) + end subroutine xdmf_write_step_footer + + subroutine xdmf_write_step(filename, t, time, npoints) + character(len=*), intent(in) :: filename + integer, intent(in) :: t + real(8), intent(in) :: time + integer, intent(in) :: npoints + integer :: unit + character(len=20) :: ts + + write (ts, '(I0)') t + + open (newunit=unit, file=filename, position="append") + + write (unit, '(A)') ' ' + write (unit, '(A,F12.6,A)') ' ' + + close (unit) + + end subroutine + + subroutine xdmf_close_file(filename) + character(len=*), intent(in) :: filename + integer :: unit + + open (newunit=unit, file=filename, status='old', action='write', position='append') + write (unit, '(A)') ' ' + write (unit, '(A)') ' ' + write (unit, '(A)') '' + close (unit) + end subroutine xdmf_close_file + + subroutine create_h5_file(filename, file_id) + character(len=*), intent(in) :: filename + integer(HID_T), intent(out) :: file_id + integer :: error + + call H5Fcreate_f(trim(filename), H5F_ACC_TRUNC_F, file_id, error) + if (file_id < 0) then + print *, "Error creating HDF5 file: ", trim(filename) + end if + if (error /= 0) then + print *, "Error raised creating HDF5" + end if + end subroutine create_h5_file + + subroutine write_1d_dataset(file_id, dataset_name, data) + integer(HID_T), intent(in) :: file_id + character(len=*), intent(in) :: dataset_name + real(dp), dimension(:), intent(in) :: data + + integer(HID_T) :: dataspace_id, dataset_id + integer(HSIZE_T), dimension(1) :: dims + integer :: error + + dims(1) = size(data) + + call H5Screate_simple_f(1, dims, dataspace_id, error) + if (error /= 0) then + print *, "Error creating dataspace" + end if + + call H5Dcreate_f(file_id, trim(dataset_name), H5T_NATIVE_DOUBLE, & + dataspace_id, dataset_id, error) + if (error /= 0) then + print *, "Error creating dataset: ", trim(dataset_name) + end if + + call H5Dwrite_f(dataset_id, H5T_NATIVE_DOUBLE, data, dims, error) + + call H5Dclose_f(dataset_id, error) + call H5Sclose_f(dataspace_id, error) + end subroutine write_1d_dataset + + subroutine write_2d_dataset(file_id, dataset_name, data) + integer(HID_T), intent(in) :: file_id + character(len=*), intent(in) :: dataset_name + real(dp), dimension(:, :), intent(in) :: data + + integer(HID_T) :: dataspace_id = 0, dataset_id = 0 + integer(HSIZE_T), dimension(2) :: dims + integer :: error = 0 + + dims(1) = size(data, 1) + dims(2) = size(data, 2) + + call H5Screate_simple_f(2, dims, dataspace_id, error) + if (error /= 0) then + print *, "Error creating dataspace" + end if + + call H5Dcreate_f(file_id, trim(adjustl(dataset_name)), H5T_NATIVE_DOUBLE, & + dataspace_id, dataset_id, error) + if (error /= 0) then + print *, "Error creating dataset: ", trim(dataset_name) + end if + + call H5Dwrite_f(dataset_id, H5T_NATIVE_DOUBLE, data, dims, error) + + call H5Dclose_f(dataset_id, error) + call H5Sclose_f(dataspace_id, error) + end subroutine write_2d_dataset + + subroutine write_3d_dataset(file_id, dataset_name, data) + integer(HID_T), intent(in) :: file_id + character(len=*), intent(in) :: dataset_name + real(dp), dimension(:, :, :), intent(in) :: data + + integer(HID_T) :: dataspace_id, dataset_id + integer(HSIZE_T), dimension(3) :: dims + integer :: error + + dims(1) = size(data, 1) + dims(2) = size(data, 2) + dims(3) = size(data, 3) + + call H5Screate_simple_f(3, dims, dataspace_id, error) + if (error /= 0) then + print *, "Error creating dataspace" + end if + + call H5Dcreate_f(file_id, trim(dataset_name), H5T_NATIVE_DOUBLE, & + dataspace_id, dataset_id, error) + if (error /= 0) then + print *, "Error creating dataset: ", trim(dataset_name) + end if + + call H5Dwrite_f(dataset_id, H5T_NATIVE_DOUBLE, data, dims, error) + + call H5Dclose_f(dataset_id, error) + call H5Sclose_f(dataspace_id, error) + end subroutine write_3d_dataset + + subroutine init_extendable_2d_dataset(file_id, dataset_name, fixed_dim, chunk_rows) + + integer(HID_T), intent(in) :: file_id + character(len=*), intent(in) :: dataset_name + integer, intent(in) :: fixed_dim + integer, intent(in) :: chunk_rows + + integer(HID_T) :: dataspace_id, dataset_id, plist_id + integer(HSIZE_T), dimension(2) :: dims + integer(HSIZE_T), dimension(2) :: maxdims + integer(HSIZE_T), dimension(2) :: chunk_dims + integer :: error + + ! Initial size + dims(1) = 0 + dims(2) = fixed_dim + + maxdims(1) = H5S_UNLIMITED_F + maxdims(2) = fixed_dim + + call H5Screate_simple_f(2, dims, dataspace_id, error, maxdims) + call H5Pcreate_f(H5P_DATASET_CREATE_F, plist_id, error) + + chunk_dims(1) = chunk_rows + chunk_dims(2) = fixed_dim + + call H5Pset_chunk_f(plist_id, 2, chunk_dims, error) + + call H5Dcreate_f(file_id, trim(dataset_name), H5T_NATIVE_DOUBLE, & + dataspace_id, dataset_id, error, plist_id) + + if (error /= 0) then + print *, "Error creating dataset: ", trim(dataset_name) + end if + + call H5Dclose_f(dataset_id, error) + call H5Sclose_f(dataspace_id, error) + call H5Pclose_f(plist_id, error) + + end subroutine init_extendable_2d_dataset + + subroutine append_rows_dataset(file_id, dataset_name, data) + integer(HID_T), intent(in) :: file_id + character(len=*), intent(in) :: dataset_name + real(dp), dimension(:, :), intent(in) :: data ! shape: (nrows, fixed_size) + + integer(HID_T) :: dataset_id, filespace, memspace + integer(HSIZE_T), dimension(2) :: dims, new_dims + integer(HSIZE_T), dimension(2) :: start, dataCount + integer :: error + integer :: nrows, fixed_size + + nrows = size(data, 1) + fixed_size = size(data, 2) + + call H5Dopen_f(file_id, trim(dataset_name), dataset_id, error) + call H5Dget_space_f(dataset_id, filespace, error) + + ! Get current dimensions + call H5Sget_simple_extent_dims_f(filespace, dims, new_dims, error) + + ! Extend dataset by nrows + new_dims(1) = dims(1) + nrows + new_dims(2) = dims(2) + call H5Dset_extent_f(dataset_id, new_dims, error) + + ! Get updated dataspace + call H5Sclose_f(filespace, error) + call H5Dget_space_f(dataset_id, filespace, error) + + ! Select hyperslab for the new rows + start(1) = dims(1) ! start at first new row + start(2) = 0 ! start at first column + dataCount(1) = nrows + dataCount(2) = fixed_size + + call H5Sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, start, dataCount, error) + + ! Memory dataspace + call H5Screate_simple_f(2, dataCount, memspace, error) + + ! Write data + call H5Dwrite_f(dataset_id, H5T_NATIVE_DOUBLE, data, dataCount, error, & + memspace, filespace) + + ! Close resources + call H5Sclose_f(memspace, error) + call H5Sclose_f(filespace, error) + call H5Dclose_f(dataset_id, error) + + end subroutine append_rows_dataset + +end module mod_xdmfAPI diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 4e57caaf..7ebebbf8 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -26,6 +26,7 @@ if (SEMBA_FDTD_ENABLE_SMBJSON) add_subdirectory(output) set(OUPUT_TESTS_LIBRARY output_tests) set(VTK_API_TESTS_LIBRARY vtkAPI_tests) + set(XDMF_API_TESTS_LIBRARY xdmfAPI_tests) endif() if (NOT SEMBA_FDTD_ENABLE_MPI) @@ -50,6 +51,7 @@ target_link_libraries(fdtd_tests ${VTK_TESTS_LIBRARY} ${SYSTEM_TESTS_LIBRARY} ${VTK_API_TESTS_LIBRARY} + ${XDMF_API_TESTS_LIBRARY} ${OUPUT_TESTS_LIBRARY} ${OBSERVATION_TESTS_LIBRARY} GTest::gtest_main diff --git a/test/fdtd_tests.cpp b/test/fdtd_tests.cpp index 080f93f8..3545667c 100644 --- a/test/fdtd_tests.cpp +++ b/test/fdtd_tests.cpp @@ -9,6 +9,7 @@ #include "rotate/rotate_tests.h" #include "output/output_tests.h" #include "output/vtkAPI_tests.h" + #include "output/xdmfAPI_tests.h" #endif #ifndef CompileWithMPI #include "observation/observation_tests.h" diff --git a/test/output/CMakeLists.txt b/test/output/CMakeLists.txt index 59d9fb96..9d27ef09 100644 --- a/test/output/CMakeLists.txt +++ b/test/output/CMakeLists.txt @@ -7,13 +7,17 @@ add_library( "test_volumic_utils.F90" ) -add_library( - vtkAPI_test_fortran +add_library(vtkAPI_test_fortran "test_vtkAPI.F90" ) +add_library(xdmfAPI_test_fortran + "test_xdmfAPI.F90" +) + add_library(output_tests "output_tests.cpp") add_library(vtkAPI_tests "vtkAPI_tests.cpp") +add_library(xdmfAPI_tests "xdmfAPI_tests.cpp") target_link_libraries(output_test_fortran semba-outputs @@ -31,4 +35,18 @@ target_link_libraries(vtkAPI_test_fortran target_link_libraries(vtkAPI_tests vtkAPI_test_fortran GTest::gtest -) \ No newline at end of file +) + +target_link_libraries(xdmfAPI_test_fortran + xdmfAPI + test_utils_fortran + ${HDF5_LIBRARIES} ${HDF5_HL_LIBRARIES} +) + +target_link_libraries(xdmfAPI_tests + xdmfAPI_test_fortran + GTest::gtest +) + +target_include_directories(xdmfAPI_test_fortran PRIVATE ${HDF5_INCLUDE_DIRS}) + diff --git a/test/output/test_xdmfAPI.F90 b/test/output/test_xdmfAPI.F90 new file mode 100644 index 00000000..05eb17eb --- /dev/null +++ b/test/output/test_xdmfAPI.F90 @@ -0,0 +1,258 @@ +integer function test_create_h5_file() bind(c) result(err) + + use HDF5 + use mod_xdmfAPI + use mod_assertionTools + use mod_directoryUtils + implicit none + + character(len=14), parameter :: folder='testing_folder' + character(len=1024) :: file + integer(HID_T) :: file_id + integer :: error + logical :: exists + integer :: test_err = 0 + + call create_folder(folder, error) + file = join_path(folder, "test_api.h5") + + call H5open_f(error) + + call create_h5_file(trim(adjustl(file)), file_id) + + test_err = test_err + assert_true(file_id > 0, "create_h5_file returned invalid id") + + call close_file(file_id) + + inquire(file=trim(adjustl(file)), exist=exists) + test_err = test_err + assert_true(exists, "HDF5 file was not created") + + call H5close_f(error) + + err = test_err + call remove_folder(folder, error) +end function + +integer function test_write_1d_dataset() bind(c) result(err) + + use HDF5 + use mod_xdmfAPI + use mod_assertionTools + use mod_directoryUtils + implicit none + + character(len=14), parameter :: folder='testing_folder' + character(len=1024) :: file + integer(HID_T) :: file_id + real(8), allocatable :: data(:) + integer :: error + integer :: test_err = 0 + integer :: n, i + + call create_folder(folder, error) + file = join_path(folder, "test_api.h5") + + call H5open_f(error) + + n = 10 + allocate(data(n)) + data = [(real(i,8), i=1,n)] + + call create_h5_file(trim(adjustl(file)), file_id) + + call write_dataset(file_id, "/data1d", data) + + test_err = test_err + assert_integer_equal(size(data), 10, "1D dataset size mismatch") + + call close_file(file_id) + + deallocate(data) + + call H5close_f(error) + + err = test_err + call remove_folder(folder, error) +end function + +integer function test_write_2d_dataset() bind(c) result(err) + + use HDF5 + use mod_xdmfAPI + use mod_assertionTools + use mod_directoryUtils + implicit none + + character(len=14), parameter :: folder='testing_folder' + character(len=1024) :: file + integer(HID_T) :: file_id + real(8), allocatable :: data(:,:) + integer :: error + integer :: test_err = 0 + + call create_folder(folder, error) + file = join_path(folder, "test_api.h5") + + call H5open_f(error) + + allocate(data(4,5)) + data = 1.0d0 + + call create_h5_file(trim(adjustl(file)), file_id) + + call write_dataset(file_id, "/data2d", data) + + test_err = test_err + assert_integer_equal(size(data,1),4,"2D dim1 mismatch") + test_err = test_err + assert_integer_equal(size(data,2),5,"2D dim2 mismatch") + + call close_file(file_id) + + deallocate(data) + + call H5close_f(error) + + err = test_err + call remove_folder(folder, error) +end function + +integer function test_write_3d_dataset() bind(c) result(err) + + use HDF5 + use mod_xdmfAPI + use mod_assertionTools + use mod_directoryUtils + implicit none + + character(len=14), parameter :: folder='testing_folder' + character(len=1024) :: file + integer(HID_T) :: file_id + real(8), allocatable :: data(:,:,:) + integer :: error + integer :: test_err = 0 + + call create_folder(folder, error) + file = join_path(folder, "test_api.h5") + + call H5open_f(error) + + allocate(data(3,3,3)) + data = 2.0d0 + + call create_h5_file(trim(adjustl(file)), file_id) + + call write_dataset(file_id, "/data3d", data) + + test_err = test_err + assert_integer_equal(size(data,1),3,"3D dim1 mismatch") + test_err = test_err + assert_integer_equal(size(data,2),3,"3D dim2 mismatch") + test_err = test_err + assert_integer_equal(size(data,3),3,"3D dim3 mismatch") + + call close_file(file_id) + + deallocate(data) + + call H5close_f(error) + + err = test_err + + call remove_folder(folder, error) +end function + +integer function test_xdmf_file_creation() bind(c) result(err) + + use mod_xdmfAPI + use mod_assertionTools + use mod_directoryUtils + implicit none + + character(len=14), parameter :: folder='testing_folder' + character(len=1024) :: file + integer :: test_err = 0 + integer :: error + logical :: exists + integer :: dims(3) + + call create_folder(folder, error) + file = join_path(folder, "test_api.xdmf") + + dims = [4,4,4] + + call xdmf_create_file(trim(adjustl(file))) + + call xdmf_write_timestep(trim(adjustl(file)),0.0d0, "data.h5:/Efield", "grid0", dims) + + call xdmf_close_file(trim(adjustl(file))) + + inquire(file=trim(adjustl(file)), exist=exists) + + test_err = test_err + assert_true(exists, "XDMF file not created") + + err = test_err + call remove_folder(folder, error) +end function + +integer function test_xdmf_file_with_h5data() bind(c) result(err) + use HDF5 + use mod_xdmfAPI + use mod_assertionTools + use mod_directoryUtils + implicit none + + character(len=20), parameter :: folder = "testing_folder" + character(len=1024) :: xdmf_file, h5_file + integer :: test_err = 0 + integer :: error, t + logical :: exists + integer :: dims(3) + integer(HID_T) :: file_id + real(dp), allocatable ,dimension(:,:) :: Efield + real(dp) :: time + character(len=12) :: ts + integer :: i,j + + ! Create test folder + call create_folder(folder, error) + + xdmf_file = join_path(folder, "test_api.xdmf") + h5_file = join_path(folder, "data.h5") + + call H5open_f(error) + + ! Create HDF5 file + call create_h5_file(trim(adjustl(h5_file)), file_id) + + ! Create XDMF file + call xdmf_create_file(trim(adjustl(xdmf_file))) + + dims = [3,3,1] ! 2D grid stored as 3D with depth 1 + + do t = 1, 5 + time = real(t-1, dp)*0.1_dp + allocate(Efield(dims(1), dims(2))) + Efield = 0.0_dp + do j = 1, dims(2) + do i = 1, dims(1) + Efield(i,j) = i + j + t - 1 + end do + end do + + write(ts,'(A,I0)') "Efield_", t + + call write_dataset(file_id, trim(adjustl(ts)), Efield) + + call xdmf_write_timestep(trim(adjustl(xdmf_file)), time, & + trim(adjustl(h5_file))//":/Efield"//trim(adjustl(ts)), & + "grid"//trim(adjustl(ts)), dims) + + deallocate(Efield) + end do + + call xdmf_close_file(trim(adjustl(xdmf_file))) + call close_file(file_id) + + inquire(file=trim(adjustl(xdmf_file)), exist=exists) + test_err = test_err + assert_true(exists, "XDMF file not created") + + call remove_folder(folder, error) + call H5close_f(error) + + err = test_err +end function \ No newline at end of file diff --git a/test/output/xdmfAPI_tests.cpp b/test/output/xdmfAPI_tests.cpp new file mode 100644 index 00000000..e0167c57 --- /dev/null +++ b/test/output/xdmfAPI_tests.cpp @@ -0,0 +1 @@ +#include "xdmfAPI_tests.h" \ No newline at end of file diff --git a/test/output/xdmfAPI_tests.h b/test/output/xdmfAPI_tests.h new file mode 100644 index 00000000..6747793f --- /dev/null +++ b/test/output/xdmfAPI_tests.h @@ -0,0 +1,18 @@ +#ifdef CompileWithNewOutputModule +#include + +extern "C" int test_create_h5_file(); +extern "C" int test_write_1d_dataset(); +extern "C" int test_write_2d_dataset(); +extern "C" int test_write_3d_dataset(); +extern "C" int test_xdmf_file_creation(); +extern "C" int test_xdmf_file_with_h5data(); + +TEST(xdmfapi, test_create_h5) { EXPECT_EQ(0, test_create_h5_file()); } +TEST(xdmfapi, test_write_1d) { EXPECT_EQ(0, test_write_1d_dataset()); } +TEST(xdmfapi, test_write_2d) { EXPECT_EQ(0, test_write_2d_dataset()); } +TEST(xdmfapi, test_write_3d) { EXPECT_EQ(0, test_write_3d_dataset()); } +TEST(xdmfapi, test_xdmf_file) { EXPECT_EQ(0, test_xdmf_file_creation()); } +TEST(xdmfapi, test_xdmf_file_with_h5) { EXPECT_EQ(0, test_xdmf_file_with_h5data()); } + +#endif \ No newline at end of file From f2d2bafceb427ee49ee8d679eab7fbfac393bafb Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 4 Mar 2026 12:35:01 +0100 Subject: [PATCH 89/96] Remove and comment pdv from volumic probes --- src_output/frequencySliceProbeOutput.F90 | 163 +++++++++++------------ src_output/movieProbeOutput.F90 | 123 ++++------------- src_output/output.F90 | 5 +- test/output/test_output.F90 | 13 -- 4 files changed, 107 insertions(+), 197 deletions(-) diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index cf06b323..f75fa27c 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -295,7 +295,6 @@ subroutine flush_frequency_slice_probe_output(this) end subroutine flush_frequency_slice_probe_output subroutine write_vtu_frequency_slice(this, freq, filename) - use vtk_fortran implicit none type(frequency_slice_probe_output_t), intent(in) :: this @@ -303,84 +302,84 @@ subroutine write_vtu_frequency_slice(this, freq, filename) character(len=*), intent(in) :: filename character(len=BUFSIZE) :: requestName - type(vtk_file) :: vtkOutput + !type(vtk_file) :: vtkOutput integer :: ierr, npts, i real(kind=RKIND), allocatable :: x(:), y(:), z(:) real(kind=RKIND), allocatable :: Componentx(:), Componenty(:), Componentz(:) logical :: writeX, writeY, writeZ - !================= Determine the measure type ================= - 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) - 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) - 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 - Componentx(i) = abs(this%xValueForFreq(freq, i)) - end do - end if - - if (writeY) then - allocate (Componenty(npts)) - do i = 1, npts - Componenty(i) = abs(this%yValueForFreq(freq, i)) - end do - end if - - if (writeZ) then - allocate (Componentz(npts)) - do i = 1, npts - Componentz(i) = abs(this%zValueForFreq(freq, i)) - end do - end if - - !================= 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=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=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=requestName, 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) - + !!================= Determine the measure type ================= + !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) + !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) + ! 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 + ! Componentx(i) = abs(this%xValueForFreq(freq, i)) + ! end do + !end if +! + !if (writeY) then + ! allocate (Componenty(npts)) + ! do i = 1, npts + ! Componenty(i) = abs(this%yValueForFreq(freq, i)) + ! end do + !end if +! + !if (writeZ) then + ! allocate (Componentz(npts)) + ! do i = 1, npts + ! Componentz(i) = abs(this%zValueForFreq(freq, i)) + ! end do + !end if +! + !!================= 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=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=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=requestName, 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 subroutine update_pvd(this, freq, PVDfilePath) @@ -393,14 +392,14 @@ subroutine update_pvd(this, freq, PVDfilePath) integer :: unit - write (newVTUfilename, '(A,A,I4.4,A)') trim(remove_extension(this%pvdPath)), '_fq', freq, '.vtu' - call write_vtu_frequency_slice(this, freq, newVTUfilename) - - write (ts, '(ES16.8)') this%frequencySlice(freq) - - open (newunit=unit, file=trim(PVDfilePath), status='old', position='append') - write (unit, '(A)') ' ' - close(unit) +! write (newVTUfilename, '(A,A,I4.4,A)') trim(remove_extension(this%pvdPath)), '_fq', freq, '.vtu' +! call write_vtu_frequency_slice(this, freq, newVTUfilename) +! +! write (ts, '(ES16.8)') this%frequencySlice(freq) +! +! 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 5d4232b3..58182fa2 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -5,7 +5,8 @@ module mod_movieProbeOutput use outputTypes use mod_outputUtils use mod_volumicProbeUtils - use vtk_fortran + use HDF5 + use mod_xdmfAPI implicit none private @@ -128,10 +129,7 @@ subroutine flush_movie_probe_output(this) integer :: i call write_bin_file(this) - - do i = 1, this%nTime - call update_pvd(this, i, this%pvdPath) - end do + call write_to_xdmf(this) call clear_memory_data(this) end subroutine flush_movie_probe_output @@ -145,16 +143,17 @@ subroutine write_bin_file(this) type(movie_probe_output_t), intent(inout) :: this integer :: i, t, unit - open(unit=unit, file=add_extension(this%path, binaryExtension), & - status='old', form='unformatted', position='append', access='stream') - do t=1, this%nTime - do i=1, this%nPoints + open (unit=unit, file=add_extension(this%path, binaryExtension), & + status='old', form='unformatted', position='append', access='stream') + do t = 1, this%nTime + do i = 1, this%nPoints write(unit) this%timeStep(t), this%coords(1,i), this%coords(2,i), this%coords(3,i), this%xValueForTime(t,i), this%yValueForTime(t,i), this%zValueForTime(t,i) end do end do - close(unit) + close (unit) end subroutine + subroutine read_bin_file(this) ! Check type definition for binary format type(movie_probe_output_t), intent(inout) :: this @@ -164,22 +163,22 @@ subroutine read_bin_file(this) integer(kind=SINGLE) :: x, y, z real(kind=RKIND) :: xVal, yVal, zVal integer(kind=4) :: dataSize - - open(unit=unit, file=add_extension(this%path, binaryExtension), & - status='old', form='unformatted', access='stream', iostat=iostat) + + open (unit=unit, file=add_extension(this%path, binaryExtension), & + status='old', form='unformatted', access='stream', iostat=iostat) if (iostat /= 0) then - print *, 'Error opening file!' - return + print *, 'Error opening file!' + return end if - + ! Read until end-of-file do - read(unit, iostat=iostat) timeStamp, x, y, z, xVal, yVal, zVal - if (iostat /= 0) exit ! EOF or error - print *, timeStamp, x, y, z, xVal, yVal, zVal + read (unit, iostat=iostat) timeStamp, x, y, z, xVal, yVal, zVal + if (iostat /= 0) exit ! EOF or error + print *, timeStamp, x, y, z, xVal, yVal, zVal end do - - close(unit) + + close (unit) end subroutine function get_output_path(this, outputTypeExtension, field, mpidir) result(path) @@ -189,11 +188,10 @@ function get_output_path(this, outputTypeExtension, field, mpidir) result(path) character(len=BUFSIZE) :: path, probeBoundsExtension, prefixFieldExtension probeBoundsExtension = get_coordinates_extension(this%mainCoords, this%auxCoords, mpidir) - prefixFieldExtension = get_prefix_extension(field, mpidir) + prefixFieldExtension = get_prefix_extension(field, mpidir) path = trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) end function get_output_path - subroutine save_current_module(this, fieldsReference, simTime, problemInfo) type(movie_probe_output_t), intent(inout) :: this type(fields_reference_t), intent(in) :: fieldsReference @@ -263,9 +261,9 @@ subroutine save_field_module(this, field, request, simTime, problemInfo) do i = this%mainCoords%x, this%auxCoords%x 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 @@ -288,7 +286,7 @@ subroutine save_field_component(this, fieldData, fieldComponent, simTime, proble do i = this%mainCoords%x, this%auxCoords%x 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 @@ -313,69 +311,7 @@ subroutine write_vtu_timestep(this, stepIndex, filename) real(kind=RKIND), allocatable :: Componentx(:), Componenty(:), Componentz(:) logical :: writeX, writeY, writeZ character(len=BUFSIZE) :: requestName - type(vtk_file) :: vtkOutput - - !================= Determine measure type ================= - if (any(CURRENT_MEASURE == this%component)) then - requestName = 'Current' - else if (any(ELECTRIC_FIELD_MEASURE == this%component)) then - requestName = 'Electric' - else if (any(MAGNETIC_FIELD_MEASURE == this%component)) then - requestName = 'Magnetic' - else - requestName = 'Unknown' - end if - - 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) - npts = this%nPoints - 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 - - 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) - - if (writeX) then - allocate(Componentx(npts)) - do i=1, npts - Componentx(i) = this%xValueForTime(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))//'X', x=Componentx) - ierr = vtkOutput%xml_writer%write_dataarray(location='node', action='close') - 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) - 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) - end if - - ierr = vtkOutput%xml_writer%finalize() - deallocate(x, y, z) end subroutine write_vtu_timestep subroutine update_pvd(this, stepIndex, PVDfilePath) @@ -386,15 +322,7 @@ subroutine update_pvd(this, stepIndex, PVDfilePath) character(len=64) :: ts character(len=BUFSIZE) :: newVTUfilename integer :: unit - - write(newVTUfilename,'(A,A,I4.4,A)') trim(remove_extension(this%pvdPath)), '_ts', stepIndex, '.vtu' - call write_vtu_timestep(this, stepIndex, newVTUfilename) - write(ts,'(ES16.8)') this%timeStep(stepIndex) - - open (newunit=unit, file=trim(PVDfilePath), status='old', position='append') - write(unit,'(A)') ' ' - close(unit) end subroutine update_pvd subroutine clear_memory_data(this) @@ -415,5 +343,4 @@ subroutine clear_memory_data(this) end if end subroutine clear_memory_data - end module mod_movieProbeOutput diff --git a/src_output/output.F90 b/src_output/output.F90 index e561df33..78647c57 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -230,15 +230,12 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, materialTags, bounds, contr 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%pvdPath) else if (domain%domainType == FREQUENCY_DOMAIN) then outputCount = outputCount + 1 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%pvdPath) - end if case (farfield) sphericRange = preprocess_polar_range(sgg%Observation(ii)) @@ -446,7 +443,7 @@ subroutine close_outputs() case (BULK_PROBE_ID) case (VOLUMIC_CURRENT_PROBE_ID) case (MOVIE_PROBE_ID) - call close_pvd(outputs(i)%movieProbe%pvdPath) + case (FREQUENCY_SLICE_PROBE_ID) call close_pvd(outputs(i)%frequencySliceProbe%pvdPath) end select diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index a090b4ec..5e6e8660 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -479,7 +479,6 @@ integer function test_init_movie_probe() bind(c) result(err) expectedPDVPath = join_path(expectedProbePath, pdvFileName) test_err = test_err + assert_string_equal(outputs(1)%movieProbe%path, expectedProbePath, 'Unexpected path') - test_err = test_err + assert_string_equal(outputs(1)%movieProbe%pvdPath, expectedPDVPath, 'Unexpected pdv path') test_err = test_err + assert_true(folder_exists(expectedProbePath), 'Movie folder do not exist') test_err = test_err + assert_true(file_exists(expectedPDVPath), 'PDV file for movie do not exist') @@ -792,20 +791,8 @@ integer function test_flush_movie_probe() bind(c) result(err) call flush_outputs(dummysgg%tiempo, 1_SINGLE, dummyControl, fields, dummyBound, .false.) - ! --- Assert file existance - do outputIdx = 1, 3 - expectedPath = add_extension(remove_extension(outputs(outputIdx)%movieProbe%pvdPath),'_ts0001.vtu') - test_err = test_err + assert_true(file_exists(expectedPath), 'Primera iteracion no encontrada') - - expectedPath = add_extension(remove_extension(outputs(outputIdx)%movieProbe%pvdPath),'_ts0002.vtu') - test_err = test_err + assert_true(file_exists(expectedPath), 'Segunda iteracion no encontrada') - end do - call close_outputs() - expectedPath = trim(adjustl(outputs(1)%movieProbe%pvdPath)) - test_err = test_err + assert_true(file_exists(expectedPath), 'PVD file not found') - call remove_folder(test_folder, ios) err = test_err From afa26124758e1f3f579fd06f2e055d4879f8cb6e Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Wed, 4 Mar 2026 16:35:48 +0100 Subject: [PATCH 90/96] working on xdmf api --- src_main_pub/timestepping.F90 | 1 + src_output/movieProbeOutput.F90 | 143 +++++++++++++++++--- src_output/output.F90 | 1 - src_output/outputTypes.F90 | 3 +- src_output/xdmfAPI.F90 | 225 +++++++++++--------------------- test/output/test_output.F90 | 172 ++++++++++++------------ test/output/test_xdmfAPI.F90 | 107 +++++++++------ 7 files changed, 357 insertions(+), 295 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index c1a2b679..f4ff111a 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -1988,6 +1988,7 @@ subroutine solver_run(this) this%n=this%n+1 !sube de iteracion end do ciclo_temporal ! End of the time-stepping loop + contains subroutine request_flush_if_any_observation_is_done() diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 58182fa2..830fde7e 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -42,29 +42,63 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, character(len=BUFSIZE), intent(in) :: outputTypeExtension integer :: error - character(len=BUFSIZE) :: pdvFileName + character(len=BUFSIZE) :: filename this%mainCoords = lowerBound - this%auxCoords = upperBound - this%component = field - this%domain = domain - this%path = get_output_path(this, outputTypeExtension, field, control%mpidir) - - pdvFileName = add_extension(get_last_component(this%path), pvdExtension) - this%pvdPath = join_path(this%path, pdvFileName) - - call create_folder(this%path, error) - call create_file_with_path(add_extension(this%path, binaryExtension), error) + this%auxCoords = upperBound + this%component = field + this%domain = domain 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) + call alloc_and_init(this%timeStep, BUFSIZE, 0.0_RKIND_tiempo) ! Allocate value arrays based on component type - 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) + call alloc_and_init(this%xValueForTime, BUFSIZE, this%nPoints, 0.0_RKIND) + call alloc_and_init(this%yValueForTime, BUFSIZE, this%nPoints, 0.0_RKIND) + call alloc_and_init(this%zValueForTime, BUFSIZE, this%nPoints, 0.0_RKIND) + + this%path = get_output_path(this, outputTypeExtension, field, control%mpidir) + filename = get_last_component(this%path) + this%filesPath = join_path(this%path, filename) + + call create_folder(this%path, error) + call create_bin_file(this%filesPath, error) + call create_movie_files(this%filesPath, this%coords ,this%nPoints, error) end subroutine init_movie_probe_output + subroutine create_bin_file(filePath, error) + character(len=*), intent(in) :: filePath + integer, intent(out) :: error + call create_file_with_path(add_extension(filePath, binaryExtension), error) + end subroutine + + subroutine create_movie_files(filePath, coords, nPoints, error) + character(len=*), intent(in) :: filePath + integer(kind=SINGLE), dimension(:, :), intent(in) :: coords + integer, intent(in) :: nPoints + integer, intent(out) :: error + real(dp), allocatable, dimension(:, :) :: coordsReal + + integer(HID_T) :: file_id + character(len=BUFSIZE) :: h5_filename + + h5_filename = add_extension(filePath, ".h5") + + call H5open_f(error) + call create_h5_file(trim(h5_filename), file_id) + + allocate (coordsReal(3, nPoints)) + coordsReal = real(coords, dp) + call write_dataset(file_id, "coords", coordsReal) + deallocate(coordsReal) + + call init_extendable_2d_dataset(file_id, 'xVal', nPoints, BUFSIZE) + call init_extendable_2d_dataset(file_id, 'yVal', nPoints, BUFSIZE) + call init_extendable_2d_dataset(file_id, 'zVal', nPoints, BUFSIZE) + call H5Fclose_f(file_id, error) + call H5close_f(error) + end subroutine + 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 @@ -129,7 +163,7 @@ subroutine flush_movie_probe_output(this) integer :: i call write_bin_file(this) - call write_to_xdmf(this) + call write_to_xdmf_h5(this) call clear_memory_data(this) end subroutine flush_movie_probe_output @@ -143,16 +177,89 @@ subroutine write_bin_file(this) type(movie_probe_output_t), intent(inout) :: this integer :: i, t, unit - open (unit=unit, file=add_extension(this%path, binaryExtension), & + open (unit=unit, file=add_extension(this%filesPath, binaryExtension), & status='old', form='unformatted', position='append', access='stream') do t = 1, this%nTime do i = 1, this%nPoints write(unit) this%timeStep(t), this%coords(1,i), this%coords(2,i), this%coords(3,i), this%xValueForTime(t,i), this%yValueForTime(t,i), this%zValueForTime(t,i) end do end do + flush (unit) close (unit) end subroutine + subroutine write_to_xdmf_h5(this) + + type(movie_probe_output_t), intent(inout) :: this + + integer(HID_T) :: file_id + integer :: t, error, xdmfunit + real(dp), allocatable, dimension(:, :) :: coordsReal + character(len=256) :: h5_filename, h5_filepath + character(len=256) :: xdmf_filename + character(len=10) :: dimension_string + character(len=10) :: nCoordsString + character(len=14) :: stepName + h5_filepath = add_extension(this%filesPath, ".h5") + h5_filename = get_last_component(h5_filepath) + + call H5open_f(error) + call H5Fopen_f(trim(h5_filepath), H5F_ACC_RDWR_F, file_id, error) + + + write(dimension_string, '(I0,1X,I0)') this%nPoints, this%nTimesFlushed + this%nTime + write(nCoordsString, '(I0, I0)') this%nPoints, 1 + do t = 1, this%nTime + write(stepName, '((I5.5))') this%nTimesFlushed + t + call append_rows_dataset(file_id, "xVal", reshape(this%xValueForTime(t, :), [1, this%nPoints])) + call append_rows_dataset(file_id, "yVal", reshape(this%yValueForTime(t, :), [1, this%nPoints])) + call append_rows_dataset(file_id, "zVal", reshape(this%zValueForTime(t, :), [1, this%nPoints])) + if (mod(this%nTimesFlushed + t, 10) == 0) then + + xdmf_filename = add_extension(add_extension(this%filesPath, ".ts_"//stepName), ".xdmf") + open(newunit=xdmfunit, file=trim(xdmf_filename), status='replace', position='append', iostat=error) + + call xdmf_write_header_file(xdmfunit) + + call xdmf_create_grid_step_info(xdmfunit, stepName, real(this%timeStep(t)), trim(h5_filename), this%nPoints) + + call xdmf_write_attribute(xdmfunit, 'xVal') + call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) + call xdmf_write_h5_acces_data_item(xdmfunit, 0, this%nTimesFlushed + t - 1, this%nPoints, this%nTimesFlushed + this%nTime) + call xdmf_close_data_item(xdmfunit) + call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/xVal', dimension_string) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_attribute(xdmfunit) + + call xdmf_write_attribute(xdmfunit, 'yVal') + call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) + call xdmf_write_h5_acces_data_item(xdmfunit, 0, this%nTimesFlushed + t - 1, this%nPoints, this%nTimesFlushed + this%nTime) + call xdmf_close_data_item(xdmfunit) + call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/yVal', dimension_string) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_attribute(xdmfunit) + + call xdmf_write_attribute(xdmfunit, 'zVal') + call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) + call xdmf_write_h5_acces_data_item(xdmfunit, 0, this%nTimesFlushed + t - 1, this%nPoints, this%nTimesFlushed + this%nTime) + call xdmf_close_data_item(xdmfunit) + call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/zVal', dimension_string) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_attribute(xdmfunit) + + call xdmf_close_grid(xdmfunit) + + call xdmf_write_footer_file(xdmfunit) + close(xdmfunit) + endif + end do + + call H5Fclose_f(file_id, error) + call H5close_f(error) + end subroutine write_to_xdmf_h5 subroutine read_bin_file(this) ! Check type definition for binary format @@ -327,7 +434,7 @@ end subroutine update_pvd subroutine clear_memory_data(this) type(movie_probe_output_t), intent(inout) :: this - + this%nTimesFlushed = this%nTimesFlushed + this%nTime this%nTime = 0 this%timeStep = 0.0_RKIND if (any(VOLUMIC_M_MEASURE == this%component)) then diff --git a/src_output/output.F90 b/src_output/output.F90 index 78647c57..161695aa 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -443,7 +443,6 @@ subroutine close_outputs() case (BULK_PROBE_ID) case (VOLUMIC_CURRENT_PROBE_ID) case (MOVIE_PROBE_ID) - case (FREQUENCY_SLICE_PROBE_ID) call close_pvd(outputs(i)%frequencySliceProbe%pvdPath) end select diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index 65c8c00c..b9fd4b8e 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -96,6 +96,7 @@ module outputTypes type, extends(abstract_probe_t) :: abstract_time_probe_t character(len=BUFSIZE) :: filePathTime integer(kind=SINGLE) :: nTime = 0_SINGLE + integer(kind=SINGLE) :: nTimesFlushed = 0_SINGLE !times alredy writen in disk real(kind=RKIND_tiempo), allocatable :: timeStep(:) end type abstract_time_probe_t @@ -171,7 +172,7 @@ module outputTypes real(kind=RKIND), allocatable :: xValueForTime(:, :) !(time, coordIdx) real(kind=RKIND), allocatable :: yValueForTime(:, :) !(time, coordIdx) real(kind=RKIND), allocatable :: zValueForTime(:, :) !(time, coordIdx) - character(len=BUFSIZE) :: pvdPath + character(len=BUFSIZE) :: filesPath end type movie_probe_output_t type, extends(abstract_frequency_probe_t) :: frequency_slice_probe_output_t diff --git a/src_output/xdmfAPI.F90 b/src_output/xdmfAPI.F90 index 1f380144..1a016adc 100644 --- a/src_output/xdmfAPI.F90 +++ b/src_output/xdmfAPI.F90 @@ -3,21 +3,9 @@ module mod_xdmfAPI implicit none ! HDF5 constants - private + integer, parameter :: dp = kind(1.0d0) - public :: dp - public :: xdmf_create_file - public :: xdmf_write_timestep - public :: xdmf_write_step - public :: xdmf_close_file - public :: create_h5_file - public :: h5_close_file - public :: write_dataset - public :: xdmf_write_step_header - public :: xdmf_write_attribute - public :: xdmf_write_step_footer - public :: init_extendable_2d_dataset - public :: append_rows_dataset + interface write_dataset module procedure write_1d_dataset @@ -26,151 +14,86 @@ module mod_xdmfAPI end interface contains - subroutine xdmf_create_file(filename) - character(len=*), intent(in) :: filename - integer :: unit, ierr - - open (newunit=unit, file=filename, status='replace', action='write', & - form='formatted', iostat=ierr) - if (ierr /= 0) stop "Cannot create XDMF file" - + subroutine xdmf_write_header_file(unit) + integer :: unit write (unit, '(A)') '' write (unit, '(A)') '' write (unit, '(A)') ' ' write (unit, '(A)') ' ' - close (unit) - end subroutine xdmf_create_file - - subroutine xdmf_write_timestep(filename, time, dataset_path, grid_name, dims) - implicit none - character(len=*), intent(in) :: filename - real(dp), intent(in) :: time - character(len=*), intent(in) :: dataset_path - character(len=*), intent(in) :: grid_name - integer, dimension(:), intent(in) :: dims - integer :: unit - character(len=50) :: dim_str1, dim_str2 - - ! Convert dimensions to string - write (dim_str1, '(I0," ",I0," ",I0)') dims(3), dims(2), dims(1) - write (dim_str2, '(I0," ",I0," ",I0)') dims(1), dims(2), dims(3) - - open (newunit=unit, file=filename, status='old', action='write', position='append') - - write (unit, '(A)') ' ' - write (unit, '(A,F8.4)') ' ' - - close (unit) - end subroutine xdmf_write_timestep - - subroutine xdmf_write_step_header(filename, t, time, npoints) - character(len=*), intent(in) :: filename - integer, intent(in) :: t - real(8), intent(in) :: time - integer, intent(in) :: npoints - integer :: unit - character(len=20) :: ts + end subroutine - write (ts, '(I0)') t - - open (newunit=unit, file=filename, position="append") - - write (unit, '(A)') ' ' - write (unit, '(A,F12.6,A)') ' ' + write (unit, '(A)') '' + write (unit, '(A)') '' + end subroutine + + subroutine xdmf_create_grid_step_info(unit, stepName, stepValue, h5_filename, ncoords) + !Requires file already open + !h5_file must contain a coords field + integer, intent(in) :: unit + character(len=*), intent(in) :: stepName + real, intent(in) :: stepValue + character(len=*), intent(in) :: h5_filename + integer, intent(in) :: ncoords + + write (unit, '(A,A,A)' ) '' + write (unit, '(A,G0,A)' ) '' + end subroutine xdmf_close_grid + + subroutine xdmf_write_attribute(unit, attributeName) + integer, intent(in) :: unit + character(len=*), intent(in) :: attributeName + write (unit, '(A,A,A)' ) '' end subroutine xdmf_write_attribute - subroutine xdmf_write_step_footer(filename) - character(len=*), intent(in) :: filename - integer :: unit - - open (newunit=unit, file=filename, position="append") - write (unit, '(A)') ' ' - close (unit) - end subroutine xdmf_write_step_footer - - subroutine xdmf_write_step(filename, t, time, npoints) - character(len=*), intent(in) :: filename - integer, intent(in) :: t - real(8), intent(in) :: time - integer, intent(in) :: npoints - integer :: unit - character(len=20) :: ts - - write (ts, '(I0)') t - - open (newunit=unit, file=filename, position="append") - - write (unit, '(A)') ' ' - write (unit, '(A,F12.6,A)') ' ' - - close (unit) - - end subroutine - - subroutine xdmf_close_file(filename) - character(len=*), intent(in) :: filename - integer :: unit - - open (newunit=unit, file=filename, status='old', action='write', position='append') - write (unit, '(A)') ' ' - write (unit, '(A)') ' ' - write (unit, '(A)') '' - close (unit) - end subroutine xdmf_close_file + subroutine xdmf_close_attribute(unit) + integer, intent(in) :: unit + write (unit, '(A)' ) '' + end subroutine xdmf_close_attribute + + subroutine xdmf_write_hyperslab_data_item(unit, dimension_string) + integer, intent(in) :: unit + character(len=*), intent(in) :: dimension_string !int writen in space separated format Ex: '2 20 3' + write (unit, '(A,A,A)' ) '' + end subroutine xdmf_write_hyperslab_data_item + + subroutine xdmf_write_h5_acces_data_item(unit, row_offset, column_offset, row_count, column_count) + !Used on cases where we acces parts of an h5 array + integer, intent(in) :: unit, row_offset, column_offset, row_count, column_count + write (unit, '(A,A,A)' ) '' + write (unit, '(I0,1X,I0)') row_offset, column_offset + write (unit, '(I0,1X,I0)') 1, 1 + write (unit, '(I0,1X,I0)') row_count, column_count + end subroutine xdmf_write_h5_acces_data_item + + subroutine xdmf_write_h5_data_item(unit, h5_filename, h5_data_path, dimension_string) + integer, intent(in) :: unit + character(len=*), intent(in) :: h5_filename + character(len=*), intent(in) :: h5_data_path + character(len=*), intent(in) :: dimension_string !int writen in space separated format Ex: '2 20 3' + write (unit, '(A,A,A)') '' + write (unit, '(A,A,A)') h5_filename,':', h5_data_path + end subroutine xdmf_write_h5_data_item + + subroutine xdmf_close_data_item(unit) + integer, intent(in) :: unit + write (unit, '(A)') '' + end subroutine xdmf_close_data_item subroutine create_h5_file(filename, file_id) character(len=*), intent(in) :: filename diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 5e6e8660..56b19fe1 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -1139,92 +1139,92 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) character(len=BUFSIZE) :: nEntrada integer :: ios integer :: freq - - nEntrada = join_path(test_folder, test_name) - - 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) - simulationMaterialsPtr => simulationMaterials - call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) - call sgg_set_Med(dummysgg, simulationMaterialsPtr) - - dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) - call sgg_set_Sweep(dummysgg, dummySweep) - dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) - call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) - call sgg_set_NumPlaneWaves(dummysgg, 1) - allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) - call sgg_set_Alloc(dummysgg, allocationRange) - - frequencySliceCurrentObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) - call sgg_add_observation(dummysgg, frequencySliceCurrentObservable) - - frequencySliceElectricXObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iExC) - call sgg_add_observation(dummysgg, frequencySliceElectricXObservable) - - 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) - - 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) - end do - sinpml_fullsizePtr => sinpml_fullsize - - dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) - - call init_outputs(dummysgg, media, sinpml_fullsize, tagNumbers, dummyBound, dummyControl, & - outputRequested, ThereAreWires) - outputs => GetOutputs() - - !--- 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 file existance - do iter = 1, expectedNumFrequencies - write (freqIdName, '(i3)') iter - expectedPath = add_extension(remove_extension(outputs(1)%frequencySliceProbe%pvdPath),'_fq'//'000'//trim(adjustl(freqIdName))//'.vtu') - test_err = test_err + assert_true(file_exists(expectedPath), 'Primera iteracion no encontrada') - end do - - call close_outputs() - - expectedPath = trim(adjustl(outputs(1)%frequencySliceProbe%pvdPath)) - test_err = test_err + assert_true(file_exists(expectedPath), 'PVD file not found') - - call remove_folder(test_folder, ios) +! + !nEntrada = join_path(test_folder, test_name) +! + !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) + !simulationMaterialsPtr => simulationMaterials + !call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + !call sgg_set_Med(dummysgg, simulationMaterialsPtr) +! + !dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + !call sgg_set_Sweep(dummysgg, dummySweep) + !dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) + !call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) + !call sgg_set_NumPlaneWaves(dummysgg, 1) + !allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + !call sgg_set_Alloc(dummysgg, allocationRange) +! + !frequencySliceCurrentObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) + !call sgg_add_observation(dummysgg, frequencySliceCurrentObservable) +! + !frequencySliceElectricXObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iExC) + !call sgg_add_observation(dummysgg, frequencySliceElectricXObservable) +! + !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) +! + !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) + !end do + !sinpml_fullsizePtr => sinpml_fullsize +! + !dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) +! + !call init_outputs(dummysgg, media, sinpml_fullsize, tagNumbers, dummyBound, dummyControl, & + ! outputRequested, ThereAreWires) + !outputs => GetOutputs() +! + !!--- 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 file existance + !do iter = 1, expectedNumFrequencies + ! write (freqIdName, '(i3)') iter + ! expectedPath = add_extension(remove_extension(outputs(1)%frequencySliceProbe%pvdPath),'_fq'//'000'//trim(adjustl(freqIdName))//'.vtu') + ! test_err = test_err + assert_true(file_exists(expectedPath), 'Primera iteracion no encontrada') + !end do +! + !call close_outputs() +! + !expectedPath = trim(adjustl(outputs(1)%frequencySliceProbe%pvdPath)) + !test_err = test_err + assert_true(file_exists(expectedPath), 'PVD file not found') +! + !call remove_folder(test_folder, ios) err = test_err end function diff --git a/test/output/test_xdmfAPI.F90 b/test/output/test_xdmfAPI.F90 index 05eb17eb..c7e5a497 100644 --- a/test/output/test_xdmfAPI.F90 +++ b/test/output/test_xdmfAPI.F90 @@ -22,7 +22,7 @@ integer function test_create_h5_file() bind(c) result(err) test_err = test_err + assert_true(file_id > 0, "create_h5_file returned invalid id") - call close_file(file_id) + call H5Fclose_f(file_id, error) inquire(file=trim(adjustl(file)), exist=exists) test_err = test_err + assert_true(exists, "HDF5 file was not created") @@ -64,7 +64,7 @@ integer function test_write_1d_dataset() bind(c) result(err) test_err = test_err + assert_integer_equal(size(data), 10, "1D dataset size mismatch") - call close_file(file_id) + call H5Fclose_f(file_id, error) deallocate(data) @@ -104,7 +104,7 @@ integer function test_write_2d_dataset() bind(c) result(err) test_err = test_err + assert_integer_equal(size(data,1),4,"2D dim1 mismatch") test_err = test_err + assert_integer_equal(size(data,2),5,"2D dim2 mismatch") - call close_file(file_id) + call H5Fclose_f(file_id, error) deallocate(data) @@ -145,7 +145,7 @@ integer function test_write_3d_dataset() bind(c) result(err) test_err = test_err + assert_integer_equal(size(data,2),3,"3D dim2 mismatch") test_err = test_err + assert_integer_equal(size(data,3),3,"3D dim3 mismatch") - call close_file(file_id) + call H5Fclose_f(file_id, error) deallocate(data) @@ -166,7 +166,7 @@ integer function test_xdmf_file_creation() bind(c) result(err) character(len=14), parameter :: folder='testing_folder' character(len=1024) :: file integer :: test_err = 0 - integer :: error + integer :: error, unit logical :: exists integer :: dims(3) @@ -175,19 +175,32 @@ integer function test_xdmf_file_creation() bind(c) result(err) dims = [4,4,4] - call xdmf_create_file(trim(adjustl(file))) + + open(newunit=unit, file=trim(file), position='append') + call xdmf_write_header_file(unit) - call xdmf_write_timestep(trim(adjustl(file)),0.0d0, "data.h5:/Efield", "grid0", dims) + call xdmf_create_grid_step_info(unit,"step0",0.0,"data.h5",dims(1)*dims(2)*dims(3)) - call xdmf_close_file(trim(adjustl(file))) + call xdmf_write_attribute(unit,"Efield") - inquire(file=trim(adjustl(file)), exist=exists) + call xdmf_write_h5_data_item(unit,"data.h5","/Efield","4 4 4") + + call xdmf_close_data_item(unit) + call xdmf_close_attribute(unit) + call xdmf_close_grid(unit) + + call xdmf_write_footer_file(unit) + close(unit) + + + inquire(file=trim(file), exist=exists) test_err = test_err + assert_true(exists, "XDMF file not created") err = test_err call remove_folder(folder, error) -end function + +end function integer function test_xdmf_file_with_h5data() bind(c) result(err) use HDF5 @@ -199,16 +212,15 @@ integer function test_xdmf_file_with_h5data() bind(c) result(err) character(len=20), parameter :: folder = "testing_folder" character(len=1024) :: xdmf_file, h5_file integer :: test_err = 0 - integer :: error, t + integer :: error, t, unit logical :: exists integer :: dims(3) integer(HID_T) :: file_id - real(dp), allocatable ,dimension(:,:) :: Efield + real(dp), allocatable :: Efield(:,:), coords(:,:) real(dp) :: time - character(len=12) :: ts - integer :: i,j + character(len=20) :: ts + integer :: i,j, npoints - ! Create test folder call create_folder(folder, error) xdmf_file = join_path(folder, "test_api.xdmf") @@ -217,41 +229,60 @@ integer function test_xdmf_file_with_h5data() bind(c) result(err) call H5open_f(error) ! Create HDF5 file - call create_h5_file(trim(adjustl(h5_file)), file_id) + call create_h5_file(trim(h5_file), file_id) + + dims = [3,3,1] ! 2D grid stored as 3D with depth 1 + npoints = dims(1)*dims(2) + + ! Allocate and write coords data: shape (npoints,3) + allocate(coords(npoints,3)) + do j = 1, dims(2) + do i = 1, dims(1) + coords((j-1)*dims(1)+i,1) = real(i-1, dp) ! X + coords((j-1)*dims(1)+i,2) = real(j-1, dp) ! Y + coords((j-1)*dims(1)+i,3) = 0.0_dp ! Z + end do + end do + call write_dataset(file_id,"coords",coords) + deallocate(coords) ! Create XDMF file - call xdmf_create_file(trim(adjustl(xdmf_file))) - - dims = [3,3,1] ! 2D grid stored as 3D with depth 1 + open(newunit=unit,file=trim(xdmf_file),position='append') + call xdmf_write_header_file(unit) do t = 1, 5 - time = real(t-1, dp)*0.1_dp - allocate(Efield(dims(1), dims(2))) - Efield = 0.0_dp - do j = 1, dims(2) - do i = 1, dims(1) - Efield(i,j) = i + j + t - 1 - end do - end do + time = real(t-1,dp)*0.1_dp + + allocate(Efield(dims(1),dims(2))) + do j=1,dims(2) + do i=1,dims(1) + Efield(i,j) = i + j + t - 1 + end do + end do - write(ts,'(A,I0)') "Efield_", t + write(ts,'("Efield_",I0)') t - call write_dataset(file_id, trim(adjustl(ts)), Efield) + ! Write timestep data + call write_dataset(file_id,trim(ts),Efield) - call xdmf_write_timestep(trim(adjustl(xdmf_file)), time, & - trim(adjustl(h5_file))//":/Efield"//trim(adjustl(ts)), & - "grid"//trim(adjustl(ts)), dims) + ! XDMF grid + call xdmf_create_grid_step_info(unit,trim(ts),real(time),trim(h5_file),npoints) + call xdmf_write_attribute(unit,"Efield") + call xdmf_write_h5_data_item(unit,trim(h5_file),"/"//trim(ts),"3 3 1") + call xdmf_close_data_item(unit) + call xdmf_close_attribute(unit) + call xdmf_close_grid(unit) deallocate(Efield) end do + call xdmf_write_footer_file(unit) + close(unit) + call H5Fclose_f(file_id,error) - call xdmf_close_file(trim(adjustl(xdmf_file))) - call close_file(file_id) - - inquire(file=trim(adjustl(xdmf_file)), exist=exists) - test_err = test_err + assert_true(exists, "XDMF file not created") + inquire(file=trim(xdmf_file),exist=exists) + test_err = test_err + assert_true(exists,"XDMF file not created") - call remove_folder(folder, error) + call remove_folder(folder,error) call H5close_f(error) err = test_err From 95710bac176b37f2bd194130c2cf7da6c7c5a542 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 5 Mar 2026 17:06:24 +0100 Subject: [PATCH 91/96] Propagate xdmf api to frecuency slices --- src_main_pub/timestepping.F90 | 1 + src_output/frequencySliceProbeOutput.F90 | 246 ++++++++++------------- src_output/movieProbeOutput.F90 | 53 ----- src_output/output.F90 | 6 +- src_output/outputTypes.F90 | 2 +- 5 files changed, 117 insertions(+), 191 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index f4ff111a..0d6f7fb5 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -2817,6 +2817,7 @@ subroutine solver_end(this) if (this%thereAre%Observation) THEN #ifdef CompileWithNewOutputModule call flush_outputs(this%sgg%tiempo, this%n, this%control, fieldReference, this%bounds, .TRUE.) + call close_outputs() #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 diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index f75fa27c..6c10ac05 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -6,6 +6,8 @@ module mod_frequencySliceProbeOutput use mod_outputUtils use mod_volumicProbeUtils use mod_directoryUtils + use HDF5 + use mod_xdmfAPI implicit none private @@ -15,6 +17,7 @@ module mod_frequencySliceProbeOutput public :: init_frequency_slice_probe_output public :: update_frequency_slice_probe_output public :: flush_frequency_slice_probe_output + public :: close_frequency_slice_probe_output !=========================== !=========================== @@ -26,8 +29,6 @@ module mod_frequencySliceProbeOutput private :: save_current private :: save_current_module private :: save_current_component - private :: update_pvd - private :: write_vtu_frequency_slice !=========================== !=========================== @@ -46,20 +47,14 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI integer :: i integer :: error - character(len=BUFSIZE) :: pdvFileName + character(len=BUFSIZE) :: filename 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_freq(this, outputTypeExtension, field, control) - - pdvFileName = add_extension(get_last_component(this%path), pvdExtension ) - this%pvdPath = join_path(this%path, pdvFileName) - - call create_folder(this%path, error) - 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) @@ -67,21 +62,9 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI 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)) - 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_CKIND, 0.0_CKIND)) - elseif (any(VOLUMIC_Y_MEASURE == this%component)) then - 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_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%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)) 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)) @@ -91,8 +74,105 @@ subroutine init_frequency_slice_probe_output(this, lowerBound, upperBound, timeI this%auxExp_H(i) = this%auxExp_E(i)*Exp(mcpi2*this%frequencySlice(i)*timeInterval*0.5_RKIND) end do + this%path = get_output_path_freq(this, outputTypeExtension, field, control) + + filename = get_last_component(this%path) + this%filesPath = join_path(this%path, filename) + + call create_folder(this%path, error) + call create_bin_file(this%filesPath, error) end subroutine init_frequency_slice_probe_output + subroutine create_bin_file(filePath, error) + character(len=*), intent(in) :: filePath + integer, intent(out) :: error + call create_file_with_path(add_extension(filePath, binaryExtension), error) + end subroutine + + subroutine write_bin_file(this) + ! Check type definition for binary format + type(frequency_slice_probe_output_t), intent(inout) :: this + integer :: i, f, unit + !We rewrite the binary as simulation continues + open (unit=unit, file=add_extension(this%filesPath, binaryExtension), & + status='old', form='unformatted', action='write', access='stream') + do f = 1, this%nFreq + do i = 1, this%nPoints + write(unit) this%frequencySlice(f), this%coords(1,i), this%coords(2,i), this%coords(3,i), this%xValueForFreq(f,i), this%yValueForFreq(f,i), this%xValueForFreq(f,i) + end do + end do + flush (unit) + close (unit) + end subroutine + + subroutine write_to_xdmf_h5(this) + !If we call to this subrutine it will always replace old values + type(frequency_slice_probe_output_t), intent(inout) :: this + + integer(HID_T) :: file_id + integer :: f, error, xdmfunit + real(dp), allocatable, dimension(:, :) :: coordsReal + character(len=256) :: h5_filename, h5_filepath + character(len=256) :: xdmf_filename + character(len=10) :: dimension_string + character(len=10) :: nCoordsString + character(len=14) :: stepName + h5_filepath = add_extension(this%filesPath, ".h5") + h5_filename = get_last_component(h5_filepath) + + call H5open_f(error) + call H5Fopen_f(trim(h5_filepath), H5F_ACC_RDWR_F, file_id, error) + write(dimension_string, '(I0,1X,I0)') this%nPoints, this%nFreq + write(nCoordsString, '(I0, I0)') this%nPoints, 1 + do f = 1, this%nFreq + write(stepName, '((I5.5))') f + call append_rows_dataset(file_id, "xVal", reshape(real(abs(this%xValueForFreq(f, :)), dp), [1, this%nPoints])) + call append_rows_dataset(file_id, "yVal", reshape(real(abs(this%yValueForFreq(f, :)), dp), [1, this%nPoints])) + call append_rows_dataset(file_id, "zVal", reshape(real(abs(this%zValueForFreq(f, :)), dp), [1, this%nPoints])) + + xdmf_filename = add_extension(add_extension(this%filesPath, ".fs_"//stepName), ".xdmf") + open(newunit=xdmfunit, file=trim(xdmf_filename), status='replace', position='append', iostat=error) + + call xdmf_write_header_file(xdmfunit) + + call xdmf_create_grid_step_info(xdmfunit, stepName, real(this%frequencySlice(f)), trim(h5_filename), this%nPoints) + + call xdmf_write_attribute(xdmfunit, 'xVal') + call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) + call xdmf_write_h5_acces_data_item(xdmfunit, 0, f - 1, this%nPoints, this%nFreq) + call xdmf_close_data_item(xdmfunit) + call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/xVal', dimension_string) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_attribute(xdmfunit) + + call xdmf_write_attribute(xdmfunit, 'yVal') + call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) + call xdmf_write_h5_acces_data_item(xdmfunit, 0, f - 1, this%nPoints, this%nFreq) + call xdmf_close_data_item(xdmfunit) + call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/yVal', dimension_string) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_attribute(xdmfunit) + + call xdmf_write_attribute(xdmfunit, 'zVal') + call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) + call xdmf_write_h5_acces_data_item(xdmfunit, 0, f - 1, this%nPoints, this%nFreq) + call xdmf_close_data_item(xdmfunit) + call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/zVal', dimension_string) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_data_item(xdmfunit) + call xdmf_close_attribute(xdmfunit) + + call xdmf_close_grid(xdmfunit) + + call xdmf_write_footer_file(xdmfunit) + close(xdmfunit) + end do + call H5Fclose_f(file_id, error) + call H5close_f(error) + end subroutine + 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 @@ -287,120 +367,14 @@ subroutine save_field(valorComplex, auxExp, fieldValue, nFreq, coordIdx) 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%pvdPath) - end do + call write_bin_file(this) end subroutine flush_frequency_slice_probe_output - subroutine write_vtu_frequency_slice(this, freq, filename) - implicit none + subroutine close_frequency_slice_probe_output(this) + type(frequency_slice_probe_output_t), intent(inout) :: this + call write_to_xdmf_h5(this) + end subroutine - type(frequency_slice_probe_output_t), intent(in) :: this - 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 :: Componentx(:), Componenty(:), Componentz(:) - logical :: writeX, writeY, writeZ - - !!================= Determine the measure type ================= - !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) - !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) - ! 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 - ! Componentx(i) = abs(this%xValueForFreq(freq, i)) - ! end do - !end if -! - !if (writeY) then - ! allocate (Componenty(npts)) - ! do i = 1, npts - ! Componenty(i) = abs(this%yValueForFreq(freq, i)) - ! end do - !end if -! - !if (writeZ) then - ! allocate (Componentz(npts)) - ! do i = 1, npts - ! Componentz(i) = abs(this%zValueForFreq(freq, i)) - ! end do - !end if -! - !!================= 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=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=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=requestName, 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 - - subroutine update_pvd(this, freq, PVDfilePath) - implicit none - type(frequency_slice_probe_output_t), intent(in) :: this - integer, intent(in) :: freq - character(len=*), intent(in) :: PVDfilePath - character(len=64) :: ts - character(len=256) :: newVTUfilename - integer :: unit - - -! write (newVTUfilename, '(A,A,I4.4,A)') trim(remove_extension(this%pvdPath)), '_fq', freq, '.vtu' -! call write_vtu_frequency_slice(this, freq, newVTUfilename) -! -! write (ts, '(ES16.8)') this%frequencySlice(freq) -! -! open (newunit=unit, file=trim(PVDfilePath), status='old', position='append') -! write (unit, '(A)') ' ' -! close(unit) - end subroutine update_pvd end module mod_frequencySliceProbeOutput diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 830fde7e..9a4f8f55 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -22,8 +22,6 @@ module mod_movieProbeOutput ! Private helpers !=========================== ! Output & File Management - private :: write_vtu_timestep - private :: update_pvd private :: clear_memory_data contains @@ -261,33 +259,6 @@ subroutine write_to_xdmf_h5(this) call H5close_f(error) end subroutine write_to_xdmf_h5 - subroutine read_bin_file(this) - ! Check type definition for binary format - type(movie_probe_output_t), intent(inout) :: this - integer :: unit - integer :: iostat - real(kind=RKIND_tiempo) timeStamp - integer(kind=SINGLE) :: x, y, z - real(kind=RKIND) :: xVal, yVal, zVal - integer(kind=4) :: dataSize - - open (unit=unit, file=add_extension(this%path, binaryExtension), & - status='old', form='unformatted', access='stream', iostat=iostat) - if (iostat /= 0) then - print *, 'Error opening file!' - return - end if - - ! Read until end-of-file - do - read (unit, iostat=iostat) timeStamp, x, y, z, xVal, yVal, zVal - if (iostat /= 0) exit ! EOF or error - print *, timeStamp, x, y, z, xVal, yVal, zVal - end do - - close (unit) - end subroutine - function get_output_path(this, outputTypeExtension, field, mpidir) result(path) type(movie_probe_output_t), intent(in) :: this character(len=*), intent(in) :: outputTypeExtension @@ -408,30 +379,6 @@ subroutine save_field(fieldData, timeIdx, coordIdx, fieldValue) fieldData(timeIdx, coordIdx) = fieldValue end subroutine save_field - subroutine write_vtu_timestep(this, stepIndex, filename) - type(movie_probe_output_t), intent(in) :: this - integer, intent(in) :: stepIndex - character(len=*), intent(in) :: filename - - 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 - - end subroutine write_vtu_timestep - - subroutine update_pvd(this, stepIndex, PVDfilePath) - implicit none - type(movie_probe_output_t), intent(in) :: this - integer, intent(in) :: stepIndex - character(len=*), intent(in) :: PVDfilePath - character(len=64) :: ts - character(len=BUFSIZE) :: newVTUfilename - integer :: unit - - end subroutine update_pvd - subroutine clear_memory_data(this) type(movie_probe_output_t), intent(inout) :: this this%nTimesFlushed = this%nTimesFlushed + this%nTime diff --git a/src_output/output.F90 b/src_output/output.F90 index 161695aa..8b9ef474 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -87,6 +87,10 @@ module output flush_farField_probe_output end interface + + interface close_solver_output + module procedure close_frequency_slice_probe_output + end interface contains function GetOutputs() result(r) @@ -444,7 +448,7 @@ subroutine close_outputs() case (VOLUMIC_CURRENT_PROBE_ID) case (MOVIE_PROBE_ID) case (FREQUENCY_SLICE_PROBE_ID) - call close_pvd(outputs(i)%frequencySliceProbe%pvdPath) + call close_solver_output(outputs(i)%frequencySliceProbe) end select end do end subroutine diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index b9fd4b8e..a96b0dc8 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -183,7 +183,7 @@ module outputTypes complex(kind=CKIND), allocatable :: xValueForFreq(:, :) !(time, coordIdx) complex(kind=CKIND), allocatable :: yValueForFreq(:, :) !(time, coordIdx) complex(kind=CKIND), allocatable :: zValueForFreq(:, :) !(time, coordIdx) - character(len=BUFSIZE) :: pvdPath + character(len=BUFSIZE) :: filesPath end type frequency_slice_probe_output_t !===================================================== From 693029f4e3acf3f20e3353c2f523ce32376c9f55 Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 5 Mar 2026 17:22:16 +0100 Subject: [PATCH 92/96] removed unused fdtype utils --- src_output/bulkProbeOutput.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src_output/bulkProbeOutput.F90 b/src_output/bulkProbeOutput.F90 index a98b49c9..a468e3ac 100644 --- a/src_output/bulkProbeOutput.F90 +++ b/src_output/bulkProbeOutput.F90 @@ -2,7 +2,6 @@ module mod_bulkProbeOutput use FDETYPES use mod_UTILS use outputTypes - use FDETYPES_TOOLS use mod_outputUtils implicit none From 3f5245e15f3c22f0bd5a31541e8e9dc15f37321e Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 5 Mar 2026 17:34:24 +0100 Subject: [PATCH 93/96] remove vtkfortran dependency --- external/VTKFortran | 1 - 1 file changed, 1 deletion(-) delete mode 160000 external/VTKFortran diff --git a/external/VTKFortran b/external/VTKFortran deleted file mode 160000 index 1b3585cb..00000000 --- a/external/VTKFortran +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 1b3585cb4bf623d793ab79b030488abb268d7338 From d87c59c79377e7d17fb478e2b5b009d8eb560f5b Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 5 Mar 2026 17:38:12 +0100 Subject: [PATCH 94/96] restore output test --- test/output/test_output.F90 | 172 ++++++++++++++++++------------------ 1 file changed, 86 insertions(+), 86 deletions(-) diff --git a/test/output/test_output.F90 b/test/output/test_output.F90 index 56b19fe1..597459f6 100644 --- a/test/output/test_output.F90 +++ b/test/output/test_output.F90 @@ -1139,92 +1139,92 @@ integer function test_flush_frequency_slice_probe() bind(c) result(err) character(len=BUFSIZE) :: nEntrada integer :: ios integer :: freq -! - !nEntrada = join_path(test_folder, test_name) -! - !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) - !simulationMaterialsPtr => simulationMaterials - !call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) - !call sgg_set_Med(dummysgg, simulationMaterialsPtr) -! - !dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) - !call sgg_set_Sweep(dummysgg, dummySweep) - !dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) - !call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) - !call sgg_set_NumPlaneWaves(dummysgg, 1) - !allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) - !call sgg_set_Alloc(dummysgg, allocationRange) -! - !frequencySliceCurrentObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) - !call sgg_add_observation(dummysgg, frequencySliceCurrentObservable) -! - !frequencySliceElectricXObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iExC) - !call sgg_add_observation(dummysgg, frequencySliceElectricXObservable) -! - !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) -! - !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) - !end do - !sinpml_fullsizePtr => sinpml_fullsize -! - !dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) -! - !call init_outputs(dummysgg, media, sinpml_fullsize, tagNumbers, dummyBound, dummyControl, & - ! outputRequested, ThereAreWires) - !outputs => GetOutputs() -! - !!--- 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 file existance - !do iter = 1, expectedNumFrequencies - ! write (freqIdName, '(i3)') iter - ! expectedPath = add_extension(remove_extension(outputs(1)%frequencySliceProbe%pvdPath),'_fq'//'000'//trim(adjustl(freqIdName))//'.vtu') - ! test_err = test_err + assert_true(file_exists(expectedPath), 'Primera iteracion no encontrada') - !end do -! - !call close_outputs() -! - !expectedPath = trim(adjustl(outputs(1)%frequencySliceProbe%pvdPath)) - !test_err = test_err + assert_true(file_exists(expectedPath), 'PVD file not found') -! - !call remove_folder(test_folder, ios) + + nEntrada = join_path(test_folder, test_name) + + 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) + simulationMaterialsPtr => simulationMaterials + call sgg_set_NumMedia(dummysgg, size(simulationMaterials)) + call sgg_set_Med(dummysgg, simulationMaterialsPtr) + + dummySweep = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Sweep(dummysgg, dummySweep) + dummySinpmlSweep = create_xyz_limit_array(1, 1, 1, 5, 5, 5) + call sgg_set_SINPMLSweep(dummysgg, dummySinpmlSweep) + call sgg_set_NumPlaneWaves(dummysgg, 1) + allocationRange = create_xyz_limit_array(0, 0, 0, 6, 6, 6) + call sgg_set_Alloc(dummysgg, allocationRange) + + frequencySliceCurrentObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) + call sgg_add_observation(dummysgg, frequencySliceCurrentObservable) + + frequencySliceElectricXObservable = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iExC) + call sgg_add_observation(dummysgg, frequencySliceElectricXObservable) + + 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) + + 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) + end do + sinpml_fullsizePtr => sinpml_fullsize + + dummyControl = create_control_flags(nEntradaRoot=nEntrada, mpidir=mpidir) + + call init_outputs(dummysgg, media, sinpml_fullsize, tagNumbers, dummyBound, dummyControl, & + outputRequested, ThereAreWires) + outputs => GetOutputs() + + !--- 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 file existance + do iter = 1, expectedNumFrequencies + write (freqIdName, '(i3)') iter + expectedPath = add_extension(remove_extension(outputs(1)%frequencySliceProbe%pvdPath),'_fq'//'000'//trim(adjustl(freqIdName))//'.vtu') + test_err = test_err + assert_true(file_exists(expectedPath), 'Primera iteracion no encontrada') + end do + + call close_outputs() + + expectedPath = trim(adjustl(outputs(1)%frequencySliceProbe%pvdPath)) + test_err = test_err + assert_true(file_exists(expectedPath), 'PVD file not found') + + call remove_folder(test_folder, ios) err = test_err end function From 2a96464eac0c7e3d6ea79ced59119f71fe7087cf Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Thu, 12 Mar 2026 12:15:12 +0100 Subject: [PATCH 95/96] Change h5 format to store 4d array for each requested component --- src_output/frequencySliceProbeOutput.F90 | 45 +-- src_output/movieProbeOutput.F90 | 233 ++++++++++----- src_output/output.F90 | 4 + src_output/outputTypes.F90 | 3 + src_output/xdmfAPI.F90 | 360 ++++++++++++++++++++--- src_utils/directoryUtils.F90 | 2 +- test/output/test_xdmfAPI.F90 | 2 +- 7 files changed, 483 insertions(+), 166 deletions(-) diff --git a/src_output/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 index 6c10ac05..1cf43bd8 100644 --- a/src_output/frequencySliceProbeOutput.F90 +++ b/src_output/frequencySliceProbeOutput.F90 @@ -126,48 +126,9 @@ subroutine write_to_xdmf_h5(this) write(nCoordsString, '(I0, I0)') this%nPoints, 1 do f = 1, this%nFreq write(stepName, '((I5.5))') f - call append_rows_dataset(file_id, "xVal", reshape(real(abs(this%xValueForFreq(f, :)), dp), [1, this%nPoints])) - call append_rows_dataset(file_id, "yVal", reshape(real(abs(this%yValueForFreq(f, :)), dp), [1, this%nPoints])) - call append_rows_dataset(file_id, "zVal", reshape(real(abs(this%zValueForFreq(f, :)), dp), [1, this%nPoints])) - - xdmf_filename = add_extension(add_extension(this%filesPath, ".fs_"//stepName), ".xdmf") - open(newunit=xdmfunit, file=trim(xdmf_filename), status='replace', position='append', iostat=error) - - call xdmf_write_header_file(xdmfunit) - - call xdmf_create_grid_step_info(xdmfunit, stepName, real(this%frequencySlice(f)), trim(h5_filename), this%nPoints) - - call xdmf_write_attribute(xdmfunit, 'xVal') - call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) - call xdmf_write_h5_acces_data_item(xdmfunit, 0, f - 1, this%nPoints, this%nFreq) - call xdmf_close_data_item(xdmfunit) - call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/xVal', dimension_string) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_attribute(xdmfunit) - - call xdmf_write_attribute(xdmfunit, 'yVal') - call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) - call xdmf_write_h5_acces_data_item(xdmfunit, 0, f - 1, this%nPoints, this%nFreq) - call xdmf_close_data_item(xdmfunit) - call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/yVal', dimension_string) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_attribute(xdmfunit) - - call xdmf_write_attribute(xdmfunit, 'zVal') - call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) - call xdmf_write_h5_acces_data_item(xdmfunit, 0, f - 1, this%nPoints, this%nFreq) - call xdmf_close_data_item(xdmfunit) - call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/zVal', dimension_string) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_attribute(xdmfunit) - - call xdmf_close_grid(xdmfunit) - - call xdmf_write_footer_file(xdmfunit) - close(xdmfunit) + call h5_append_rows_to_dataset(file_id, "xVal", reshape(real(abs(this%xValueForFreq(f, :)), dp), [1, this%nPoints])) + call h5_append_rows_to_dataset(file_id, "yVal", reshape(real(abs(this%yValueForFreq(f, :)), dp), [1, this%nPoints])) + call h5_append_rows_to_dataset(file_id, "zVal", reshape(real(abs(this%zValueForFreq(f, :)), dp), [1, this%nPoints])) end do call H5Fclose_f(file_id, error) call H5close_f(error) diff --git a/src_output/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 index 9a4f8f55..359bc78f 100644 --- a/src_output/movieProbeOutput.F90 +++ b/src_output/movieProbeOutput.F90 @@ -41,12 +41,17 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, integer :: error character(len=BUFSIZE) :: filename + real(RKIND), pointer :: xsteps(:), ysteps(:), zsteps(:) this%mainCoords = lowerBound this%auxCoords = upperBound this%component = field this%domain = domain + xsteps => problemInfo%xSteps(lowerBound%x:upperBound%x) + ysteps => problemInfo%ySteps(lowerBound%y:upperBound%y) + zsteps => problemInfo%zSteps(lowerBound%z:upperBound%z) + call find_and_store_important_coords(this%mainCoords, this%auxCoords, this%component, problemInfo, this%nPoints, this%coords) call alloc_and_init(this%timeStep, BUFSIZE, 0.0_RKIND_tiempo) @@ -61,7 +66,8 @@ subroutine init_movie_probe_output(this, lowerBound, upperBound, field, domain, call create_folder(this%path, error) call create_bin_file(this%filesPath, error) - call create_movie_files(this%filesPath, this%coords ,this%nPoints, error) + call create_movie_files(this, error, xsteps, ysteps, zsteps) + if (error/=0) print *, 'error en creacion' end subroutine init_movie_probe_output subroutine create_bin_file(filePath, error) @@ -70,33 +76,60 @@ subroutine create_bin_file(filePath, error) call create_file_with_path(add_extension(filePath, binaryExtension), error) end subroutine - subroutine create_movie_files(filePath, coords, nPoints, error) - character(len=*), intent(in) :: filePath - integer(kind=SINGLE), dimension(:, :), intent(in) :: coords - integer, intent(in) :: nPoints + subroutine create_movie_files(this, error, xsteps, ysteps, zsteps) + type(movie_probe_output_t), intent(in) :: this + real(RKIND), pointer, intent(in) :: xsteps(:), ysteps(:), zsteps(:) integer, intent(out) :: error - real(dp), allocatable, dimension(:, :) :: coordsReal + real(dp), allocatable, dimension(:, :) :: coordsReal integer(HID_T) :: file_id character(len=BUFSIZE) :: h5_filename + character(len=BUFSIZE) :: attributeBaseName + integer(SINGLE), dimension(3) :: topology_size - h5_filename = add_extension(filePath, ".h5") + h5_filename = add_extension(this%filesPath, ".h5") + topology_size(1) = this%auxCoords%x - this%mainCoords%x + 1 + topology_size(2) = this%auxCoords%y - this%mainCoords%y + 1 + topology_size(3) = this%auxCoords%z - this%mainCoords%z + 1 call H5open_f(error) call create_h5_file(trim(h5_filename), file_id) - allocate (coordsReal(3, nPoints)) - coordsReal = real(coords, dp) - call write_dataset(file_id, "coords", coordsReal) - deallocate(coordsReal) + call h5_create_rectilinear_coords_dataset(file_id, real(xsteps,dp), real(ysteps,dp), real(zsteps,dp)) + call h5_create_times_dataset(file_id, BUFSIZE) + call create_h5_data_dataset(file_id, this%component, topology_size) - call init_extendable_2d_dataset(file_id, 'xVal', nPoints, BUFSIZE) - call init_extendable_2d_dataset(file_id, 'yVal', nPoints, BUFSIZE) - call init_extendable_2d_dataset(file_id, 'zVal', nPoints, BUFSIZE) call H5Fclose_f(file_id, error) call H5close_f(error) end subroutine + subroutine create_h5_data_dataset(file_id, requestedComponent, topology_size) + integer(HID_T), intent(in) :: file_id + integer(SINGLE), intent(in) :: requestedComponent + integer(SINGLE), dimension(3), intent(in) :: topology_size + + character(len=BUFSIZE) :: attributeBaseName + + select case(requestedComponent) + case(iCur, iCurX, iCurY, iCurZ); attributeBaseName = 'CurrenDensity' + case(iMEC, iExC, iEyC, iEzC); attributeBaseName = 'ElectricField' + case(iMHC, iHxC, iHyC, iHzC); attributeBaseName = 'MagneticField' + end select + + select case(requestedComponent) + case(iCur, iMEC, iMHC) + call h5_init_extendable_dataset(file_id, trim(attributeBaseName)//'X', topology_size, BUFSIZE) + call h5_init_extendable_dataset(file_id, trim(attributeBaseName)//'Y', topology_size, BUFSIZE) + call h5_init_extendable_dataset(file_id, trim(attributeBaseName)//'Z', topology_size, BUFSIZE) + case(iCurX, iEXC, iHXC) + call h5_init_extendable_dataset(file_id, trim(attributeBaseName)//'X', topology_size, BUFSIZE) + case(iCurY, iEyC, iHyC) + call h5_init_extendable_dataset(file_id, trim(attributeBaseName)//'Y', topology_size, BUFSIZE) + case(iCurZ, iEZC, iHzC) + call h5_init_extendable_dataset(file_id, trim(attributeBaseName)//'Z', topology_size, BUFSIZE) + end select + end subroutine + 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 @@ -159,10 +192,11 @@ end subroutine update_movie_probe_output subroutine flush_movie_probe_output(this) type(movie_probe_output_t), intent(inout) :: this integer :: i - - call write_bin_file(this) - call write_to_xdmf_h5(this) - + if (this%nTime /= 0) then + call write_bin_file(this) + call write_to_h5_file(this) + call write_to_xdmf_file(this) + end if call clear_memory_data(this) end subroutine flush_movie_probe_output @@ -186,78 +220,123 @@ subroutine write_bin_file(this) close (unit) end subroutine - subroutine write_to_xdmf_h5(this) + subroutine write_to_xdmf_file(this) + type(movie_probe_output_t), intent(inout) :: this + character(len=256) :: xdmf_filename + character(len=256) :: h5_filename + character(len=256) :: attributeBaseName + integer :: xdmfunit, error + integer, dimension(3) :: topologyDimensions + integer, dimension(4) :: h5_dimensions + xdmf_filename = add_extension(this%filesPath, ".xdmf") + h5_filename = add_extension(get_last_component(this%filesPath), ".h5") + + topologyDimensions(1) = this%auxCoords%x - this%mainCoords%x + 1 + topologyDimensions(2) = this%auxCoords%y - this%mainCoords%y + 1 + topologyDimensions(3) = this%auxCoords%z - this%mainCoords%z + 1 + + h5_dimensions(1) = this%nTime + this%nTimesFlushed + h5_dimensions(2) = topologyDimensions(3) + h5_dimensions(3) = topologyDimensions(2) + h5_dimensions(4) = topologyDimensions(1) + + select case(this%component) + case(iCur, iCurX, iCurY, iCurZ); attributeBaseName = 'CurrenDensity' + case(iMEC, iExC, iEyC, iEzC); attributeBaseName = 'ElectricField' + case(iMHC, iHxC, iHyC, iHzC); attributeBaseName = 'MagneticField' + end select + + open(newunit=xdmfunit, file=trim(xdmf_filename), status='replace', position='append', iostat=error) + call xdmf_write_header_file(xdmfunit, 'movieProbe') + + call xdmf_write_topology(xdmfunit, topologyDimensions) + call xdmf_write_geometry(xdmfunit, topologyDimensions, h5_filename) + call xdmf_write_time_array(xdmfunit, this%nTime + this%nTimesFlushed, h5_filename) + + select case(this%component) + case(iCur, iMEC, iMHC) + call xdmf_write_scalar_attribute(xdmfunit, h5_dimensions, h5_filename, trim(attributeBaseName)//'X') + call xdmf_write_scalar_attribute(xdmfunit, h5_dimensions, h5_filename, trim(attributeBaseName)//'Y') + call xdmf_write_scalar_attribute(xdmfunit, h5_dimensions, h5_filename, trim(attributeBaseName)//'Z') + case(iCurX, iEXC, iHXC) + call xdmf_write_scalar_attribute(xdmfunit, h5_dimensions, h5_filename, trim(attributeBaseName)//'X') + case(iCurY, iEyC, iHyC) + call xdmf_write_scalar_attribute(xdmfunit, h5_dimensions, h5_filename, trim(attributeBaseName)//'Y') + case(iCurZ, iEZC, iHzC) + call xdmf_write_scalar_attribute(xdmfunit, h5_dimensions, h5_filename, trim(attributeBaseName)//'Z') + end select + + call xdmf_write_footer_file(xdmfunit) + + close(xdmfunit) + end subroutine + + subroutine write_to_h5_file(this) type(movie_probe_output_t), intent(inout) :: this integer(HID_T) :: file_id - integer :: t, error, xdmfunit - real(dp), allocatable, dimension(:, :) :: coordsReal + integer :: i, error, probeDimensions(3) + real(dp), allocatable, dimension(:,:,:,:) :: h5Table character(len=256) :: h5_filename, h5_filepath - character(len=256) :: xdmf_filename - character(len=10) :: dimension_string - character(len=10) :: nCoordsString - character(len=14) :: stepName + character(len=256) :: attributeBaseName h5_filepath = add_extension(this%filesPath, ".h5") h5_filename = get_last_component(h5_filepath) + !Only stores the volume associated to that probe + + probeDimensions(1) = this%auxCoords%x - this%mainCoords%x + 1 + probeDimensions(2) = this%auxCoords%y - this%mainCoords%y + 1 + probeDimensions(3) = this%auxCoords%z - this%mainCoords%z + 1 + + select case(this%component) + case(iCur, iCurX, iCurY, iCurZ); attributeBaseName = 'CurrenDensity' + case(iMEC, iExC, iEyC, iEzC); attributeBaseName = 'ElectricField' + case(iMHC, iHxC, iHyC, iHzC); attributeBaseName = 'MagneticField' + end select + call H5open_f(error) call H5Fopen_f(trim(h5_filepath), H5F_ACC_RDWR_F, file_id, error) - - write(dimension_string, '(I0,1X,I0)') this%nPoints, this%nTimesFlushed + this%nTime - write(nCoordsString, '(I0, I0)') this%nPoints, 1 - do t = 1, this%nTime - write(stepName, '((I5.5))') this%nTimesFlushed + t - call append_rows_dataset(file_id, "xVal", reshape(this%xValueForTime(t, :), [1, this%nPoints])) - call append_rows_dataset(file_id, "yVal", reshape(this%yValueForTime(t, :), [1, this%nPoints])) - call append_rows_dataset(file_id, "zVal", reshape(this%zValueForTime(t, :), [1, this%nPoints])) - if (mod(this%nTimesFlushed + t, 10) == 0) then - - xdmf_filename = add_extension(add_extension(this%filesPath, ".ts_"//stepName), ".xdmf") - open(newunit=xdmfunit, file=trim(xdmf_filename), status='replace', position='append', iostat=error) - - call xdmf_write_header_file(xdmfunit) - - call xdmf_create_grid_step_info(xdmfunit, stepName, real(this%timeStep(t)), trim(h5_filename), this%nPoints) - - call xdmf_write_attribute(xdmfunit, 'xVal') - call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) - call xdmf_write_h5_acces_data_item(xdmfunit, 0, this%nTimesFlushed + t - 1, this%nPoints, this%nTimesFlushed + this%nTime) - call xdmf_close_data_item(xdmfunit) - call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/xVal', dimension_string) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_attribute(xdmfunit) - - call xdmf_write_attribute(xdmfunit, 'yVal') - call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) - call xdmf_write_h5_acces_data_item(xdmfunit, 0, this%nTimesFlushed + t - 1, this%nPoints, this%nTimesFlushed + this%nTime) - call xdmf_close_data_item(xdmfunit) - call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/yVal', dimension_string) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_attribute(xdmfunit) - - call xdmf_write_attribute(xdmfunit, 'zVal') - call xdmf_write_hyperslab_data_item(xdmfunit, nCoordsString) - call xdmf_write_h5_acces_data_item(xdmfunit, 0, this%nTimesFlushed + t - 1, this%nPoints, this%nTimesFlushed + this%nTime) - call xdmf_close_data_item(xdmfunit) - call xdmf_write_h5_data_item(xdmfunit, trim(h5_filename), '/zVal', dimension_string) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_data_item(xdmfunit) - call xdmf_close_attribute(xdmfunit) - - call xdmf_close_grid(xdmfunit) - - call xdmf_write_footer_file(xdmfunit) - close(xdmfunit) - endif - end do - + call h5_append_rows_to_dataset(file_id, 'times', this%timeStep(:this%nTime)) + + allocate(h5Table(probeDimensions(1), probeDimensions(2), probeDimensions(3), this%nTime)) !(x,y,z,t) + if (any([iCur, iMEC, iMHC, iCurX, iExC, iHxC]==this%component)) then + h5Table = 0_dp + do i=1, this%nPoints !Readjust idx into hyperslab (x,y,z,t) + h5Table(this%coords(1,i) - this%mainCoords%x + 1, & + this%coords(2,i) - this%mainCoords%y + 1, & + this%coords(3,i) - this%mainCoords%z + 1, & + : ) = this%xValueForTime(:this%nTime, i) + end do + call h5_append_rows_to_dataset(file_id, trim(attributeBaseName)//'X', h5Table) + end if + if (any([iCur, iMEC, iMHC, iCurY, iEyC, iHyC]==this%component)) then + h5Table = 0_dp + do i=1, this%nPoints !Readjust idx into hyperslab (x,y,z,t) + h5Table(this%coords(1,i) - this%mainCoords%x + 1, & + this%coords(2,i) - this%mainCoords%y + 1, & + this%coords(3,i) - this%mainCoords%z + 1, & + : ) = this%yValueForTime(:this%nTime, i) + end do + call h5_append_rows_to_dataset(file_id, trim(attributeBaseName)//'Y', h5Table) + end if + if (any([iCur, iMEC, iMHC, iCurZ, iEzC, iHzC]==this%component)) then + h5Table = 0_dp + do i=1, this%nPoints !Readjust idx into hyperslab (x,y,z,t) + h5Table(this%coords(1,i) - this%mainCoords%x + 1, & + this%coords(2,i) - this%mainCoords%y + 1, & + this%coords(3,i) - this%mainCoords%z + 1, & + : ) = this%zValueForTime(:this%nTime, i) + end do + call h5_append_rows_to_dataset(file_id, trim(attributeBaseName)//'Z', h5Table) + end if + deallocate(h5Table) + call H5Fclose_f(file_id, error) call H5close_f(error) - end subroutine write_to_xdmf_h5 + if (error/=0) stop + end subroutine write_to_h5_file function get_output_path(this, outputTypeExtension, field, mpidir) result(path) type(movie_probe_output_t), intent(in) :: this diff --git a/src_output/output.F90 b/src_output/output.F90 index 8b9ef474..8e9a3c44 100644 --- a/src_output/output.F90 +++ b/src_output/output.F90 @@ -106,6 +106,7 @@ function GetProblemInfo() result(r) end function subroutine init_outputs(sgg, media, sinpml_fullsize, materialTags, bounds, control, observationsExists, wiresExists) + type(SGGFDTDINFO), intent(in) :: sgg type(media_matrices_t), target, intent(in) :: media type(limit_t), dimension(:), target, intent(in) :: SINPML_fullsize @@ -135,6 +136,9 @@ subroutine init_outputs(sgg, media, sinpml_fullsize, materialTags, bounds, contr problemInfo%simulationBounds => bounds problemInfo%problemDimension => SINPML_fullsize problemInfo%materialTag => materialTags + problemInfo%xSteps => sgg%LineX + problemInfo%ySteps => sgg%LineY + problemInfo%zSteps => sgg%LineZ outputs => NULL() allocate (outputs(requestedOutputs)) diff --git a/src_output/outputTypes.F90 b/src_output/outputTypes.F90 index a96b0dc8..0a4bd9cf 100644 --- a/src_output/outputTypes.F90 +++ b/src_output/outputTypes.F90 @@ -211,6 +211,9 @@ module outputTypes type(bounds_t), pointer :: simulationBounds type(MediaData_t), pointer :: materialList(:) type(taglist_t), pointer :: materialTag + real(RKIND), pointer, dimension(:) :: xSteps + real(RKIND), pointer, dimension(:) :: ySteps + real(RKIND), pointer, dimension(:) :: zSteps end type problem_info_t contains diff --git a/src_output/xdmfAPI.F90 b/src_output/xdmfAPI.F90 index 1a016adc..1868755c 100644 --- a/src_output/xdmfAPI.F90 +++ b/src_output/xdmfAPI.F90 @@ -7,27 +7,92 @@ module mod_xdmfAPI integer, parameter :: dp = kind(1.0d0) - interface write_dataset + interface h5_write_dataset module procedure write_1d_dataset module procedure write_2d_dataset module procedure write_3d_dataset end interface + interface h5_init_extendable_dataset + module procedure init_extendable_1D_dataset + module procedure init_extendable_2D_dataset + module procedure init_extendable_4D_dataset + end interface + + interface h5_append_rows_to_dataset + module procedure append_rows_to_1d_dataset + module procedure append_rows_to_2d_dataset + module procedure append_rows_to_4d_dataset + end interface + contains - subroutine xdmf_write_header_file(unit) - integer :: unit - write (unit, '(A)') '' - write (unit, '(A)') '' - write (unit, '(A)') ' ' - write (unit, '(A)') ' ' - end subroutine + subroutine xdmf_write_header_file(unit, gridName) + integer, intent(in) :: unit + character (len=*), intent(in) :: gridName + write (unit, '(A)' ) '' + write (unit, '(A)' ) '' + write (unit, '(A)' ) '' + write (unit, '(A,A,A)') '' + end subroutine subroutine xdmf_write_footer_file(unit) integer :: unit write (unit, '(A)') '' write (unit, '(A)') '' write (unit, '(A)') '' - end subroutine + end subroutine + + subroutine xdmf_write_topology(unit, dimensions) + integer, intent(in) :: unit + integer, intent(in), dimension(3) :: dimensions + write (unit, '(A,I0,1X,I0,1X,I0,A)') '' !(z,y,x) + end subroutine + + subroutine xdmf_write_geometry(unit, dimensions, h5_filename) + integer, intent(in) :: unit + integer, intent(in), dimension(3) :: dimensions + character (len=*), intent(in) :: h5_filename + + write(unit, '(A)') '' + ! X coordinates + write(unit, '(A,I0,A)') '' + write(unit, '(A,A)' ) trim(h5_filename),':/coordsX' + write(unit, '(A)' ) '' + ! Y coordinates + write(unit, '(A,I0,A)') '' + write(unit, '(A,A)' ) trim(h5_filename),':/coordsY' + write(unit, '(A)' ) '' + ! Z coordinates + write(unit, '(A,I0,A)') '' + write(unit, '(A,A)' ) trim(h5_filename),':/coordsZ' + write(unit, '(A)' ) '' + ! Close JOIN and Geometry + write(unit, '(A)' ) '' + end subroutine + + subroutine xdmf_write_time_array(unit, nTime, h5_filename) + integer, intent(in) :: unit + integer, intent(in) :: nTime + character (len=*), intent(in) :: h5_filename + write(unit, '(A)' ) '' + end subroutine + + subroutine xdmf_write_scalar_attribute(unit, dimensions, h5_filename, attributeName) + integer, intent(in) :: unit + integer, intent(in), dimension(4) :: dimensions + character (len=*), intent(in) :: h5_filename + character (len=*), intent(in) :: attributeName + + write(unit, '(A,A,A)' ) '' + write(unit, '(A,I0,1X,I0,1X,I0,1X,I0,A)') '' + write(unit, '(A,A,A)' ) trim(h5_filename), ':/' ,trim(attributeName) + write(unit, '(A)' ) '' + write(unit, '(A)' ) '' + end subroutine subroutine xdmf_create_grid_step_info(unit, stepName, stepValue, h5_filename, ncoords) !Requires file already open @@ -66,29 +131,32 @@ subroutine xdmf_close_attribute(unit) write (unit, '(A)' ) '' end subroutine xdmf_close_attribute - subroutine xdmf_write_hyperslab_data_item(unit, dimension_string) - integer, intent(in) :: unit - character(len=*), intent(in) :: dimension_string !int writen in space separated format Ex: '2 20 3' - write (unit, '(A,A,A)' ) '' + subroutine xdmf_write_hyperslab_data_item(unit, offset, stride, selection, h5_dimension, h5_file_path, h5_data_path) + integer, intent(in) :: unit, offset(4), stride(4), selection(4), h5_dimension(4) + character(len=*), intent(in) :: h5_file_path, h5_data_path + write (unit, '(A,I0,1X,I0,1X,I0,1X,I0,A)') '' + call xdmf_write_h5_acces_data_item(unit, offset, stride, selection) + call xdmf_write_h5_data_path(unit, h5_dimension, h5_file_path, h5_data_path) + call xdmf_close_data_item(unit) end subroutine xdmf_write_hyperslab_data_item - subroutine xdmf_write_h5_acces_data_item(unit, row_offset, column_offset, row_count, column_count) + subroutine xdmf_write_h5_acces_data_item(unit, offset, stride, selection) !Used on cases where we acces parts of an h5 array - integer, intent(in) :: unit, row_offset, column_offset, row_count, column_count - write (unit, '(A,A,A)' ) '' - write (unit, '(I0,1X,I0)') row_offset, column_offset - write (unit, '(I0,1X,I0)') 1, 1 - write (unit, '(I0,1X,I0)') row_count, column_count + integer, intent(in) :: unit, offset(4), stride(4), selection(4) + write (unit, '(A)' ) '' + write (unit, '(I0,1X,I0,1X,I0,1X,I0)') offset(1), offset(2), offset(3), offset(4) + write (unit, '(I0,1X,I0,1X,I0,1X,I0)') stride(1), stride(2), stride(3), stride(4) + write (unit, '(I0,1X,I0,1X,I0,1X,I0)') selection(1), selection(2), selection(3), selection(4) + call xdmf_close_data_item(unit) end subroutine xdmf_write_h5_acces_data_item - subroutine xdmf_write_h5_data_item(unit, h5_filename, h5_data_path, dimension_string) - integer, intent(in) :: unit - character(len=*), intent(in) :: h5_filename - character(len=*), intent(in) :: h5_data_path - character(len=*), intent(in) :: dimension_string !int writen in space separated format Ex: '2 20 3' - write (unit, '(A,A,A)') '' - write (unit, '(A,A,A)') h5_filename,':', h5_data_path - end subroutine xdmf_write_h5_data_item + subroutine xdmf_write_h5_data_path(unit, h5_dimension, h5_file_path, h5_data_path) + integer, intent(in) :: unit, h5_dimension(4) + character(len=*), intent(in) :: h5_file_path, h5_data_path + write (unit, '(A,A,A)') ' 0) then component = component(last_slash + 1:) diff --git a/test/output/test_xdmfAPI.F90 b/test/output/test_xdmfAPI.F90 index c7e5a497..507b18a9 100644 --- a/test/output/test_xdmfAPI.F90 +++ b/test/output/test_xdmfAPI.F90 @@ -177,7 +177,7 @@ integer function test_xdmf_file_creation() bind(c) result(err) open(newunit=unit, file=trim(file), position='append') - call xdmf_write_header_file(unit) + call xdmf_write_header_file(unit, 'movieProbe') call xdmf_create_grid_step_info(unit,"step0",0.0,"data.h5",dims(1)*dims(2)*dims(3)) From e7a22d6e08973f2b2988670369beaaf210dfd5ab Mon Sep 17 00:00:00 2001 From: adrianarce-elemwave Date: Mon, 16 Mar 2026 16:09:40 +0100 Subject: [PATCH 96/96] wip --- CMakePresets.json | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/CMakePresets.json b/CMakePresets.json index 14b700d1..8b0bc189 100644 --- a/CMakePresets.json +++ b/CMakePresets.json @@ -26,17 +26,28 @@ } }, { - "name": "intel2025.1-debug", - "displayName": "Intel 2025.1 Debug", - "description": "Configure proyect for Intel oneAPI 2025.1 y OpenMP", + "name": "intel-rls", "generator": "Ninja", - "binaryDir": "${sourceDir}/build-dbg", + "binaryDir": "build-intel-rls/", + "environment": { + "I_MPI_ROOT": "/opt/intel/oneapi/mpi/latest", + "FC": "mpiifx", + "CC": "mpiicx", + "CXX": "mpiicpx" + }, "cacheVariables": { - "CMAKE_BUILD_TYPE": "Debug", - "CMAKE_C_COMPILER": "/opt/intel/oneapi/compiler/2025.1/bin/icx", - "CMAKE_CXX_COMPILER": "/opt/intel/oneapi/compiler/2025.1/bin/icpx", - "CMAKE_Fortran_COMPILER": "/opt/intel/oneapi/compiler/2025.1/bin/ifx", - "CMAKE_EXPORT_COMPILE_COMMANDS": "YES" + "CMAKE_BUILD_TYPE": "Release", + "SEMBA_FDTD_ENABLE_MPI": "ON", + "SEMBA_FDTD_ENABLE_MTLN": "ON", + "SEMBA_FDTD_ENABLE_DOUBLE_PRECISION": "ON" + } + }, + { + "name": "intel-rls-nomtln", + "inherits": "intel-rls", + "binaryDir": "build-intel-rls-nomtln/", + "cacheVariables": { + "SEMBA_FDTD_ENABLE_MTLN": "OFF" } } ]