diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 8d3b4f30..7aaf8e5a 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -29,6 +29,7 @@ jobs: mtln: ["ON", "OFF"] hdf: ["ON"] double-precision: ["OFF"] + new-output-module: ["OFF","ON"] include: # Disable by lack of space on github action @@ -89,13 +90,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=='OFF' env: SEMBA_FDTD_ENABLE_MPI: ${{ matrix.mpi }} SEMBA_FDTD_ENABLE_MTLN: ${{ matrix.mtln }} 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 f7ed4f70..fbf30376 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) @@ -27,7 +27,21 @@ option(SEMBA_FDTD_EXECUTABLE "Compiles executable" ON) 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 (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() if(SEMBA_FDTD_ENABLE_SMBJSON) add_definitions(-DCompileWithSMBJSON) endif() @@ -186,6 +200,13 @@ 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) + set(OUTPUT_LIBRARIES fdtd-output) +endif() add_subdirectory(src_conformal) set(CONFORMAL_LIBRARIES conformal) @@ -194,6 +215,8 @@ if (SEMBA_FDTD_ENABLE_TEST) add_subdirectory(test) endif() + + if(SEMBA_FDTD_COMPONENTS_LIB) add_library(semba-components "src_main_pub/anisotropic.F90" @@ -256,7 +279,8 @@ if(SEMBA_FDTD_MAIN_LIB) "src_main_pub/timestepping.F90" ) target_link_libraries(semba-main - semba-outputs + semba-outputs + ${OUTPUT_LIBRARIES} ${SMBJSON_LIBRARIES} ${MTLN_LIBRARIES}) endif() 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_main_pub/fdetypes.F90 b/src_main_pub/fdetypes.F90 index 2ddff284..6f71b7f5 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 @@ -186,6 +185,17 @@ 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] + + 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] + ! CHARACTER (LEN=*), PARAMETER :: SEPARADOR='______________' integer (kind=4), PARAMETER :: comi=1,fine=2, icoord=1,jcoord=2,kcoord=3 @@ -585,6 +595,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 @@ -607,15 +618,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 @@ -632,6 +643,7 @@ module FDETYPES logical :: thereArePMLMagneticMedia CHARACTER (LEN=BUFSIZE) :: nEntradaRoot type (coorsxyzP) :: Punto + end type type media_matrices_t @@ -859,6 +871,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_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 21eb0890..b9254a37 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 @@ -1503,10 +1507,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%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, & 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 @@ -1772,6 +1779,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 @@ -1797,6 +1808,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) @@ -1872,9 +1900,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 @@ -2023,11 +2053,21 @@ subroutine solver_run(this) subroutine updateAndFlush() integer(kind=4) :: mindum IF (this%thereAre%Observation) then +#ifdef CompileWithNewOutputModule + 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 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 @@ -2726,12 +2766,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 @@ -2777,8 +2840,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.) @@ -2799,6 +2866,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 @@ -2806,6 +2876,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) @@ -2831,7 +2902,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/CMakeLists.txt b/src_output/CMakeLists.txt new file mode 100644 index 00000000..33389f7d --- /dev/null +++ b/src_output/CMakeLists.txt @@ -0,0 +1,19 @@ +add_library(fdtd-output + "output.F90" + "outputTypes.F90" + "domain.F90" + "outputUtils.F90" + "volumicProbeUtils.F90" + "pointProbeOutput.F90" + "wireProbeOutput.F90" + "bulkProbeOutput.F90" + "movieProbeOutput.F90" + "frequencySliceProbeOutput.F90" + "farFieldProbeOutput.F90" +) +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 new file mode 100644 index 00000000..a98b49c9 --- /dev/null +++ b/src_output/bulkProbeOutput.F90 @@ -0,0 +1,184 @@ +module mod_bulkProbeOutput + use FDETYPES + use mod_UTILS + use outputTypes + use FDETYPES_TOOLS + use mod_outputUtils + implicit none + +contains + + subroutine init_bulk_probe_output(this, lowerBound, upperBound, field, domain, outputTypeExtension, mpidir) + type(bulk_current_probe_output_t), intent(out) :: this + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound + integer(kind=SINGLE), intent(in) :: mpidir, field + character(len=BUFSIZE), intent(in) :: outputTypeExtension + type(domain_t), intent(in) :: domain + + integer(kind=SINGLE) :: i + + this%mainCoords = lowerBound + this%auxCoords = upperBound + this%component = field + + this%domain = domain + this%path = get_output_path() + + call alloc_and_init(this%timeStep, BuffObse, 0.0_RKIND_tiempo) + call alloc_and_init(this%valueForTime, BuffObse, 0.0_RKIND) + call create_data_file(this%filePathTime, this%path, timeExtension, datFileExtension) + + contains + + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_coordinates_extension(this%mainCoords, this%auxCoords, mpidir) + prefixFieldExtension = get_prefix_extension(field, mpidir) + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) + return + end function get_output_path + + end subroutine init_bulk_probe_output + + subroutine update_bulk_probe_output(this, step, field) + type(bulk_current_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + type(field_data_t), intent(in) :: field + + integer(kind=SINGLE) :: i1_m, i2_m, j1_m, j2_m, k1_m, k2_m + integer(kind=SINGLE) :: i1, i2, j1, j2, k1, k2 + integer(kind=SINGLE) :: iii, jjj, kkk + + real(kind=RKIND), pointer, dimension(:, :, :) :: xF, yF, zF + real(kind=RKIND), pointer, dimension(:) :: dx, dy, dz + + i1_m = this%mainCoords%x + j1_m = this%mainCoords%y + k1_m = this%mainCoords%z + i2_m = this%auxCoords%x + j2_m = this%auxCoords%y + k2_m = this%auxCoords%z + + i1 = i1_m + j1 = j1_m + k1 = k1_m + i2 = i2_m + j2 = j2_m + k2 = k2_m + + xF => field%x + yF => field%y + zF => field%z + dx => field%deltaX + dy => field%deltaY + dz => field%deltaZ + + this%nTime = this%nTime + 1 + this%timeStep(this%nTime) = step + this%valueForTime(this%nTime) = 0.0_RKIND !Clear uninitialized value + selectcase (this%component) + case (iBloqueJx) + do JJJ = j1, j2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (yF(i1_m, JJJ, k1_m - 1) - yF(i1_m, JJJ, k2_m))*dy(JJJ) + end do + do KKK = k1, k2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (-zF(i1_m, j1_m - 1, KKK) + zF(i1_m, j2_m, KKK))*dz(KKK) + end do + + case (iBloqueJy) + do KKK = k1, k2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (-zF(i2_m, j1_m, KKK) + zF(i1_m - 1, j1_m, KKK))*dz(KKK) + end do + do III = i1, i2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (xF(III, j1_m, k2_m) - xF(III, j1_m, k1_m - 1))*dx(III) + end do + + case (iBloqueJz) + do III = i1, i2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (xF(III, j1_m - 1, k1_m) - xF(III, j2_m, k1_m))*dx(III) + end do + do JJJ = j1, j2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (-yF(i1_m - 1, JJJ, k1_m) + yF(i2_m, JJJ, k1_m))*dy(JJJ) + end do + + case (iBloqueMx) + do JJJ = j1, j2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (-yF(i1_m, JJJ, k1_m) + yF(i1_m, JJJ, k2_m + 1))*dy(JJJ) + end do + do KKK = k1, k2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (zF(i1_m, j1_m, KKK) - zF(i1_m, j2_m + 1, KKK))*dz(KKK) + end do + + case (iBloqueMy) + do KKK = k1, k2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (zF(i2_m + 1, j1_m, KKK) - zF(i1_m, j1_m, KKK))*dz(KKK) + end do + do III = i1, i2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (-xF(III, j1_m, k2_m + 1) + xF(III, j1_m, k1_m))*dx(III) + end do + + case (iBloqueMz) + do III = i1, i2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (-xF(III, j1_m, k1_m) + xF(III, j2_m + 1, k1_m))*dx(III) + end do + do JJJ = j1, j2 + this%valueForTime(this%nTime) = & + this%valueForTime(this%nTime) + & + (yF(i1_m, JJJ, k1_m) - yF(i2_m + 1, JJJ, k1_m))*dy(JJJ) + end do + + end select + + end subroutine update_bulk_probe_output + + subroutine flush_bulk_probe_output(this) + type(bulk_current_probe_output_t), intent(inout) :: this + integer :: i + integer :: unit + if (this%nTime <= 0) then + print *, "No data to write." + return + end if + + open (unit=unit, file=this%filePathTime, status="old", action="write", position="append") + + do i = 1, this%nTime + write (unit, fmt) this%timeStep(i), this%valueForTime(i) + end do + + close (unit) + call clear_time_data() + contains + subroutine clear_time_data() + this%timeStep = 0.0_RKIND_tiempo + this%valueForTime = 0.0_RKIND + + this%nTime = 0 + end subroutine clear_time_data + end subroutine flush_bulk_probe_output + +end module mod_bulkProbeOutput diff --git a/src_output/domain.F90 b/src_output/domain.F90 new file mode 100644 index 00000000..d9799478 --- /dev/null +++ b/src_output/domain.F90 @@ -0,0 +1,67 @@ +module mod_domain + use FDETYPES + use outputTypes + implicit none + + private + public :: domain_t + + interface domain_t + module procedure new_domain_time, new_domain_freq, new_domain_both, null_domain + end interface 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) :: 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 + + + 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) :: 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%fstep = (fstop - fstart) / fnum + new_domain%logarithmicSpacing = logarithmicSpacing + + 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/farFieldProbeOutput.F90 b/src_output/farFieldProbeOutput.F90 new file mode 100644 index 00000000..15ffc752 --- /dev/null +++ b/src_output/farFieldProbeOutput.F90 @@ -0,0 +1,94 @@ +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, 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 + type(cell_coordinate_t), intent(in) :: lowerBound, upperBound + integer(kind=SINGLE), intent(in) :: field + type(spheric_domain_t), intent(in) :: sphericRange + type(sim_control_t), intent(in) :: control + character(len=*), intent(in) :: fileNormalize, outputTypeExtension + type(problem_info_t), intent(in) :: problemInfo + real(kind=RKIND), intent(in) :: mu0, eps0 + + if (domain%domainType /= TIME_DOMAIN) call StopOnError(0, 0, "Unexpected domain type for farField probe") + + this%domain = domain + this%sphericRange = sphericRange + this%component = field + this%path = get_output_path() + call InitFarField(sgg, & + problemInfo%geometryToMaterialData%sggMiEx, problemInfo%geometryToMaterialData%sggMiEy, problemInfo%geometryToMaterialData%sggMiEz, & + problemInfo%geometryToMaterialData%sggMiHx, problemInfo%geometryToMaterialData%sggMiHy, problemInfo%geometryToMaterialData%sggMiHz, & + control%layoutnumber, control%size, problemInfo%simulationBounds, control%resume, & + 2025, this%path, & + lowerBound%x, upperBound%x, & + lowerBound%y, upperBound%y, & + lowerBound%z, upperBound%z, & + domain%fstart, domain%fstop, domain%fstep, & + sphericRange%phiStart, sphericRange%phiStop, sphericRange%phiStep, & + sphericRange%thetaStart, sphericRange%thetaStop, sphericRange%thetaStep, & + fileNormalize, problemInfo%problemDimension, & + control%facesNF2FF, control%NF2FFDecim, & +#ifdef CompileWithMPI + 0, 0, & +#endif + eps0, mu0) + + contains + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_coordinates_extension(this%mainCoords, this%auxCoords, control%mpidir) + prefixFieldExtension = get_prefix_extension(field, control%mpidir) + outputPath = & + trim(adjustl(outputTypeExtension))//'_'//trim(adjustl(prefixFieldExtension))//'_'//trim(adjustl(probeBoundsExtension)) + return + end function get_output_path + + end subroutine init_farField_probe_output + + subroutine update_farField_probe_output(this, ntime, bounds, fieldsReference) + type(far_field_probe_output_t), intent(inout) :: this + type(fields_reference_t), intent(in) :: fieldsReference + integer(kind=SINGLE), intent(in) :: ntime + type(bounds_t), intent(in) :: bounds + call UpdateFarField(ntime, bounds, & + fieldsReference%E%x, fieldsReference%E%y, fieldsReference%E%z, & + fieldsReference%H%x, fieldsReference%H%y, fieldsReference%H%z) + end subroutine update_farField_probe_output + + subroutine flush_farField_probe_output(this, simlulationTimeArray, timeIndex, control, fieldsReference, bounds) + type(far_field_probe_output_t), intent(out) :: this + integer, intent(in) :: timeIndex + real(KIND=RKIND_tiempo), pointer, dimension(:), intent(in) :: simlulationTimeArray + type(sim_control_t), intent(in) :: control + type(fields_reference_t), pointer, intent(in) :: fieldsReference + type(bounds_t), intent(in) :: bounds + + real(kind=RKIND_tiempo) :: flushTime + + flushTime = simlulationTimeArray(timeIndex) + call FlushFarfield(control%layoutnumber, control%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/frequencySliceProbeOutput.F90 b/src_output/frequencySliceProbeOutput.F90 new file mode 100644 index 00000000..cf06b323 --- /dev/null +++ b/src_output/frequencySliceProbeOutput.F90 @@ -0,0 +1,407 @@ +module mod_frequencySliceProbeOutput + use FDETYPES + use mod_UTILS + use Report + use outputTypes + use mod_outputUtils + use mod_volumicProbeUtils + use mod_directoryUtils + 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 :: 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 + !=========================== + + !=========================== + +contains + + 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 + 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 + + integer :: i + integer :: error + character(len=BUFSIZE) :: pdvFileName + + 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) + end do + + 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%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)) ! 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 + + 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 + type(sim_control_t), intent(in) :: control + type(problem_info_t), intent(in) :: problemInfo + type(fields_reference_t), intent(in) :: fieldsReference + + 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, 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 + + else if (any(VOLUMIC_X_MEASURE == request)) then + select case (request) + 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 + + else if (any(VOLUMIC_Y_MEASURE == request)) then + select case (request) + 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, 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, 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 + + 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 (isValidPointForCurrent(iCur, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + 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(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), dimension(:) :: auxExp + real(kind=RKIND_tiempo), intent(in) :: step + + 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 (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 + end do + end do + end do + end subroutine + + 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) :: auxExponential(:) + integer, intent(in) :: i, j, k, coordIdx, nFreq + type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND_tiempo), intent(in) :: step + + integer :: iter + complex(kind=CKIND) :: z_cplx = (0.0_RKIND, 0.0_RKIND) + real(kind=rkind) :: jdir + + jdir = computej(direction, i, j, k, fieldsReference) + + do iter = 1, nFreq + valorComplex(iter, coordIdx) = valorComplex(iter, coordIdx) + (auxExponential(iter)**step)*jdir + end do + end subroutine + + subroutine save_field_module(this, fieldInfo, simTime, request, problemInfo) + type(frequency_slice_probe_output_t), intent(inout) :: this + 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 + + 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 + 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%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 + end do + + end subroutine + + 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(:, :) + 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, auxExponential, fieldComponent(i, j, k), this%nFreq, coordIdx) + end if + end do + end do + end do + end subroutine + + 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) + 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 + 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 + 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/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/movieProbeOutput.F90 b/src_output/movieProbeOutput.F90 new file mode 100644 index 00000000..f9f97d2f --- /dev/null +++ b/src_output/movieProbeOutput.F90 @@ -0,0 +1,384 @@ +module mod_movieProbeOutput + use FDETYPES + USE mod_UTILS + use Report + use outputTypes + use mod_outputUtils + use mod_volumicProbeUtils + use vtk_fortran + implicit none + private + + !=========================== + ! Public interface + !=========================== + public :: init_movie_probe_output + public :: update_movie_probe_output + public :: flush_movie_probe_output + !=========================== + + !=========================== + ! Private helpers + !=========================== + ! Output & File Management + private :: write_vtu_timestep + private :: update_pvd + private :: clear_memory_data + +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 + 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 + + 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) + + 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) + type(movie_probe_output_t), intent(inout) :: this + 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") + 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") + 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") + 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") + end select + end if + end subroutine update_movie_probe_output + + 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%pvdPath) + 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 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 + do k = this%mainCoords%z, this%auxCoords%z + if (isValidPointForCurrent(iCur, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + 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 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 + + 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 (isValidPointForCurrent(fieldDir, i, j, k, problemInfo)) then + coordIdx = coordIdx + 1 + call save_current(currentData, this%nTime, coordIdx, fieldDir, i, j, k, fieldsReference) + end if + end do + end do + end do + 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 + + 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 + + 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)) + end if + end do + end do + end do + 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 + + 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)) + end if + end do + end do + end do + end subroutine save_field_component + + 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 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 + 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) + 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 + + 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) + type(movie_probe_output_t), intent(inout) :: this + + 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 module mod_movieProbeOutput diff --git a/src_output/output.F90 b/src_output/output.F90 new file mode 100644 index 00000000..e242d8dc --- /dev/null +++ b/src_output/output.F90 @@ -0,0 +1,456 @@ +module output + use FDETYPES + use Report + use mod_domain + use mod_outputUtils + use mod_pointProbeOutput + use mod_wireProbeOutput + use mod_bulkProbeOutput + 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 :: UNDEFINED_PROBE = -1, & + POINT_PROBE_ID = 0, & + WIRE_CURRENT_PROBE_ID = 1, & + WIRE_CHARGE_PROBE_ID = 2, & + BULK_PROBE_ID = 3, & + VOLUMIC_CURRENT_PROBE_ID = 4, & + MOVIE_PROBE_ID = 5, & + FREQUENCY_SLICE_PROBE_ID = 6, & + FAR_FIELD_PROBE_ID = 7 + + 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, target :: problemInfo + + interface init_solver_output + module procedure & + init_point_probe_output, & + init_wire_current_probe_output, & + init_wire_charge_probe_output, & + init_bulk_probe_output, & + init_movie_probe_output, & + init_frequency_slice_probe_output, & + init_farField_probe_output + end interface + + interface update_solver_output + module procedure & + update_point_probe_output, & + update_wire_current_probe_output, & + update_wire_charge_probe_output, & + update_bulk_probe_output, & + update_movie_probe_output, & + update_frequency_slice_probe_output, & + update_farField_probe_output + end interface + + 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, & + flush_farField_probe_output + + end interface +contains + + function GetOutputs() result(r) + type(solver_output_t), pointer, dimension(:) :: r + r => outputs + 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), 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 + + 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 + + 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)) + + allocate (InvEps(0:sgg%NumMedia - 1), InvMu(0:sgg%NumMedia - 1)) + outputCount = 0 + + 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 + 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 + 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 + + outputTypeExtension = trim(adjustl(control%nEntradaRoot))//'_'//trim(adjustl(sgg%observation(ii)%outputrequest)) + + 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 + + allocate (outputs(outputCount)%pointProbe) + call init_solver_output(outputs(outputCount)%pointProbe, lowerBound, outputRequestType, domain, outputTypeExtension, control%mpidir, sgg%dt) + case (iJx, iJy, iJz) + if (wiresExists) then + outputCount = outputCount + 1 + outputs(outputCount)%outputID = WIRE_CURRENT_PROBE_ID + + allocate (outputs(outputCount)%wireCurrentProbe) + call init_solver_output(outputs(outputCount)%wireCurrentProbe, lowerBound, NODE, outputRequestType, domain, problemInfo%materialList, outputTypeExtension, control%mpidir, control%wiresflavor) + end if + + 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, 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, lowerBound, upperBound, outputRequestType, domain, outputTypeExtension, control%mpidir) + !! 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) + call adjust_bound_range() + + 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, 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)) + + 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, 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 + subroutine adjust_bound_range() + select case (outputRequestType) + case (iExC, iEyC, iHzC, iMhC) + 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(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(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) + type(Obses_t), intent(in) :: observation + real(kind=RKIND_tiempo), pointer, dimension(:), intent(in) :: timeArray + 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(real(observation%InitialTime, kind=RKIND_tiempo), & + real(observation%FinalTime, kind=RKIND_tiempo), & + real(observation%TimeStep, kind=RKIND_tiempo)) + + newdomain%tstep = max(newdomain%tstep, simulationTimeStep) + + 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 + 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) + 1_SINGLE + 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 + newDomain%fstep = newDomain%fstop - newDomain%fstart + newDomain%fstop = newDomain%fstart + newDomain%fstep + end if + + newDomain%fnum = int((newDomain%fstop - newDomain%fstart)/newDomain%fstep, kind=SINGLE) + + else + newDomain = domain_t() + end if + 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 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(sim_control_t), intent(in) :: control + real(kind=RKIND), pointer, dimension(:, :, :) :: fieldComponent + type(field_data_t) :: fieldReference + type(fields_reference_t), intent(in) :: fieldsReference + real(kind=RKIND_tiempo) :: discreteTime + + discreteTime = discreteTimeArray(timeIndx) + + do i = 1, size(outputs) + select case (outputs(i)%outputID) + case (POINT_PROBE_ID) + 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, 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%component, fieldsReference) + call update_solver_output(outputs(i)%bulkCurrentProbe, discreteTime, fieldReference) + case (MOVIE_PROBE_ID) + call update_solver_output(outputs(i)%movieProbe, discreteTime, fieldsReference, control, problemInfo) + case (FREQUENCY_SLICE_PROBE_ID) + 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 default + call stoponerror(0, 0, 'Output update not implemented') + end select + end do + + end subroutine update_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_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) + 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 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) + 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%pvdPath) + case (FREQUENCY_SLICE_PROBE_ID) + call close_pvd(outputs(i)%frequencySliceProbe%pvdPath) + end select + end do + end subroutine + + subroutine create_pvd(pvdPath) + implicit none + character(len=*), intent(out) :: pvdPath + integer :: ios + integer :: unit + + 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 (unit, *) '' + write (unit, *) '' + write (unit, *) ' ' + close(unit) + end subroutine create_pvd + + subroutine close_pvd(pvdPath) + implicit none + character(len=*), intent(in) :: pvdPath + integer :: unit + integer :: ios + 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) + 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/outputTypes.F90 b/src_output/outputTypes.F90 new file mode 100644 index 00000000..58542444 --- /dev/null +++ b/src_output/outputTypes.F90 @@ -0,0 +1,201 @@ +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 + +!===================================================== +! 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 :: pvdExtension = '.pvd' + character(len=4), parameter :: datFileExtension = '.dat' + character(len=2), parameter :: timeExtension = 'tm' + character(len=2), parameter :: frequencyExtension = 'fq' + character(len=1), parameter :: wordseparation = '_' + +!===================================================== +! 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 + 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 + 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() + 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 :: 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 + 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 + 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 + 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(:) + 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), 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), allocatable :: chargeValue(:) + type(CurrentSegments), pointer :: segment + end type wire_charge_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 +#ifdef CompileWithBerengerWires + type(TSegment), pointer :: segmentBerenger +#endif +#ifdef CompileWithSlantedWires + class(Segment), pointer :: segmentSlanted +#endif + end type wire_current_probe_output_t + + type, extends(abstract_time_probe_t) :: bulk_current_probe_output_t + type(cell_coordinate_t) :: auxCoords + real(kind=RKIND), allocatable :: valueForTime(:) + end type bulk_current_probe_output_t + + 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, 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(:, :) + 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 + integer(kind=SINGLE), allocatable :: coords(:, :) + 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 + +!===================================================== +! High-level aggregation types +!===================================================== + type :: solver_output_t + 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 + 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/outputUtils.F90 b/src_output/outputUtils.F90 new file mode 100644 index 00000000..f3850dfd --- /dev/null +++ b/src_output/outputUtils.F90 @@ -0,0 +1,618 @@ +module mod_outputUtils + use FDETYPES + use outputTypes + use mod_domain + use report + implicit none + integer(kind=SINGLE), parameter :: FILE_UNIT = 400 + + private + + !=========================== + ! Public interface summary + !=========================== + public :: new_cell_coordinate + public :: get_coordinates_extension + public :: get_prefix_extension + public :: get_field_component + public :: get_field_reference + 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 + public :: fieldo + public :: create_data_file + !=========================== + + !=========================== + ! 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 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 + 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 + character(len=BUFSIZE) :: ext + character(len=BUFSIZE) :: chari, charj, chark + + write (chari, '(i7)') coordinates%x + write (charj, '(i7)') coordinates%y + write (chark, '(i7)') coordinates%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 +#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(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)') lowerCoordinates%x + write (charj, '(i7)') lowerCoordinates%y + write (chark, '(i7)') lowerCoordinates%z + + write (chari2, '(i7)') upperCoordinates%x + write (charj2, '(i7)') upperCoordinates%y + write (chark2, '(i7)') upperCoordinates%z + +#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(0, 0, '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 + +#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 (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 + 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 (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 + 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 (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 + call stoponerror(0, 0, "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 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 => 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 + + 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 => fieldReference%E%x + field%y => fieldReference%E%y + field%z => fieldReference%E%z + + field%deltaX => fieldReference%E%deltax + field%deltaY => fieldReference%E%deltay + field%deltaZ => fieldReference%E%deltaz + case (iBloqueMx, iBloqueMy, iBloqueMz) + field%x => fieldReference%H%x + field%y => fieldReference%H%y + field%z => fieldReference%H%z + + field%deltaX => fieldReference%H%deltax + field%deltaY => fieldReference%H%deltay + field%deltaZ => fieldReference%H%deltaz + end select + end function get_field_reference + + 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 + + integer function getBlockCurrentDirection(field) + integer(kind=4) :: field + select case (field) + 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 + + logical function isThinWire(field, i, j, k, problem) + integer(kind=4), intent(in) :: field, i, j, k + type(problem_info_t), intent(in) :: problem + + integer(kind=SINGLE) :: mediaIndex + + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) + isThinWire = problem%materialList(mediaIndex)%is%ThinWire + end function + + logical function isPEC(field, i, j, k, problem) + integer(kind=4), intent(in) :: field, i, j, k + type(problem_info_t), intent(in) :: problem + + integer(kind=SINGLE) :: mediaIndex + + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) + isPEC = problem%materialList(mediaIndex)%is%PEC + 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 + + integer(kind=SINGLE) :: mediaIndex + + mediaIndex = getMediaIndex(field, i, j, k, problem%geometryToMaterialData) + isSurface = problem%materialList(mediaIndex)%is%Surface + end function + + logical function isWithinBounds(field, i, j, k, problem) + integer(kind=4), intent(in) :: field, i, j, k + 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) .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) + integer(kind=4), intent(in) :: field, i, j, k + type(problem_info_t), intent(in) :: problem + + 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, 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, 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) + implicit none + + ! Input Arguments + integer(kind=single), intent(in) :: field, i, j, k + 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) + 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), 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), 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), 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), 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 + + 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 new file mode 100644 index 00000000..0c06fd67 --- /dev/null +++ b/src_output/pointProbeOutput.F90 @@ -0,0 +1,162 @@ +module mod_pointProbeOutput + use FDETYPES + use mod_UTILS + use outputTypes + use mod_domain + use mod_outputUtils + + implicit none + + private + + public :: init_point_probe_output + 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 + type(cell_coordinate_t) :: coordinates + 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%mainCoords = coordinates + + this%component = field + + 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) + 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 + allocate (this%frequencySlice(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 + 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 + call create_data_file(this%filePathFreq, this%path, frequencyExtension, datFileExtension) + end if + + contains + function get_output_path() result(outputPath) + character(len=BUFSIZE) :: probeBoundsExtension, prefixFieldExtension + character(len=BUFSIZE) :: outputPath + probeBoundsExtension = get_coordinates_extension(this%mainCoords, 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_point_probe_output + + subroutine update_point_probe_output(this, step, field) + type(point_probe_output_t), intent(inout) :: this + 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 + 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%component) + case (iEx, iEy, iEz) + do iter = 1, this%nFreq + this%valueForFreq(iter) = & + 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%mainCoords%x, this%mainCoords%y, this%mainCoords%z)*(this%auxExp_H(iter)**step) + end do + end select + + 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() + end if + if (any(this%domain%domainType == (/FREQUENCY_DOMAIN, BOTH_DOMAIN/))) then + call flush_frequency_domain(this) + end if + contains + + subroutine flush_time_domain(this) + type(point_probe_output_t), intent(in) :: this + integer :: i + integer :: unit + + if (this%nTime <= 0) then + print *, "No data to write." + return + end if + + open (unit=unit, file=this%filePathTime, status="old", action="write", position="append") + + do i = 1, this%nTime + write (unit, '(F12.6,1X,F12.6)') this%timeStep(i), this%valueForTime(i) + end do + + close (unit) + end subroutine flush_time_domain + + subroutine flush_frequency_domain(this) + type(point_probe_output_t), intent(in) :: this + integer :: i + integer :: unit + + if (.not. allocated(this%frequencySlice) .or. .not. allocated(this%valueForFreq)) then + print *, "Error: arrays not allocated." + return + end if + + if (this%nFreq <= 0) then + print *, "No data to write." + return + end if + open (unit=unit, file=this%filePathFreq, status="replace", action="write") + + do i = 1, this%nFreq + write (unit, '(F12.6,1X,F12.6,1X,F12.6)') this%frequencySlice(i), real(this%valueForFreq(i)), aimag(this%valueForFreq(i)) + end do + + close (unit) + end subroutine flush_frequency_domain + + subroutine clear_time_data() + this%timeStep = 0.0_RKIND_tiempo + this%valueForTime = 0.0_RKIND + + this%nTime = 0 + end subroutine clear_time_data + + end subroutine flush_point_probe_output +end module diff --git a/src_output/volumicProbeUtils.F90 b/src_output/volumicProbeUtils.F90 new file mode 100644 index 00000000..8db59a66 --- /dev/null +++ b/src_output/volumicProbeUtils.F90 @@ -0,0 +1,177 @@ +module mod_volumicProbeUtils + use FDETYPES + USE mod_UTILS + 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 diff --git a/src_output/wireProbeOutput.F90 b/src_output/wireProbeOutput.F90 new file mode 100644 index 00000000..572cc288 --- /dev/null +++ b/src_output/wireProbeOutput.F90 @@ -0,0 +1,459 @@ +module mod_wireProbeOutput + use FDETYPES + USE mod_UTILS + use Report + use outputTypes + use mod_outputUtils + use wiresHolland_constants + use HollandWires + + implicit none + private + + !=========================== + ! Public interface + !=========================== + public :: init_wire_current_probe_output + public :: init_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 + !=========================== + + !=========================== + ! 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 + +#ifdef CompileWithBerengerWires + private :: update_current_berenger +#endif + +#ifdef CompileWithSlantedWires + private :: update_current_slanted +#endif + !=========================== + + 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) + call create_data_file(this%filePathTime, this%path, timeExtension, datFileExtension) + + 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 + + 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) + call create_data_file(this%filePathTime, this%path, timeExtension, datFileExtension) + + end subroutine init_wire_charge_probe_output + + !====================================================================== + ! 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') + call update_current_berenger(this, InvEps, InvMu) +#endif +#ifdef CompileWithSlantedWires + case ('slanted','semistructured') + call update_current_slanted(this) +#endif + end select + end subroutine + + + subroutine update_wire_charge_probe_output(this, step) + type(wire_charge_probe_output_t), intent(inout) :: this + real(kind=RKIND_tiempo), intent(in) :: step + + this%nTime = this%nTime + 1 + this%timeStep(this%nTime) = step + this%chargeValue(this%nTime) = this%segment%ChargeMinus%ChargePresent + end subroutine + + !====================================================================== + ! FLUSH + !====================================================================== + subroutine flush_wire_current_probe_output(this) + type(wire_current_probe_output_t), intent(inout) :: this + integer :: i + integer :: unit + + open(unit, file=this%filePathTime, & + status='old', position='append') + + do i = 1, this%nTime + 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(unit) + + call clear_current_time_data(this) + end subroutine + + + subroutine flush_wire_charge_probe_output(this) + type(wire_charge_probe_output_t), intent(inout) :: this + integer :: i + integer :: unit + + open(unit, file=this%filePathTime, & + status='old', position='append') + + do i = 1, this%nTime + write(unit, fmt) this%timeStep(i), this%chargeValue(i) + end do + close(unit) + + call clear_charge_time_data(this) + end subroutine + + 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 + + found = .false. + this%sign = 1 + + 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 => seg + if (seg%orientadoalreves) this%sign = -1 + exit + end if + end do + +#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 + +#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 + + 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 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 + + 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 + + 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 + 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(ci))//'_'//trim(adjustl(cj))//'_'//trim(adjustl(ck)) +#endif + end function 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 + + write(nodeStr,'(i7)') node + fieldExt = get_prefix_extension(field, mpidir) + boundsExt = probe_bounds_extension(mpidir, coords) + + 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 + + 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 clear_charge_time_data(this) + type(wire_charge_probe_output_t), intent(inout) :: this + + this%timeStep = 0.0_RKIND_tiempo + this%chargeValue = 0.0_RKIND + this%nTime = 0 + end subroutine clear_charge_time_data + + subroutine update_current_holland(this, control, InvEps, InvMu) + type(wire_current_probe_output_t), intent(inout) :: this + type(sim_control_t), intent(in) :: control + real(kind=RKIND), intent(in) :: InvEps(:), InvMu(:) + + type(CurrentSegments), pointer :: seg + + seg => this%segment + + this%currentValues(this%nTime)%current = & + this%sign * seg%currentpast + + this%currentValues(this%nTime)%deltaVoltage = & + - seg%Efield_wire2main * seg%delta + + if (control%wirecrank) then + this%currentValues(this%nTime)%plusVoltage = this%sign * & + (seg%ChargePlus%ChargePresent) * seg%Lind * & + (InvMu(seg%indexmed) * InvEps(seg%indexmed)) + + 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)) + + 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%currentValues(this%nTime)%voltageDiference = & + this%currentValues(this%nTime)%plusVoltage - & + this%currentValues(this%nTime)%minusVoltage + end subroutine update_current_holland + +#ifdef CompileWithBerengerWires + subroutine update_current_berenger(this, InvEps, InvMu) + type(wire_current_probe_output_t), intent(inout) :: this + real(kind=RKIND), intent(in) :: InvEps(:), InvMu(:) + + type(TSegment), pointer :: seg + + seg => this%segmentBerenger + + this%currentValues(this%nTime)%current = & + this%sign * seg%currentpast + + this%currentValues(this%nTime)%deltaVoltage = & + - seg%field * seg%dl + + this%currentValues(this%nTime)%plusVoltage = this%sign * & + ((seg%ChargePlus + seg%ChargePlusPast) / 2.0_RKIND) * & + seg%L * (InvMu(seg%imed) * InvEps(seg%imed)) + + 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 + + class(Segment), pointer :: seg + + seg => this%segmentSlanted + + 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 + +end module mod_wireProbeOutput diff --git a/src_utils/CMakeLists.txt b/src_utils/CMakeLists.txt new file mode 100644 index 00000000..13268e21 --- /dev/null +++ b/src_utils/CMakeLists.txt @@ -0,0 +1,9 @@ +add_library(fdtd-utils + "utils.F90" + "valueReplacer.F90" + "allocationUtils.F90" + "directoryUtils.F90" +) +target_link_libraries(fdtd-utils + semba-types +) \ No newline at end of file diff --git a/src_utils/allocationUtils.F90 b/src_utils/allocationUtils.F90 new file mode 100644 index 00000000..60bf63f0 --- /dev/null +++ b/src_utils/allocationUtils.F90 @@ -0,0 +1,136 @@ +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 +#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 + 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/directoryUtils.F90 b/src_utils/directoryUtils.F90 new file mode 100644 index 00000000..cf1829f7 --- /dev/null +++ b/src_utils/directoryUtils.F90 @@ -0,0 +1,275 @@ +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 + public :: list_files + public :: create_file_with_path + public :: get_path_separator + +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=BUFSIZE) :: 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 + + !------------------------------------------------------------ + ! 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) + !------------------------------------------------------------ + 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=BUFSIZE), dimension(:), intent(out) :: files + integer, intent(out) :: nfiles + integer, intent(out) :: ios + + character(len=BUFSIZE) :: cmd + character(len=BUFSIZE) :: 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=BUFSIZE) :: folder + integer :: pos + + ios = 0 + + ! Find last slash or backslash + pos = index(fullpath, get_path_separator()) + + 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 new file mode 100644 index 00000000..da6a7b7d --- /dev/null +++ b/src_utils/utils.F90 @@ -0,0 +1,9 @@ +module mod_UTILS + use mod_allocationUtils + use mod_valueReplacer + use mod_directoryUtils + 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 new file mode 100644 index 00000000..8c3df663 --- /dev/null +++ b/src_utils/valueReplacer.F90 @@ -0,0 +1,130 @@ +module mod_valueReplacer + use FDETYPES, only: RKIND, CKIND, SINGLE, RKIND_tiempo + implicit none + private + + public :: replace_value + + interface replace_value + ! Scalars + module procedure replace_scalar_int + module procedure replace_scalar_real + module procedure replace_scalar_complex + + ! 1D arrays + module procedure replace_1d_int + module procedure replace_1d_real + module procedure replace_1d_complex + + ! 2D arrays + module procedure replace_2d_int + module procedure replace_2d_real + module procedure replace_2d_complex + + ! 3D arrays + module procedure replace_3d_int + module procedure replace_3d_real + 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_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_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_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 mod_valueReplacer diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 5b2b68c4..233504d1 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -23,9 +23,15 @@ if (SEMBA_FDTD_ENABLE_SMBJSON) 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) + endif() + 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() @@ -45,5 +51,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 08f95a01..b1675710 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/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 diff --git a/test/observation/observation_testingTools.F90 b/test/observation/observation_testingTools.F90 index 5b672a4a..920c7a28 100644 --- a/test/observation/observation_testingTools.F90 +++ b/test/observation/observation_testingTools.F90 @@ -129,23 +129,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) - 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) - type(limit_t) :: r - end function - 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) :: XI,YI,ZI,XE,YE,ZE @@ -160,60 +143,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) - 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) - 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) - 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) type(MediaData_t) :: media end function create_basic_media 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_init.F90 b/test/observation/test_observation_init.F90 index 5d0db0cf..10f31636 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) @@ -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,& @@ -74,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/observation/test_observation_update.F90 b/test/observation/test_observation_update.F90 index 28aacbf4..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. @@ -37,9 +38,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..db4c33cc 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 @@ -24,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. @@ -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 @@ -67,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. @@ -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 @@ -138,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 @@ -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 @@ -190,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. @@ -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 @@ -240,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. @@ -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 @@ -278,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. @@ -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 @@ -315,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/CMakeLists.txt b/test/output/CMakeLists.txt new file mode 100644 index 00000000..03cc0733 --- /dev/null +++ b/test/output/CMakeLists.txt @@ -0,0 +1,21 @@ +message(STATUS "Creating build system for test/output") + +add_library( + output_test_fortran + "test_output.F90" + "test_output_utils.F90" + "test_volumic_utils.F90" +) + +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 +) \ 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..8fa915cf --- /dev/null +++ b/test/output/output_tests.h @@ -0,0 +1,38 @@ +#ifdef CompileWithNewOutputModule + +#include + +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_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(); +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()); } +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_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()); } +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.F90 b/test/output/test_output.F90 new file mode 100644 index 00000000..bae1b1b6 --- /dev/null +++ b/test/output/test_output.F90 @@ -0,0 +1,1154 @@ +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 + 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 + 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) + 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=trim(nEntrada), wiresflavor='holland') + + ! Action + call init_outputs(sgg, media, sinpml, bounds, control, outputRequested, hasWires) + outputs => GetOutputs() + + ! 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') + + 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 +end function + +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 + 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 + 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 + 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) + 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=nEntrada, 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 + + ! 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') + + 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') + + !Cleanup + call remove_folder(test_folder, ios) + + err = test_err +end function + +integer function test_flush_point_probe() bind(c) result(err) + use output + use outputTypes + use mod_pointProbeOutput + 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 + + integer :: n, i + integer :: test_err = 0 + integer :: ios + + ! 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, & + 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, nEntrada, 3, 0.1_RKIND_tiempo) + + ! Action + 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%nTime = n + probe%nFreq = n + + call flush_point_probe_output(probe) + + ! 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!') + + 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!' + test_err = test_err + 1 + end if + + !Cleanup + call remove_folder(test_folder, ios) + + err = test_err +end function + +integer function test_multiple_flush_point_probe() bind(c) result(err) + use output + use outputTypes + use mod_pointProbeOutput + 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 + + real(kind=RKIND), allocatable :: expectedTime(:, :) + real(kind=RKIND), allocatable :: expectedFreq(:, :) + + integer :: n, i, unit + integer :: test_err = 0 + integer :: ios + + ! 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, & + 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, 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 + 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%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) + probe%valueForFreq(i) = -0.5*i + + expectedTime(i + n, 1) = real(i + 10) + expectedTime(i + n, 2) = 10.0*(i + 10) + + expectedFreq(i, 1) = 0.1*i + expectedFreq(i, 2) = -0.5*i + end do + + probe%nTime = n + call flush_point_probe_output(probe) + + ! 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=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 + +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 + 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) :: sinpml(6) + + type(Obses_t) :: movieObservable + type(cell_coordinate_t) :: lowerBoundMovieProbe + type(cell_coordinate_t) :: upperBoundMovieProbe + + 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 + logical :: ThereAreWires = .false. + logical :: outputRequested + integer(kind=SINGLE) :: iter + integer(kind=SINGLE) :: test_err = 0 + + 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 + + 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) + 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)) + + 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) + + 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(iter) = create_limit_t(0, 8, 0, 8, 0, 8, 10, 10, 10) + end do + + 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)%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') + + 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_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') + + !Cleanup + call remove_folder(test_folder, ios) + + 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 + 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) :: movieObservable + + 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=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 + + 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) + + 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)) + + 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) + + 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=nEntrada, mpidir=mpidir) + + call init_outputs(dummysgg, media, sinpml_fullsize, dummyBound, dummyControl, & + outputRequested, ThereAreWires) + + outputs => GetOutputs() + + 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(dummyControl, dummysgg%tiempo, 1_SINGLE, fields) + + 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') + + !Cleanup + call remove_folder(test_folder, ios) + + 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 + 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) :: movieCurrentObservable + type(Obses_t) :: movieElectricXObservable + type(Obses_t) :: movieMagneticYObservable + 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=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 + + 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) + + 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)) + + 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, 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, 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 + + 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, dummyBound, dummyControl, & + outputRequested, ThereAreWires) + + outputs => GetOutputs() + + !--- Dummy first update --- + !movieCurrentObservable + outputs(1)%movieProbe%nTime = 1 + outputs(1)%movieProbe%timeStep(1) = 0.5_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] + + !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.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.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.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.) + + ! --- 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 +end function + +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 + 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) :: frequencySliceObservation + + 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) :: expectedTotalFrequnecies + integer(kind=SINGLE) :: mpidir = 3 + integer(kind=SINGLE) :: iter + integer(kind=SINGLE) :: test_err = 0 + logical :: ThereAreWires = .false. + logical :: outputRequested + + + 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) + + 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) + + 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)) + + frequencySliceObservation = create_frequency_slice_observation(2, 2, 2, 5, 5, 5, iCur) + call sgg_add_observation(dummysgg, frequencySliceObservation) + + expectedTotalFrequnecies = 6_SINGLE + + 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) + end do + sinpml_fullsizePtr => sinpml_fullsize + + 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)%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( & + 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') + + 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 + +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 + 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) :: frequencySliceObservation + + 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) :: expectedNumberFrequencies + integer(kind=SINGLE) :: mpidir = 3 + integer(kind=SINGLE) :: iter + integer(kind=SINGLE) :: test_err = 0 + logical :: ThereAreWires = .false. + logical :: outputRequested + + + 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) + 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) + + 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)) + + 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) + + 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) + expectedNumberFrequencies = 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, dummyBound, dummyControl, & + outputRequested, ThereAreWires) + + outputs => GetOutputs() + + 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 + + call fillGradient(dummyFields, 1, 0.0_RKIND, 10.0_RKIND) + + 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%nPoints, & + expectedNumMeasurments, 'Unexpected number of measurements') + + test_err = test_err + assert_integer_equal( & + size(outputs(1)%frequencySliceProbe%frequencySlice), & + expectedNumberFrequencies, 'Unexpected allocation size') + + !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 remove_folder(test_folder, ios) + + 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 + 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) :: frequencySliceCurrentObservable + type(Obses_t) :: frequencySliceElectricXObservable + type(Obses_t) :: frequencySliceMagneticHObservable + 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) :: expectedNumFrequencies + 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 + 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 --- + 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) + + 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)) + + 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, 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_output_utils.F90 b/test/output/test_output_utils.F90 new file mode 100644 index 00000000..75a9d238 --- /dev/null +++ b/test/output/test_output_utils.F90 @@ -0,0 +1,236 @@ +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_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 + !=========================== + + !=========================== + + 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_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 + + 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, '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 + + type(observable_t), dimension(:), allocatable :: P + type(observation_domain_t) :: domain + + allocate (P(1)) + P(1) = create_observable(xi, yi, zi, xe, ye, ze, 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, 'volumicProbe', domain, 'DummyFileNormalize') + end function create_volumic_probe_observation + + 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, 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, 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, request) + call initialize_observation_frequency_domain(domain, 0.0_RKIND, 100.0_RKIND, 20.0_RKIND) + + call set_observation(observation, P, 'frequencySliceProbe', 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 + 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 + + 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 + + !-------------------------------------------------------------------------------- + ! 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 diff --git a/test/utils/CMakeLists.txt b/test/utils/CMakeLists.txt index ad087a19..96e569ad 100644 --- a/test/utils/CMakeLists.txt +++ b/test/utils/CMakeLists.txt @@ -3,8 +3,12 @@ message(STATUS "Creating build system for test/observation") add_library( test_utils_fortran "fdetypes_tools.F90" + "assertion_tools.F90" + "array_assertion_tools.F90" + "sgg_setters.F90" ) target_link_libraries(test_utils_fortran semba-types + fdtd-utils ) 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 new file mode 100644 index 00000000..b125187b --- /dev/null +++ b/test/utils/assertion_tools.F90 @@ -0,0 +1,160 @@ +module mod_assertionTools + 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 + 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 + 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_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 + 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, 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 + 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)) > tolerance) then + flag = flag + 1 + end if + 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 diff --git a/test/utils/fdetypes_tools.F90 b/test/utils/fdetypes_tools.F90 index 01ea7fc9..916f33bf 100644 --- a/test/utils/fdetypes_tools.F90 +++ b/test/utils/fdetypes_tools.F90 @@ -1,63 +1,808 @@ 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 + use mod_UTILS + 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 + 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 = .FALSE. + logical :: Saveall = .FALSE. + logical :: TransFer = .FALSE. + logical :: Volumic = .FALSE. + 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 + 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 + + subroutine create_geometry_media(res, xi, xe, yi, ye, zi, ze) + integer(kind=SINGLE), intent(in) :: xi, xe, yi, ye, zi, ze + type(media_matrices_t), intent(inout) :: res + + ! 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) + 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(:, :, :) = 1 + r%sggMiNo(:, :, :) = 1 + r%sggMiEx(:, :, :) = 1 + r%sggMiEy(:, :, :) = 1 + r%sggMiEz(:, :, :) = 1 + r%sggMiHx(:, :, :) = 1 + r%sggMiHy(:, :, :) = 1 + r%sggMiHz(:, :, :) = 1 + end function create_geometry_media_from_sggAlloc + + 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 = 3 + 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(wirecrank)) 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 + + subroutine init_simulation_material_list(simulationMaterials) + implicit none + 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 subroutine init_simulation_material_list + + 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(:), intent(out) :: 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 subroutine init_time_array + + 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 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, line_in) result(observable) + type(observable_t) :: observable + 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 + observable%ZI = ZI + + observable%XE = XE + observable%YE = YE + observable%ZE = ZE + + observable%Xtrancos = 1 + observable%Ytrancos = 1 + 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_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, istat + oldSize = size(simulationMaterials) + allocate (tempSimulationMaterials(0:oldSize), stat=istat) + if (istat /= 0) then + stop "Allocation failed for temporary media array." + end if + + if (oldSize > 0) then + tempSimulationMaterials(0:oldSize - 1) = simulationMaterials + deallocate (simulationMaterials) + end if + tempSimulationMaterials(oldSize) = newSimulationMaterial + + simulationMaterials = tempSimulationMaterials + end subroutine add_simulation_material + + 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(:), target, 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 + + 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 + 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 + 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_simulation_material() result(res) + implicit none + + type(MediaData_t) :: res + type(Material) :: mat + + mat = create_pec_material() + res = get_default_mediadata() + res%Id = mat%id + res%Is%PEC = .TRUE. + + res%Priority = 150 + res%Epr = mat%eps/UTILEPS0 + res%Sigma = mat%sigma + res%Mur = mat%mu/UTILMU0 + res%SigmaM = mat%sigmam + + end function create_pec_simulation_material + + function create_pmc_simulation_material() result(res) + implicit none + + type(MediaData_t) :: res + type(Material) :: mat + + mat = create_pmc_material() + res = get_default_mediadata() + + res%Id = mat%id + res%Is%PMC = .TRUE. + + res%Priority = 160 + res%Epr = mat%eps/UTILEPS0 + res%Sigma = mat%sigma + res%Mur = mat%mu/UTILMU0 + res%SigmaM = mat%sigmam + + 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 + 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 + + 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) + type(Material) :: mat + 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_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_RKIND, SIGMA_PMC, 2) + end function create_pmc_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(:), target, 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 + + mats_collection%Mats => temp_Mats + + mats_collection%n_Mats = new_size + mats_collection%n_Mats_max = new_size + + 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 set_observation(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_observation + + subroutine initialize_observation_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_observation_time_domain + + subroutine initialize_observation_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_observation_frequency_domain + + subroutine initialize_observation_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_observation_theta_domain + + subroutine initialize_observation_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_observation_phi_domain + + subroutine initialize_observation_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_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 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": [