From d44c2c3b653add234bbed863739e3292faf82a76 Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Wed, 6 Nov 2024 13:15:12 +0100 Subject: [PATCH 01/13] Removes CompileWithNodalSource flag --- CMakeLists.txt | 1 - src_main_pub/errorreport.F90 | 8 -------- src_main_pub/interpreta_switches.F90 | 9 ++------- src_main_pub/nodalsources.F90 | 4 ---- src_main_pub/observation.F90 | 27 +++++---------------------- src_main_pub/timestepping.F90 | 26 +++++--------------------- 6 files changed, 12 insertions(+), 63 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2404159d..27828af9 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -143,7 +143,6 @@ add_definitions( -DCompileWithAnisotropic -DCompileWithEDispersives -DCompileWithNF2FF --DCompileWithNodalSources -DCompileWithDMMA -DCompileWithSGBC -DCompileWithWires diff --git a/src_main_pub/errorreport.F90 b/src_main_pub/errorreport.F90 index ab0f7d86..69ebb436 100755 --- a/src_main_pub/errorreport.F90 +++ b/src_main_pub/errorreport.F90 @@ -299,14 +299,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML call print11(layoutnumber,SEPARADOR//sEPARADOR//SEPARADOR) !!! - if ((thereare%NodalE).or.(thereare%NodalH)) then -#ifdef CompileWithNodalSources - continue -#else - buff=trim(adjustl(whoami))//' Nodal sources unsupported. Recompile' - call stoponerror(layoutnumber,size,buff) -#endif - endif ! IF (thereare%FarFields) then #ifdef CompileWithNF2FF diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index 8c567eb2..6e8ee834 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -5,9 +5,7 @@ module interpreta_switches_m use EpsMuTimeScale_m use Report use version -! #ifdef CompilePrivateVersion -! use ParseadorClass -! #endif + IMPLICIT NONE PRIVATE ! @@ -1733,11 +1731,8 @@ subroutine print_help(l) #else !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Loaded and grounded thin-wires with juntions') #endif -#ifdef CompileWithNodalSources CALL print11 (l%layoutnumber, 'SUPPORTED: Nodal hard/soft electric and magnetic sources') -#else - !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Nodal hard/soft electric and magnetic sources') -#endif + #ifdef CompileWithHDF CALL print11 (l%layoutnumber, 'SUPPORTED: .xdmf+.h5 probes ') #else diff --git a/src_main_pub/nodalsources.F90 b/src_main_pub/nodalsources.F90 index 984c8251..ed729f9d 100755 --- a/src_main_pub/nodalsources.F90 +++ b/src_main_pub/nodalsources.F90 @@ -29,8 +29,6 @@ module nodalsources -#ifdef CompileWithNodalSources - use fdetypes USE REPORT @@ -772,7 +770,5 @@ subroutine InitHopf(sgg,NumNodalSources,sggNodalSource,sggSweep,ficherohopf) return end subroutine InitHopf -#endif - END MODULE nodalsources \ No newline at end of file diff --git a/src_main_pub/observation.F90 b/src_main_pub/observation.F90 index 8f35f23a..c06b5df3 100755 --- a/src_main_pub/observation.F90 +++ b/src_main_pub/observation.F90 @@ -54,9 +54,7 @@ module Observa #ifdef CompileWithNF2FF use farfield_m #endif -#ifdef CompileWithNodalSources use nodalsources -#endif ! IMPLICIT NONE private @@ -1310,10 +1308,8 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s if (field==mapvtk) then INIT=.TRUE.; geom=.false. ; asigna=.false.; magnetic=.false. ; electric=.true. -#ifdef CompileWithNodalSources call nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag, & init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) -#endif #ifdef CompileWithWires call wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic,wiresflavor,sggMtag) @@ -1375,10 +1371,9 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s !!! if (field==mapvtk) then INIT=.false.; geom=.false. ; asigna=.false.; magnetic=.true. ; electric=.false. -#ifdef CompileWithNodalSources call nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag, & init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) -#endif + endif !!! output(ii)%item(i)%columnas=conta @@ -1623,10 +1618,8 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s !!! if (field==mapvtk) then INIT=.false.; geom=.true. ; asigna=.false.; magnetic=.false. ; electric=.true. -#ifdef CompileWithNodalSources call nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag,& init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) -#endif #ifdef CompileWithWires call wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic,wiresflavor,sggMtag) #endif @@ -1733,10 +1726,9 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s !!! if (field==mapvtk) then INIT=.false.; geom=.true. ; asigna=.false.; magnetic=.true. ; electric=.false. -#ifdef CompileWithNodalSources call nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag,& init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) -#endif + endif !!! my_iostat=0 @@ -3466,10 +3458,9 @@ subroutine UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz !!! if (field==mapvtk) then INIT=.false.; geom=.false. ; asigna=.true.; magnetic=.false. ; electric=.true. -#ifdef CompileWithNodalSources call nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag,& init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) -#endif + #ifdef CompileWithWires call wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic,wiresflavor,sggMtag) #endif @@ -3488,9 +3479,9 @@ subroutine UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz (dzh(KKK ) * Hz( III , JJJ , KKK ) + dzh(KKK +1) *Hz( III , JJJ , KKK +1) )/1.0_RKIND + & dxh(III )*( Hx( III , JJJ , KKK +1) - Hx( III , JJJ , KKK -1) )/1.0_RKIND !el Hx al promediarlo con el suyo (i,j,k) a ambos lados pierde su componente y solo quedan las adyacentes - !a pesar de ser lógico tengo dudas de esa division por 2 caso tiras guada 0824 !?!? + !a pesar de ser l�gico tengo dudas de esa division por 2 caso tiras guada 0824 !?!? !he quitado la division por 2 porque el lazo debe tragarse los lados de la celda - !otro tema sería la resta de la corriente de desplazamiento ahora que tambien calculamos campo electrico es posible 020824 + !otro tema ser�a la resta de la corriente de desplazamiento ahora que tambien calculamos campo electrico es posible 020824 Jz=(dyh(JJJ ) * Hy( III , JJJ , KKK ) + dyh(JJJ +1) *Hy( III , JJJ +1, KKK ) )/1.0_RKIND - & (dyh(JJJ ) * Hy( III -1, JJJ , KKK ) + dyh(JJJ +1) *Hy( III -1, JJJ +1, KKK ) )/1.0_RKIND + & dxh(III )*( Hx( III , JJJ -1, KKK ) - Hx( III , JJJ +1, KKK ) )/1.0_RKIND @@ -3669,10 +3660,8 @@ subroutine UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz !!! if (field==mapvtk) then INIT=.false.; geom=.false. ; asigna=.true.; magnetic=.true. ; electric=.false. -#ifdef CompileWithNodalSources call nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag, & init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) -#endif endif !!! !!!!!!!!!!!!esto dara problemas en los angulos y aristas donde porque ahi sacara la Bloque current en Hx!!!! 19/2/14 @@ -4815,10 +4804,6 @@ subroutine contabordes(sgg,imed,imed1,imed2,imed3,imed4,EsBorde,SINPML_fullsize, return end subroutine contabordes - - - -#ifdef CompileWithNodalSources subroutine nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag, & init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) type (SGGFDTDINFO), intent(IN) :: sgg @@ -5184,8 +5169,6 @@ subroutine nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag, return end subroutine -#endif -!del CompileWithNodalSources #ifdef CompileWithWires diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 89cf6396..6b73926f 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -50,10 +50,7 @@ module Solver use Borders_CPML use Borders_MUR use Resuming - -#ifdef CompileWithNodalSources use nodalsources -#endif use Lumped use PMLbodies #ifdef CompileWithXDMF @@ -1024,8 +1021,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx write(dubuf,*) '----> no Plane waves are found'; call print11(layoutnumber,dubuf) endif -#ifdef CompileWithNodalSources - !debe venir antes para que observation las use en mapvtk #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) #endif @@ -1050,8 +1045,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx write(dubuf,*) '----> no Structured Nodal sources are found'; call print11(layoutnumber,dubuf) endif -#endif - !!!!!!!sgg 121020 !rellena la matriz Mtag con los slots de una celda call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b) !!!!!!!fin @@ -1518,16 +1511,13 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif endif - -#ifdef CompileWithNodalSources - !NOdal sources E-field advancing + !Nodal sources E-field advancing If (Thereare%NodalE) then - ! if (.not.simu_devia) then !bug! debe entrar en nodal y si son hard simplemente ponerlas a cero !mdrc 290323 - call AdvanceNodalE(sgg,sggMiEx,sggMiEy,sggMiEz,sgg%NumMedia,n, b,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,simu_devia) - ! endif + ! if (.not.simu_devia) then !bug! debe entrar en nodal y si son hard simplemente ponerlas a cero !mdrc 290323 + call AdvanceNodalE(sgg,sggMiEx,sggMiEy,sggMiEz,sgg%NumMedia,n, b,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,simu_devia) + ! endif endif -#endif !!!!!!!!!!!!!!!!!! @@ -1693,17 +1683,13 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif - -#ifdef CompileWithNodalSources - !NOdal sources E-field advancing + !Nodal sources E-field advancing If (Thereare%NodalH) then !! if (.not.simu_devia) then !bug! debe entrar en nodal y si son hard simplemente ponerlas a cero !mdrc 290323 call AdvanceNodalH(sgg,sggMiHx,sggMiHy,sggMiHz,sgg%NumMedia,n, b ,GM2,Idxe,Idye,Idze,Hx,Hy,Hz,simu_devia) !! endif endif -#endif - !Must be called here again at the end to enforce any of the previous changes !Posible Wire for thickwires advancing in the H-field part #ifdef CompileWithWires @@ -3272,9 +3258,7 @@ subroutine Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe REAL (KIND=RKIND), intent(INOUT) , pointer, dimension ( : ) :: G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh call DestroyObservation(sgg) -#ifdef CompileWithNodalSources Call DestroyNodal(sgg) -#endif call DestroyIlumina(sgg) #ifdef CompileWithNIBC call DestroyMultiports(sgg) From 1df3f9b58619a0df3e53a725680a3daa163cfb0f Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Fri, 8 Nov 2024 08:57:22 +0100 Subject: [PATCH 02/13] movie components changed to be a single entry, not array. --- CMakeLists.txt | 1 + doc/smbjson.md | 4 ++-- src_json_parser/CMakeLists.txt | 2 +- src_json_parser/smbjson.F90 | 16 +++++----------- .../{labels_mod.F90 => smbjson_labels.F90} | 4 ++-- testData/cases/sphere.fdtd.json | 2 +- 6 files changed, 12 insertions(+), 17 deletions(-) rename src_json_parser/{labels_mod.F90 => smbjson_labels.F90} (99%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2404159d..406d302f 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -147,6 +147,7 @@ add_definitions( -DCompileWithDMMA -DCompileWithSGBC -DCompileWithWires +-DCompileWithXDMF ) diff --git a/doc/smbjson.md b/doc/smbjson.md index 07847c68..54f8e103 100644 --- a/doc/smbjson.md +++ b/doc/smbjson.md @@ -634,7 +634,7 @@ If not `magnitudeFile` is specified and only one `source` is defined, the `magni Probes of type `movie` record a vector field in a volume region indicated by `elementIds`. `[field]` can be `electric`, `magnetic`, or `currentDensity`; defaults to `electric`. `currentDensity` will store only the surface density currents on `pec` or lossy surfaces. -The stored values can be selected using `[components]`, which stores an array of the following labels `x`, `y`, `z`, or `magnitude`; if no components are specified, defaults to `magnitude`. +The stored values can be selected using the `[component]` entry, which stores one of the following labels `x`, `y`, `z`, or `magnitude`; if no component is specified, defaults to `magnitude`. An example follows: ```json @@ -642,7 +642,7 @@ An example follows: "name": "electric_field_movie", "type": "movie", "field": "electric", - "components": ["x"], + "component": "x", "elementIds": [4] } ``` diff --git a/src_json_parser/CMakeLists.txt b/src_json_parser/CMakeLists.txt index c0803869..2d69d2a2 100755 --- a/src_json_parser/CMakeLists.txt +++ b/src_json_parser/CMakeLists.txt @@ -13,7 +13,7 @@ add_library (jsonfortran ) add_library(smbjson - "labels_mod.F90" + "smbjson_labels.F90" "cells.F90" "smbjson.F90" "idchildtable.F90" diff --git a/src_json_parser/smbjson.F90 b/src_json_parser/smbjson.F90 index 3fac4244..7cd8fc18 100644 --- a/src_json_parser/smbjson.F90 +++ b/src_json_parser/smbjson.F90 @@ -4,7 +4,7 @@ module smbjson use NFDETypes use NFDETypes_extension - use labels_mod + use smbjson_labels_mod use mesh_mod use parser_tools_mod use idchildtable_mod @@ -986,18 +986,12 @@ function readVolProbe(p) result(res) fieldType = this%getStrAt(p, J_FIELD, default=J_FIELD_ELECTRIC) call this%core%get(p, J_PR_MOVIE_COMPONENTS, compsPtr, found=componentsFound) + allocate(res%cordinates(1)) if (componentsFound) then - numberOfComponents = this%core%count(compsPtr) - allocate(res%cordinates(numberOfComponents)) - do i = 1, numberOfComponents - call this%core%get_child(compsPtr, i, compPtr) - call this%core%get(compPtr, component) - res%cordinates(i) = cs(1) - res%cordinates(i)%Or = buildVolProbeType(fieldType, component) - end do - else - allocate(res%cordinates(1)) + call this%core%get(compsPtr, component) res%cordinates(1) = cs(1) + res%cordinates(1)%Or = buildVolProbeType(fieldType, component) + else component = J_DIR_M res%cordinates(1)%Or = buildVolProbeType(fieldType, component) endif diff --git a/src_json_parser/labels_mod.F90 b/src_json_parser/smbjson_labels.F90 similarity index 99% rename from src_json_parser/labels_mod.F90 rename to src_json_parser/smbjson_labels.F90 index 34f92975..82d01670 100644 --- a/src_json_parser/labels_mod.F90 +++ b/src_json_parser/smbjson_labels.F90 @@ -1,4 +1,4 @@ -module labels_mod +module smbjson_labels_mod #ifdef CompileWithSMBJSON ! LABELS @@ -155,7 +155,7 @@ module labels_mod character (len=*), parameter :: J_PR_POINT_DIRECTIONS = "directions" - character (len=*), parameter :: J_PR_MOVIE_COMPONENTS = "components" + character (len=*), parameter :: J_PR_MOVIE_COMPONENTS = "component" character (len=*), parameter :: J_PR_FAR_FIELD_THETA = "theta" character (len=*), parameter :: J_PR_FAR_FIELD_PHI = "phi" diff --git a/testData/cases/sphere.fdtd.json b/testData/cases/sphere.fdtd.json index 72172030..4d2d161e 100644 --- a/testData/cases/sphere.fdtd.json +++ b/testData/cases/sphere.fdtd.json @@ -40956,7 +40956,7 @@ "name": "electric_field_movie", "type": "movie", "field": "electric", - "components": ["x"], + "components": "x", "elementIds": [2], "domain": { "type": "time", From 5d5e2112042b5338483dd08b337e6033bfeacd5d Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Fri, 8 Nov 2024 09:08:24 +0100 Subject: [PATCH 03/13] propagates change in name --- CMakeLists.txt | 2 +- src_json_parser/idchildtable.F90 | 2 +- src_json_parser/parser_tools.F90 | 1 - test/smbjson/test_idchildtable.F90 | 1 + 4 files changed, 3 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 406d302f..7cb31a7e 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -147,7 +147,7 @@ add_definitions( -DCompileWithDMMA -DCompileWithSGBC -DCompileWithWires --DCompileWithXDMF +# -DCompileWithXDMF ) diff --git a/src_json_parser/idchildtable.F90 b/src_json_parser/idchildtable.F90 index 0ddf43f1..50063027 100644 --- a/src_json_parser/idchildtable.F90 +++ b/src_json_parser/idchildtable.F90 @@ -2,8 +2,8 @@ module idchildtable_mod #ifdef CompileWithSMBJSON use json_module + use smbjson_labels_mod, only: J_ID use fhash, only: fhash_tbl_t, key=>fhash_key - use labels_mod use parser_tools_mod, only: json_value_ptr type :: IdChildTable_t diff --git a/src_json_parser/parser_tools.F90 b/src_json_parser/parser_tools.F90 index 7427db78..07709aa6 100644 --- a/src_json_parser/parser_tools.F90 +++ b/src_json_parser/parser_tools.F90 @@ -1,7 +1,6 @@ module parser_tools_mod #ifdef CompileWithSMBJSON - use labels_mod use mesh_mod use cells_mod use json_module diff --git a/test/smbjson/test_idchildtable.F90 b/test/smbjson/test_idchildtable.F90 index c2f20702..9e1f2008 100644 --- a/test/smbjson/test_idchildtable.F90 +++ b/test/smbjson/test_idchildtable.F90 @@ -22,6 +22,7 @@ integer function test_idchildtable_fhash() bind(C) result(error_cnt) integer function test_idchildtable() bind(C) result(err) use idchildtable_mod + use smbjson_labels_mod use parser_tools_mod, only: json_value_ptr use smbjson_testingTools use json_module From 3c4f824e3053105fd385ef6c37a111ec4750295c Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Fri, 8 Nov 2024 09:38:00 +0100 Subject: [PATCH 04/13] Minor in sphere.fdtd.json test case --- src_json_parser/smbjson.F90 | 2 +- src_json_parser/smbjson_labels.F90 | 2 +- test/smbjson/smbjson_tests.h | 2 +- testData/cases/sphere.fdtd.json | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src_json_parser/smbjson.F90 b/src_json_parser/smbjson.F90 index 7cd8fc18..2baff42e 100644 --- a/src_json_parser/smbjson.F90 +++ b/src_json_parser/smbjson.F90 @@ -985,7 +985,7 @@ function readVolProbe(p) result(res) cs = cellIntervalsToCoords(cRs(1)%intervals) fieldType = this%getStrAt(p, J_FIELD, default=J_FIELD_ELECTRIC) - call this%core%get(p, J_PR_MOVIE_COMPONENTS, compsPtr, found=componentsFound) + call this%core%get(p, J_PR_MOVIE_COMPONENT, compsPtr, found=componentsFound) allocate(res%cordinates(1)) if (componentsFound) then call this%core%get(compsPtr, component) diff --git a/src_json_parser/smbjson_labels.F90 b/src_json_parser/smbjson_labels.F90 index 82d01670..c56001ac 100644 --- a/src_json_parser/smbjson_labels.F90 +++ b/src_json_parser/smbjson_labels.F90 @@ -155,7 +155,7 @@ module smbjson_labels_mod character (len=*), parameter :: J_PR_POINT_DIRECTIONS = "directions" - character (len=*), parameter :: J_PR_MOVIE_COMPONENTS = "component" + character (len=*), parameter :: J_PR_MOVIE_COMPONENT = "component" character (len=*), parameter :: J_PR_FAR_FIELD_THETA = "theta" character (len=*), parameter :: J_PR_FAR_FIELD_PHI = "phi" diff --git a/test/smbjson/smbjson_tests.h b/test/smbjson/smbjson_tests.h index a239ba79..d7a756b8 100644 --- a/test/smbjson/smbjson_tests.h +++ b/test/smbjson/smbjson_tests.h @@ -41,4 +41,4 @@ TEST(smbjson, read_currentinjection) { EXPECT_EQ(0, test_read_currentinjection( // TEST(smbjson, read_shieldedpair) { EXPECT_EQ(0, test_read_shieldedpair()); } TEST(smbjson, read_mtln) { EXPECT_EQ(0, test_read_mtln()); } TEST(smbjson, read_sphere) { EXPECT_EQ(0, test_read_sphere()); } -TEST(smbjson, read_airplane) { EXPECT_EQ(0, test_read_airplane()); } \ No newline at end of file +TEST(smbjson, read_airplane) { EXPECT_EQ(0, test_read_airplane()); } \ No newline at end of file diff --git a/testData/cases/sphere.fdtd.json b/testData/cases/sphere.fdtd.json index 4d2d161e..3f306146 100644 --- a/testData/cases/sphere.fdtd.json +++ b/testData/cases/sphere.fdtd.json @@ -40956,7 +40956,7 @@ "name": "electric_field_movie", "type": "movie", "field": "electric", - "components": "x", + "component": "x", "elementIds": [2], "domain": { "type": "time", From 49347330f6b77d37ac6316af9d84b1a8d0790701 Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Sat, 9 Nov 2024 10:21:05 +0100 Subject: [PATCH 05/13] Adds xdmf output --- CMakeLists.txt | 4 +- src_main_pub/xdmf.F90 | 581 +++++++++++++++++++++++++++++++++++++++ src_main_pub/xdmf_h5.F90 | 283 +++++++++++++++++++ 3 files changed, 867 insertions(+), 1 deletion(-) create mode 100644 src_main_pub/xdmf.F90 create mode 100644 src_main_pub/xdmf_h5.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 7cb31a7e..bcca2573 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -116,6 +116,8 @@ if (SEMBA_FDTD_MAIN_LIB) "src_main_pub/timestepping.F90" "src_main_pub/observation.F90" "src_main_pub/vtk.F90" + "src_main_pub/xdmf.F90" + "src_main_pub/xdmf_h5.F90" "src_wires_pub/wires.F90" "src_wires_pub/wires_mtln.F90" ) @@ -147,7 +149,7 @@ add_definitions( -DCompileWithDMMA -DCompileWithSGBC -DCompileWithWires -# -DCompileWithXDMF +-DCompileWithXDMF ) diff --git a/src_main_pub/xdmf.F90 b/src_main_pub/xdmf.F90 new file mode 100644 index 00000000..162d5ac4 --- /dev/null +++ b/src_main_pub/xdmf.F90 @@ -0,0 +1,581 @@ +MODULE xdmf + ! +#ifdef CompileWithXDMF + USE fdetypes + USE Observa + use report + use xdmf_h5 + ! + ! + ! + ! + IMPLICIT NONE + ! + PRIVATE + PUBLIC createxdmf,createxdmfOnTheFly,createh5bintxt + !!! public create_interpreted_mesh +CONTAINS + ! ================================================================================================= + ! ====>>>> SALVADOR's CODE <<<<==== + ! ================================================================================================= + ! + !Subrutine to parse the volumic probes to create .xdmf and .h5 files + ! + SUBROUTINE createxdmf (sgg,layoutnumber, size,vtkindex,createh5bin,somethingdone,mpidir) + logical, save :: firsttimeenteringcreatexdmf=.true. + integer (KIND=4) :: mpidir + logical :: vtkindex,createh5bin + !------------------------> + CHARACTER (LEN=BUFSIZE) :: filename ! File name + ! + type (SGGFDTDINFO), intent(IN) :: sgg + INTEGER (KIND=4), INTENT (IN) :: layoutnumber, size + INTEGER (KIND=4) :: ierr, sizeofvalores,COMPO + complex( kind = CKIND), dimension( :, :, :, :,: ), allocatable :: valor3DComplex !freqdomain probes + ! + TYPE (output_t), POINTER, DIMENSION (:) :: output + INTEGER (KIND=4) :: iroot + integer (KIND=4) :: myunit + ! +#ifdef CompileWithMPI + REAL (KIND=RKIND), ALLOCATABLE, DIMENSION (:, :, :, :) :: newvalor3d !para sondas Volumic +#endif + + + REAL (KIND=RKIND), ALLOCATABLE, DIMENSION (:, :, :, :) :: valor3d !para sondas Volumic + real ( KINd=RKIND_TIEMPO), ALLOCATABLE, DIMENSION (:) :: att + + + INTEGER (KIND=4) :: indi,fieldob + ! + INTEGER (KIND=4) :: ii, i1, j1, k1, finalstep + INTEGER (KIND=4) :: minx, maxx, miny, maxy, minz, maxz,pasadas,pasadastotales + LOGICAL :: lexis,somethingdone + character (LEN=BUFSIZE) :: dubuf + INTEGER (KIND=4) :: minXabs, maxXabs, minYabs, maxYabs, minZabs, maxZabs + INTEGER (KIND=4) :: minXabs_primero,minYabs_primero,minZabs_primero,imdice + CHARACTER (LEN=BUFSIZE) :: pathroot + character (LEN=BUFSIZE) :: chari,charj,chark,chari2,charj2,chark2 + character (LEN=BUFSIZE) :: extpoint + character(len=BUFSIZE) :: buff + REAL (KIND=RKIND) :: linez_minZabs_primero,liney_minYabs_primero,linex_minXabs_primero, & + dz_minZabs,dy_minYabs,dx_minXabs + ! + CHARACTER (LEN=BUFSIZE) :: whoami, whoamishort + REAL (KIND=RKIND) :: rdum + integer :: my_iostat + + WRITE (whoamishort, '(i5)') layoutnumber + 1 + WRITE (whoami, '(a,i5,a,i5,a)') '(', layoutnumber + 1, '/', size, ') ' + ! + output => GetOutput ()!get the output private info from observation + + somethingdone=.false. + barridoprobes: DO ii = 1, sgg%NumberRequest + + IF (sgg%observation(ii)%Volumic) then + if (sgg%observation(ii)%nP == 1) then + if ((sgg%observation(ii)%P(1)%What /= nothing).AND.(sgg%observation(ii)%P(1)%What /= iCur).AND.(sgg%observation(ii)%P(1)%What /= mapvtk).AND. & + (sgg%observation(ii)%P(1)%What /= iCurX).AND.(sgg%observation(ii)%P(1)%What /= iCurY).AND.(sgg%observation(ii)%P(1)%What /= iCurZ)) THEN + if (sgg%Observation(ii)%done.and.(sgg%Observation(ii)%flushed)) then + cycle barridoprobes + elseif (sgg%Observation(ii)%done) then + sgg%Observation(ii)%flushed=.true. !ultima que se flushea + continue + elseif ((.not.(sgg%Observation(ii)%done)).and.(sgg%Observation(ii)%Begun)) then + continue + elseif (.not.(sgg%Observation(ii)%begun)) then + cycle barridoprobes + else !creo que tengo toda la casuistica, por si se me escapa algo continuo, y ya debajo se manejara + continue + endif + else + cycle barridoprobes + endif + endif + endif + ! + !sondas Volumic traducelas a xdfm + IF (sgg%observation(ii)%Volumic) then + if (sgg%observation(ii)%nP == 1) then + if ((sgg%observation(ii)%P(1)%What /= nothing).AND.(sgg%observation(ii)%P(1)%What /= iCur).AND.(sgg%observation(ii)%P(1)%What /= mapvtk).AND. & + (sgg%observation(ii)%P(1)%What /= iCurX).AND.(sgg%observation(ii)%P(1)%What /= iCurY).AND.(sgg%observation(ii)%P(1)%What /= iCurZ)) THEN + INQUIRE (FILE=trim(adjustl(output(ii)%item(1)%path)), EXIST=lexis) + if ((lexis).and.(output(ii)%TimesWritten/=0)) then + fieldob=sgg%observation(ii)%P(1)%what +!inicializaciones varias + ! + minXabs = sgg%observation(ii)%P(1)%XI + maxXabs = sgg%observation(ii)%P(1)%XE + minYabs = sgg%observation(ii)%P(1)%YI + maxYabs = sgg%observation(ii)%P(1)%YE +#ifdef CompileWithMPI + minZabs = output(ii)%item(1)%ZIorig + maxZabs = output(ii)%item(1)%ZEorig +#else + minZabs = sgg%observation(ii)%P(1)%zI + maxZabs = sgg%observation(ii)%P(1)%zE +#endif + write(chari ,'(i7)') minXabs + write(charj ,'(i7)') minYabs + write(chark ,'(i7)') minZabs + write(chari2,'(i7)') maxXabs + write(charj2,'(i7)') maxYabs + write(chark2,'(i7)') maxZabs + !mpidir 190319 !desrotacion para que los nombres sean correctos + if (mpidir==3) then + extpoint=trim(adjustl(chari)) //'_'//trim(adjustl(charj)) //'_'//trim(adjustl(chark))//'__'// & + trim(adjustl(chari2))//'_'//trim(adjustl(charj2))//'_'//trim(adjustl(chark2)) + elseif (mpidir==2) then + extpoint=trim(adjustl(charj)) //'_'//trim(adjustl(chark)) //'_'//trim(adjustl(chari))//'__'// & + trim(adjustl(charj2))//'_'//trim(adjustl(chark2))//'_'//trim(adjustl(chari2)) + elseif (mpidir==1) then + extpoint=trim(adjustl(chark)) //'_'//trim(adjustl(chari)) //'_'//trim(adjustl(charj))//'__'// & + trim(adjustl(chark2))//'_'//trim(adjustl(chari2))//'_'//trim(adjustl(charj2)) + else + call stoponerror(layoutnumber,size,'Buggy error in mpidir. ') + endif + !fin mpidir + + !! CORREGIDO PARA TRANCOS AHORA DESPUES DE HABER PUESTO BIEN EXTPOINT +!guarda el original + minXabs_primero = minXabs + minYabs_primero = minYabs + minZabs_primero = minZabs + im1: do imdice=minXabs,maxXabs + if (mod(imdice,output(ii)%item(1)%Xtrancos)==0) then + minXabs_primero=imdice + exit im1 + endif + end do im1 + im2: do imdice=minYabs,maxYabs + if (mod(imdice,output(ii)%item(1)%Ytrancos)==0) then + minYabs_primero=imdice + exit im2 + endif + end do im2 + im3: do imdice=minZabs,maxZabs + if (mod(imdice,output(ii)%item(1)%Ztrancos)==0) then + minZabs_primero=imdice + exit im3 + endif + end do im3 +!pufff hay mucha reduncancia minxabs = minx, etc. 021219 limpiar algun dia + minXabs = int(sgg%Observation(ii)%P(1)%XI/output(ii)%item(1)%Xtrancos) + if (mod(sgg%Observation(ii)%P(1)%XI,output(ii)%item(1)%Xtrancos) /= 0) minXabs=minXabs+1 + maxXabs = int(sgg%Observation(ii)%P(1)%XE/output(ii)%item(1)%Xtrancos) + minYabs = int(sgg%observation(ii)%P(1)%YI/output(ii)%item(1)%Ytrancos) + if (mod(sgg%Observation(ii)%P(1)%YI,output(ii)%item(1)%Ytrancos) /= 0) minYabs=minYabs+1 + maxYabs = int(sgg%observation(ii)%P(1)%YE/output(ii)%item(1)%Ytrancos) + +#ifdef CompileWithMPI + minZabs = int(output(ii)%item(1)%ZIorig/output(ii)%item(1)%Ztrancos) + if (mod(output(ii)%item(1)%ZIorig,output(ii)%item(1)%Ztrancos) /= 0) minZabs=minZabs+1 + maxZabs = int(output(ii)%item(1)%ZEorig/output(ii)%item(1)%Ztrancos) +#else + minZabs = int(sgg%observation(ii)%P(1)%zI/output(ii)%item(1)%Ztrancos) + if (mod(sgg%Observation(ii)%P(1)%ZI,output(ii)%item(1)%Ztrancos) /= 0) minZabs=minZabs+1 + maxZabs = int(sgg%observation(ii)%P(1)%zE/output(ii)%item(1)%Ztrancos) +#endif + + + !fin trancos + + iroot=index(output(ii)%item(1)%path,'__',.true.) + pathroot=trim(adjustl(output(ii)%item(1)%path(1:iroot-1))) + iroot = index (pathroot, '_',.true.) + pathroot = trim (adjustl(pathroot(1:iroot-1))) + iroot = index (pathroot, '_',.true.) + pathroot = trim (adjustl(pathroot(1:iroot-1))) + iroot = index (pathroot, '_',.true.) + pathroot = trim(adjustl(pathroot(1:iroot-1)))//'_'//trim(adjustl(extpoint)) + + + linez_minZabs_primero = sgg%linez(minZabs_primero) + liney_minYabs_primero = sgg%liney(minYabs_primero) + linex_minXabs_primero = sgg%linex(minXabs_primero) + dz_minZabs = sgg%dz(minZabs)*output(ii)%item(1)%Ztrancos + dy_minYabs = sgg%dy(minYabs)*output(ii)%item(1)%Ytrancos + dx_minXabs = sgg%dx(minXabs)*output(ii)%item(1)%Xtrancos + + OPEN (output(ii)%item(1)%UNIT, FILE=trim(adjustl(output(ii)%item(1)%path)), FORM='unformatted') +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + READ (output(ii)%item(1)%UNIT) minx, maxx , miny, maxy, minz, maxz !ya deben venir bien escritos incluyendo correccion de TRANCOS +!!!allocate space + if (SGG%Observation(ii)%TimeDomain) then + finalstep=output(ii)%TimesWritten + allocate (att(1:finalstep)) + att = 0.0_RKIND !aquiiiii + pasadastotales=1 + ALLOCATE (valor3d(minXabs:maxXabs, minYabs:maxYabs, minZabs:maxZabs, 1)) + elseif (SGG%Observation(ii)%FreqDomain) then + !este read solo se precisa para la frecuencial y es dummy + read(output(ii)%item(1)%unit) rdum !instante en el que se ha escrito la info frequencial + finalstep= output(ii)%NumFreqs + allocate (att(1:finalstep)) + att = 0.0_RKIND !aquiiiii + pasadastotales=2 + ALLOCATE (valor3d(minXabs:maxXabs, minYabs:maxYabs, minZabs:maxZabs, 1)) + ALLOCATE (valor3dCOMPLEX(1,1:3,minXabs:maxXabs, minYabs:maxYabs, minZabs:maxZabs)) + endif + +#ifdef CompileWithMPI + ALLOCATE (newvalor3d(minXabs:maxXabs, minYabs:maxYabs, minZabs:maxZabs, 1)) +#endif + +#ifdef CompileWithMPI + IF (layoutnumber == output(ii)%item(1)%MPIRoot) THEN +#else + IF (layoutnumber == 0) THEN +#endif + if (createh5bin) then + if (firsttimeenteringcreatexdmf) then + open(newunit=myunit,file=trim(adjustl(sgg%nEntradaRoot))//'_'//trim(adjustl(whoamishort))//'_h5bin.txt',form='formatted') !lista de todos los .h5bin + WRITE (myunit, '(a)') '!END' + close(myunit,status='delete') + firsttimeenteringcreatexdmf=.false. + endif + my_iostat=0 +9138 if(my_iostat /= 0) write(*,fmt='(a)',advance='no'), '.' !!if(my_iostat /= 0) print '(i5,a1,i4,2x,a)',9138,'.',layoutnumber,trim(adjustl(sgg%nEntradaRoot))//'_'//trim(adjustl(whoamishort))//'_h5bin.txt' + open(newunit=myunit,file=trim(adjustl(sgg%nEntradaRoot))//'_'//trim(adjustl(whoamishort))//'_h5bin.txt',form='formatted',position='append',err=9138,iostat=my_iostat,status='new',action='write') !lista de todos los .h5bin + ! !lista de todos los .h5bin + write (myunit,'(a)') trim(adjustl(pathroot))//'.h5bin' + close(myunit) + ! + open(newunit=myunit,file=trim(adjustl(pathroot))//'.h5bin',form='unformatted') + write (myunit) finalstep,minXabs, maxXabs, minYabs, maxYabs, minZabs, maxZabs,fieldob,SGG%Observation(ii)%TimeDomain,pasadastotales + endif + endif !del layoutnumber + +#ifdef CompileWithMPI + call MPI_Barrier(output(ii)%item(1)%MPISubComm,ierr) +#endif + buclepasadas: do pasadas=1,pasadastotales +!!!inicializa a cero en cada pasada + if (SGG%Observation(ii)%TimeDomain) then + valor3d = 0.0_RKIND + elseif (SGG%Observation(ii)%FreqDomain) then + valor3d = 0.0_RKIND + valor3dCOMPLEX = 0.0_RKIND + endif + +#ifdef CompileWithMPI + newvalor3d = 0.0_RKIND +#endif +!!!!abre fiecho escritura .h5 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (SGG%Observation(ii)%TimeDomain) then + if (pasadas==1) then + filename = trim (adjustl(pathroot))//'_time' + else + print *,'Buggy error in valor3d. ' + stop + endif + continue !ya se ha leido valor3d + else + if (pasadas==1) then + filename = trim (adjustl(pathroot))//'_mod' + elseif (pasadas==2) then + filename = trim (adjustl(pathroot))//'_phase' + else + print *,'Buggy error in valor3d. ' + stop + endif + endif +#ifdef CompileWithHDF +#ifdef CompileWithMPI + IF (layoutnumber == output(ii)%item(1)%MPIRoot) THEN +#else + IF (layoutnumber == 0) THEN +#endif + + if (.not.(((fieldob == iMEC).or.(fieldob ==iMHC)).and.(pasadas ==2))) then ! no tiene sentido esccribir la fase del modulo + call openh5file(filename,finalstep,minXabs,maxXabs, minYabs,maxYabs, minZabs,maxZabs) + endif + endif +#endif + + bucleindi: DO indi = 1, finalstep + if (pasadas == 1) then !solo es preciso leer los datos una vez + READ (output(ii)%item(1)%UNIT) att(indi) + write(dubuf,*) ' ----> .xdmf file ',att(indi),'(',indi,'/',finalstep,')' + call print11(layoutnumber,dubuf) + + if (SGG%Observation(ii)%TimeDomain) then + DO k1 = minz, maxz + DO j1 = miny, maxy + READ (output(ii)%item(1)%UNIT) (valor3d(i1, j1, k1, 1), i1=minx, maxx) + END DO + END DO + ! + elseif (SGG%Observation(ii)%FreqDomain) then + DO COMPO=1,3 + DO k1 = minz, maxz + DO j1 = miny, maxy + READ (output(ii)%item(1)%UNIT) (valor3dCOMPLEX(1,COMPO,i1, j1, k1), i1=minx, maxx) + END DO + END DO + END DO + endif + endif !del if (pasadas==1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (SGG%Observation(ii)%TimeDomain) then + continue !ya se ha leido valor3d + else !freqdomain construir valor3d + select case (fieldob) + case(iMEC,iMHC) + !modulo + DO k1 = minz, maxz + DO j1 = miny, maxy + DO i1=minx, maxx + if (pasadas==1) then !modulo + valor3d(i1, j1, k1, 1)=SQRT( ABS(valor3dCOMPLEX(1,1,i1, j1, k1))**2. + & + ABS(valor3dCOMPLEX(1,2,i1, j1, k1))**2. + & + ABS(valor3dCOMPLEX(1,3,i1, j1, k1))**2. ) !sgg 301119 faltaba este cuadrado creo + else !phase + valor3d=0.0_RKIND !LA fase no tiene sentido para el modulo del vector + endif + END DO + END DO + END DO + case(iExC,iHxC) + DO k1 = minz, maxz + DO j1 = miny, maxy + DO i1=minx, maxx + if (pasadas==1) then !modulo + valor3d(i1, j1, k1, 1)= ABS(valor3dCOMPLEX(1,1,i1, j1, k1)) + else !phase + valor3d(i1, j1, k1, 1)= ATAN2(AIMAG(valor3dCOMPLEX(1,1,i1, j1, k1)),REAL(valor3dCOMPLEX(1,1,i1, j1, k1))) + endif + END DO + END DO + END DO + case(iEyC,iHyC) + DO k1 = minz, maxz + DO j1 = miny, maxy + DO i1=minx, maxx + if (pasadas==1) then !modulo + valor3d(i1, j1, k1, 1)=ABS(valor3dCOMPLEX(1,2,i1, j1, k1)) + else !phase + valor3d(i1, j1, k1, 1)= ATAN2(AIMAG(valor3dCOMPLEX(1,2,i1, j1, k1)),REAL(valor3dCOMPLEX(1,2,i1, j1, k1))) + endif + END DO + END DO + END DO + case(iEzC,iHzC) + DO k1 = minz, maxz + DO j1 = miny, maxy + DO i1=minx, maxx + if (pasadas==1) then !modulo + valor3d(i1, j1, k1, 1)=ABS(valor3dCOMPLEX(1,3,i1, j1, k1)) + else !phase + valor3d(i1, j1, k1, 1)= ATAN2(AIMAG(valor3dCOMPLEX(1,3,i1, j1, k1)),REAL(valor3dCOMPLEX(1,3,i1, j1, k1))) + endif + END DO + END DO + END DO + case default + print *,'Buggy error in valor3d. Not processing continuing. ' + continue + end select + endif !del time domain +!!!!!!!!!!!!!!!!sincroniza valor3d y aunalos en el root +#ifdef CompileWithMPI + if (size>1) then + if (output(ii)%item(1)%MPISubComm /= -1) then + sizeofvalores = (maxXabs-minXabs+1) * (maxYabs-minYabs+1) * (maxZabs-minZabs+1) + call MPI_Barrier(output(ii)%item(1)%MPISubComm,ierr) + CALL MPI_AllReduce (valor3d, newvalor3d, sizeofvalores, REALSIZE, MPI_SUM, & + & output(ii)%item(1)%MPISubComm, ierr) + endif + valor3d = newvalor3d + endif +#endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!escribe los ficheros de salida + +#ifdef CompileWithMPI + IF (layoutnumber == output(ii)%item(1)%MPIRoot) THEN +#else + IF (layoutnumber == 0) THEN +#endif +#ifdef CompileWithHDF + if (.not.(((fieldob == iMEC).or.(fieldob ==iMHC)).and.(pasadas ==2))) then ! no tiene sentido esccribir la fase del modulo + call writeh5file(filename,valor3d,indi,att(indi),minXabs,maxXabs, minYabs,maxYabs, minZabs,maxZabs, & + linez_minZabs_primero,liney_minYabs_primero,linex_minXabs_primero, & + dz_minZabs,dy_minYabs,dx_minXabs,& + minZabs_primero,minYabs_primero,minXabs_primero,finalstep,vtkindex) + endif +#endif + if (createh5bin) then + write (myunit) (minZabs_primero),(minYabs_primero), (minXabs_primero) + write (myunit) linez_minZabs_primero,liney_minYabs_primero,linex_minXabs_primero + write (myunit) dz_minZabs,dy_minYabs,dx_minXabs + WRITE (myunit) att(indi) + DO k1 = minzabs, maxzabs + DO j1 = minyabs, maxyabs + WRITE (myunit) (valor3d(i1, j1, k1, 1), i1=minxabs, maxxabs) + END DO + END DO + endif + endif + + END DO bucleindi + +#ifdef CompileWithHDF +#ifdef CompileWithMPI + IF (layoutnumber == output(ii)%item(1)%MPIRoot) THEN +#else + IF (layoutnumber == 0) THEN +#endif + + if (.not.(((fieldob == iMEC).or.(fieldob ==iMHC)).and.(pasadas ==2))) then ! no tiene sentido esccribir la fase del modulo + call closeh5file(finalstep,att) + CALL print11 (layoutnumber, trim(adjustl(whoami))//' Written into '//trim(adjustl(filename))//'.h5', .TRUE.) !enforces print + endif + endif +#endif + end do buclepasadas + ! +#ifdef CompileWithMPI + IF (layoutnumber == output(ii)%item(1)%MPIRoot) THEN +#else + IF (layoutnumber == 0) THEN +#endif + if (createh5bin) then + close(myunit) + CALL print11 (layoutnumber, trim(adjustl(whoami))//' Written into '//trim(adjustl(sgg%nEntradaRoot))//'.h5bin', .TRUE.) + endif + endif + + DEALLOCATE (valor3d) + if (SGG%Observation(ii)%FreqDomain) then + DEALLOCATE (valor3dCOMPLEX) + ENDIF +#ifdef CompileWithMPI + DEALLOCATE (newvalor3d) +#endif + DEALLOCATE (ATT) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + CLOSE (output(ii)%item(1)%UNIT) + else !del lexis + buff='NOT PROCESSING: Ignoring: Inexistent or void file '//trim(adjustl(output(ii)%item(1)%path)) + CALL print11(layoutnumber, buff) + ENDIF !DEL LEXIS + somethingdone=.true. + ENDIF + ENDIF + ENDIF + END DO barridoprobes !barrido puntos de observacion + + RETURN + END SUBROUTINE createxdmf + + + SUBROUTINE createh5bintxt(sgg,layoutnumber,size) + type (SGGFDTDINFO), intent(IN) :: sgg + INTEGER (KIND=4), INTENT (IN) :: layoutnumber, size + logical :: lexis,algoescrito + INTEGER (KIND=4) :: ii,ierr + integer (KIND=4) :: myunit,myunit2 + CHARACTER (LEN=BUFSIZE) :: whoamishort + CHARACTER (LEN=BUFSIZE) :: pathroot + integer :: my_iostat +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + if (layoutnumber == 0) then !solo el root + open(newunit=myunit,file=trim(adjustl(sgg%nEntradaRoot))//'_h5bin.txt',form='formatted') !lista de todos los .h5bin + write (myunit,'(a)') '!END' + close(myunit,status='delete') + my_iostat=0 +9138 if(my_iostat /= 0) write(*,fmt='(a)',advance='no'), '.' !!if(my_iostat /= 0) print '(i5,a1,i4,2x,a)',9138,'.',layoutnumber,trim(adjustl(sgg%nEntradaRoot))//'_h5bin.txt' + open(newunit=myunit,file=trim(adjustl(sgg%nEntradaRoot))//'_h5bin.txt',form='formatted',err=9138,iostat=my_iostat,status='new',action='write') !lista de todos los .h5bin + algoescrito=.false. + do ii=0,size-1 !auna todos los _h5bin.txt + WRITE (whoamishort, '(i5)') ii + 1 + INQUIRE (FILE=trim(adjustl(trim(adjustl(sgg%nEntradaRoot))//'_'//trim(adjustl(whoamishort))//'_h5bin.txt')), EXIST=lexis) + if (lexis) then + open(newunit=myunit2,file=trim(adjustl(sgg%nEntradaRoot))//'_'//trim(adjustl(whoamishort))//'_h5bin.txt',form='formatted') + do + read (myunit2, '(a)',end=9874) pathroot + write (myunit,'(a)') trim(adjustl(pathroot)) + algoescrito=.true. + end do +9874 close (myunit2,status='delete') + endif + end do + if (algoescrito) then + close(myunit) + else + close(myunit,status='delete') + endif + endif +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + end SUBROUTINE createh5bintxt + + SUBROUTINE createxdmfOnTheFly (sgg,layoutnumber,size,vtkindex,createh5bin,somethingdone,mpidir) + integer (KIND=4) :: mpidir + logical :: vtkindex,createh5bin + !------------------------> + + type (SGGFDTDINFO), intent(IN) :: sgg + INTEGER (KIND=4), INTENT (IN) :: layoutnumber, size + TYPE (output_t), POINTER, DIMENSION (:) :: output + INTEGER (KIND=4) :: ii + logical :: lexis,somethingdone + character(len=BUFSIZE) :: buff + ! + output => GetOutput ()!get the output private info from observation + ! + + DO ii = 1, sgg%NumberRequest + !sondas Volumic traducelas a xdfm + IF (sgg%observation(ii)%Volumic) then + if (sgg%observation(ii)%nP == 1) then + if ((sgg%observation(ii)%P(1)%What /= nothing).AND.(sgg%observation(ii)%P(1)%What /= iCur).AND.(sgg%observation(ii)%P(1)%What /= iCurX).AND.(sgg%observation(ii)%P(1)%What /= iCurY).AND.(sgg%observation(ii)%P(1)%What /= iCurZ)) THEN + ! + INQUIRE (FILE=trim(adjustl(output(ii)%item(1)%path)), EXIST=lexis) + if (.not.lexis) then + buff='NOT PROCESSING: Inexistent file '//trim(adjustl(output(ii)%item(1)%path)) + CALL print11(layoutnumber, buff) + return + ELSE + close (output(ii)%item(1)%unit) + ENDIF !DEL LEXIS + ENDIF + ENDIF + ENDIF + + END DO !barrido puntos de observacion + call createxdmf (sgg,layoutnumber, size,vtkindex,createh5bin,somethingdone,mpidir) + DO ii = 1, sgg%NumberRequest + !sondas Volumic traducelas a xdfm + IF (sgg%observation(ii)%Volumic) then + if (sgg%observation(ii)%nP == 1) then + if ((sgg%observation(ii)%P(1)%What /= nothing).AND.(sgg%observation(ii)%P(1)%What /= iCur).AND.(sgg%observation(ii)%P(1)%What /= iCurX).AND.(sgg%observation(ii)%P(1)%What /= iCurY).AND.(sgg%observation(ii)%P(1)%What /= iCurZ)) THEN + ! + INQUIRE (FILE=trim(adjustl(output(ii)%item(1)%path)), EXIST=lexis) + if (.not.lexis) then + buff='NOT PROCESSING: Inexistent file '//trim(adjustl(output(ii)%item(1)%path)) + CALL print11(layoutnumber, buff) + return + ELSE + open (output(ii)%item(1)%unit,file=trim(adjustl(output(ii)%item(1)%path)),FORM='unformatted',position='append') + ENDIF !DEL LEXIS + ENDIF + ENDIF + ENDIF + + END DO !barrido puntos de observacion + + RETURN + END SUBROUTINE createxdmfOnTheFly +#endif +END MODULE xdmf +! +! diff --git a/src_main_pub/xdmf_h5.F90 b/src_main_pub/xdmf_h5.F90 new file mode 100644 index 00000000..445a429a --- /dev/null +++ b/src_main_pub/xdmf_h5.F90 @@ -0,0 +1,283 @@ +MODULE xdmf_h5 +#ifdef CompileWithHDF + + USE fdetypes + USE HDF5 + IMPLICIT NONE + + INTEGER (HID_T) :: file_id ! File identifier + INTEGER (HID_T) :: dset_id ! Dataset identifier + INTEGER (HID_T) :: dspace_id, slice2D_id ! Dataspace identifier + INTEGER (HSIZE_T), ALLOCATABLE, DIMENSION (:) :: DATA_dims ! Dataset dimensions + INTEGER (HSIZE_T), ALLOCATABLE, DIMENSION (:) :: offset + INTEGER (HSIZE_T), ALLOCATABLE, DIMENSION (:) :: valor3d_dims ! slice dimensions + + ! + PRIVATE + PUBLIC openh5file,writeh5file,closeh5file,createh5filefromsinglebin + +CONTAINS + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine openh5file(filename,finalstep,minXabs,maxXabs, minYabs,maxYabs, minZabs,maxZabs) + + INTEGER :: error ! Error flag + CHARACTER (LEN=BUFSIZE) :: filename ! File name + CHARACTER (LEN=BUFSIZE) :: dsetname ! Dataset name + ! + INTEGER (KIND=4) :: minXabs, maxXabs, minYabs, maxYabs, minZabs, maxZabs,finalstep + + INTEGER :: rank ! Dataset rank + ! + rank = 4 + ALLOCATE(DATA_dims(1:RANK),valor3d_dims(1:RANK),offset(1:RANK)) + ! + DATA_dims (1) = maxXabs - minXabs + 1 + DATA_dims (2) = maxYabs - minYabs + 1 + DATA_dims (3) = maxZabs - minZabs + 1 + DATA_dims (4) = finalstep + ! + valor3d_dims (1) = DATA_dims (1) + valor3d_dims (2) = DATA_dims (2) + valor3d_dims (3) = DATA_dims (3) + valor3d_dims (4) = 1 + + dsetname = 'data' + CALL h5open_f (error) + CALL h5fcreate_f (trim(adjustl(filename))//'.h5', H5F_ACC_TRUNC_F, file_id, error) + CALL h5screate_simple_f (rank, DATA_dims, dspace_id, error) + CALL h5screate_simple_f (rank, valor3d_dims, slice2D_id, error) +#ifdef CompileWithReal8 + CALL h5dcreate_f (file_id, trim(adjustl(dsetname)), H5T_NATIVE_DOUBLE, dspace_id, dset_id, error) +#else + CALL h5dcreate_f (file_id, trim(adjustl(dsetname)), H5T_NATIVE_REAL , dspace_id, dset_id, error) +#endif + +!xdmf part + OPEN (18, FILE=trim(adjustl(filename))//'.xdmf', FORM='formatted') + WRITE (18,*) '' + WRITE (18,*) '' + WRITE (18,*) '' + + + end subroutine openh5file + + subroutine writeh5file(filename,valor3d,indi,attindi,minXabs,maxXabs, minYabs,maxYabs, minZabs,maxZabs, & + linez_minZabs_primero,liney_minYabs_primero,linex_minXabs_primero, & + dz_minZabs,dy_minYabs,dx_minXabs,& + minZabs_primero,minYabs_primero,minXabs_primero,finalstep,vtkindex) + real ( KINd=RKIND_tiempo) :: attindi + CHARACTER (LEN=BUFSIZE) :: filename + logical :: vtkindex + ! + CHARACTER (LEN=BUFSIZE) :: dsetname ! Dataset name + INTEGER (KIND=4) :: indi + REAL (KIND=RKIND), DIMENSION (:, :, :, :) :: valor3d + INTEGER :: error ! Error flag + CHARACTER (LEN=BUFSIZE) :: charc + INTEGER (KIND=4) :: minXabs, maxXabs, minYabs, maxYabs, minZabs, maxZabs, & + minZabs_primero,minYabs_primero,minXabs_primero,finalstep + REAL (KIND=RKIND) :: linez_minZabs_primero,liney_minYabs_primero,linex_minXabs_primero, & + dz_minZabs,dy_minYabs,dx_minXabs + + + offset (1) = 0 + offset (2) = 0 + offset (3) = 0 + offset (4) = indi - 1 + ! + CALL h5sselect_hyperslab_f (dspace_id, H5S_SELECT_SET_F, offset, valor3d_dims, error) +#ifdef CompileWithReal8 + CALL h5dwrite_f (dset_id, H5T_NATIVE_DOUBLE, valor3d, valor3d_dims, error, slice2D_id, & + & dspace_id) +#elif CompileWithReal16 + !miguel-2018: compila pero no testeado + CALL h5dwrite_f (dset_id, H5T_NATIVE_LDOUBLE, valor3d, valor3d_dims, error, slice2D_id, & + & dspace_id) +#else + CALL h5dwrite_f (dset_id, H5T_NATIVE_REAL, valor3d, valor3d_dims, error, slice2D_id, & + & dspace_id) +#endif + + !el .xdmf como usualmente + !HDF5 transposes matrices + WRITE (charc,'(e19.9e3)') attindi !'(i9)') indi ! + dsetname = 'data' + DATA_dims(1) = maxXabs - minXabs + 1 + DATA_dims(2) = maxYabs - minYabs + 1 + DATA_dims(3) = maxZabs - minZabs + 1 + WRITE (18, '(a)') '>' + WRITE (18, '(a)') '' + + + end subroutine writeh5file + + + subroutine closeh5file(finalstep,att) + ! + INTEGER :: rank ! Dataset rank + real ( KINd=RKIND_tiempo), DIMENSION (:) :: att + INTEGER :: error ! Error flag + INTEGER (KIND=4) :: finalstep + CHARACTER (LEN=BUFSIZE) :: dsetname ! Dataset name + + + DEALLOCATE(DATA_dims,valor3d_dims,offset) + + !timedata + CALL h5dclose_f (dset_id, error) + + dsetname='Time' + rank = 1 + ALLOCATE(DATA_dims(rank)) + data_dims(1) = finalstep + + CALL h5screate_simple_f (rank, DATA_dims, dspace_id, error) +#ifdef CompileWithReal8 + CALL h5dcreate_f (file_id, trim(adjustl(dsetname)), H5T_NATIVE_DOUBLE, dspace_id, dset_id, error) + CALL h5dwrite_f (dset_id, H5T_NATIVE_DOUBLE, att, DATA_dims, error) +#elif CompileWithReal16 + !miguel-2018: compila pero no testeado + CALL h5dcreate_f (file_id, trim(adjustl(dsetname)), H5T_NATIVE_LDOUBLE, dspace_id, dset_id, error) + CALL h5dwrite_f (dset_id, H5T_NATIVE_REAL, att, DATA_dims, error) +#else + CALL h5dcreate_f (file_id, trim(adjustl(dsetname)), H5T_NATIVE_REAL, dspace_id, dset_id, error) + CALL h5dwrite_f (dset_id, H5T_NATIVE_REAL, att, DATA_dims, error) +#endif + cALL h5dclose_f (dset_id, error) + + CALL h5sclose_f (slice2D_id, error) + CALL h5sclose_f (dspace_id, error) + + + + CALL h5fclose_f (file_id, error) + CALL h5close_f (error) + ! + ! + WRITE (18, '(a)') '' + WRITE (18, '(a)') '' + WRITE (18, '(a)') '' + CLOSE (18) + ! + DEALLOCATE(DATA_dims) + + + end subroutine closeh5file + + subroutine createh5filefromsinglebin(filename,vtkindex) + integer (KIND=4) :: myunit,fieldob,pasadas,pasadastotales + CHARACTER (LEN=BUFSIZE) :: filename,fichin ! File name + real ( KINd=RKIND_tiempo), ALLOCATABLE, DIMENSION (:) :: att + REAL (KIND=RKIND), ALLOCATABLE, DIMENSION (:, :, :, :) :: valor3d !para sondas Volumic + logical :: vtkindex,SGGObservationiiTimeDomain + INTEGER (KIND=4) :: minXabs, maxXabs, minYabs, maxYabs, minZabs, maxZabs, & + minZabs_primero,minYabs_primero,minXabs_primero,finalstep,indi,i1,j1,k1 + REAL (KIND=RKIND) :: linez_minZabs_primero,liney_minYabs_primero,linex_minXabs_primero, & + dz_minZabs,dy_minYabs,dx_minXabs + character (LEN=BUFSIZE) :: dubuf + + filename=filename(1:index(filename,'.h5bin')-1); filename=trim(adjustl(filename)) + + open(newunit=myunit,file=trim(adjustl(filename))//'.h5bin',form='unformatted') + read (myunit) finalstep,minXabs, maxXabs, minYabs, maxYabs, minZabs, maxZabs,fieldob, & + SGGObservationiiTimeDomain,pasadastotales + + ALLOCATE (valor3d(minXabs:maxXabs, minYabs:maxYabs, minZabs:maxZabs, 1)) + allocate (att(1:finalstep)) + + buclepasadas: do pasadas=1,pasadastotales + if (SGGObservationiiTimeDomain) then + if (pasadas==1) then + fichin = trim (adjustl(filename))//'_time' + else + print *,'Buggy error in valor3d. ' + stop + endif + else + if (pasadas==1) then + fichin = trim (adjustl(filename))//'_mod' + elseif (pasadas==2) then + fichin = trim (adjustl(filename))//'_phase' + else + print *,'Buggy error in valor3d. ' + stop + endif + endif + + + if (.not.(((fieldob == iMEC).or.(fieldob ==iMHC)).and.(pasadas ==2))) then ! no tiene sentido esccribir la fase + call openh5file(fichin,finalstep,minXabs,maxXabs, minYabs,maxYabs, minZabs,maxZabs) + endif + + valor3d = 0.0_RKIND + att=0.0_RKIND + DO indi = 1, finalstep + read(myunit) minZabs_primero,minYabs_primero,minXabs_primero + read(myunit) linez_minZabs_primero,liney_minYabs_primero,linex_minXabs_primero + read(myunit) dz_minZabs,dy_minYabs,dx_minXabs + read (myunit) att(indi) + write(dubuf,*) ' ----> .xdmf file ',att(indi),'(',indi,'/',finalstep,')' + print *,trim(adjustl(dubuf)) + DO k1 = minzabs, maxzabs + DO j1 = minyabs, maxyabs + read (myunit) (valor3d(i1, j1, k1, 1), i1=minxabs, maxxabs) + END DO + END DO + + if (.not.(((fieldob == iMEC).or.(fieldob ==iMHC)).and.(pasadas ==2))) then ! no tiene sentido esccribir la fase + call writeh5file(fichin,valor3d,indi,att(indi),minXabs,maxXabs, minYabs,maxYabs, minZabs,maxZabs, & + linez_minZabs_primero,liney_minYabs_primero,linex_minXabs_primero, & + dz_minZabs,dy_minYabs,dx_minXabs,& + minZabs_primero,minYabs_primero,minXabs_primero,finalstep,vtkindex) + endif + end do + + if (.not.(((fieldob == iMEC).or.(fieldob ==iMHC)).and.(pasadas ==2))) then ! no tiene sentido esccribir la fase + call closeh5file(finalstep,att) + endif + end do buclepasadas + + close(myunit) + + DEALLOCATE (valor3d) + DEALLOCATE (ATT) + + + end subroutine createh5filefromsinglebin + + +#endif + +END MODULE xdmf_h5 \ No newline at end of file From efb237e9abd5fddf7100fff12160ad2ddc8d8045 Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Sat, 9 Nov 2024 10:48:03 +0100 Subject: [PATCH 06/13] Adds test to check movie is created in test sphere --- src_pyWrapper/pyWrapper.py | 14 ++++---------- test/pyWrapper/test_full_system.py | 28 +++++++++++++++++----------- test/pyWrapper/utils.py | 9 ++++++++- 3 files changed, 29 insertions(+), 22 deletions(-) diff --git a/src_pyWrapper/pyWrapper.py b/src_pyWrapper/pyWrapper.py index b54566de..8fd1f75c 100644 --- a/src_pyWrapper/pyWrapper.py +++ b/src_pyWrapper/pyWrapper.py @@ -13,17 +13,11 @@ class Probe(): def __init__(self, probe_filename): self.filename = probe_filename - - # with open(probe_filename, 'r') as file: - # data = file.read() - # data = data.replace('/', '-') - # with open(probe_filename, 'w') as file: - # file.write(data) mtln_probe_tags = ['_V_','_I_'] current_probe_tags = ['_Wx_', '_Wy_', '_Wz_'] far_field_tag = ['_FF_'] - movie_tags = ['_ExC_', '_EyC_', '_EzC_', '_HxC_', '_HyC_', '_HzC_'] + movie_tags = ['_ExC_', '_EyC_', '_EzC_', '_HxC_', '_HyC_', '_HzC_', '_ME_', '_MH_'] all_tags = current_probe_tags + far_field_tag + movie_tags + mtln_probe_tags @@ -48,14 +42,14 @@ def __init__(self, probe_filename): elif tag in far_field_tag: self.type = 'farField' self.name, positions_str = basename_with_no_case_name.split(tag) - init_str, end_str = pos = positions_str.split('__') + init_str, end_str = positions_str.split('__') self.cell_init = positionStrToCell(init_str) self.cell_end = positionStrToCell(end_str) self.df = pd.read_csv(self.filename, sep='\s+') elif tag in movie_tags: self.type = 'movie' self.name, positions_str = basename_with_no_case_name.split(tag) - init_str, end_str = pos = positions_str.split('__') + init_str, end_str = positions_str.split('__') self.cell_init = positionStrToCell(init_str) self.cell_end = positionStrToCell(end_str) elif tag in mtln_probe_tags: @@ -101,7 +95,7 @@ def getSolvedProbeFilenames(self, probe_name): if not "probes" in input_json: raise ValueError('Solver does not contain probes.') - file_extensions = ('*.dat', '*.bin') + file_extensions = ('*.dat', '*.xdmf', '*.bin', '*.h5') probeFiles = [] for ext in file_extensions: newProbes = [x for x in glob.glob(ext) if re.match(self.case + '_' + probe_name, x)] diff --git a/test/pyWrapper/test_full_system.py b/test/pyWrapper/test_full_system.py index ebeef72d..d51acdc9 100644 --- a/test/pyWrapper/test_full_system.py +++ b/test/pyWrapper/test_full_system.py @@ -91,27 +91,33 @@ def test_towelHanger(tmp_path): for i in range(3): p_solved = Probe(probe_files[i]) assert np.allclose(p_expected[i].df.to_numpy()[:,0:3], p_solved.df.to_numpy()[:,0:3], rtol = 5e-2, atol=5e-2) - - def test_sphere(tmp_path): case = 'sphere' input_json = getCase(case) - input_json['general']['numberOfSteps'] = 200 - input_json['probes'][0]['domain']['numberOfFrequencies'] = 100 + input_json['general']['numberOfSteps'] = 20 + input_json['probes'][0]['domain']['initialFrequency'] = 1e8 + input_json['probes'][0]['domain']['finalFrequency'] = 1e9 fn = tmp_path._str + '/' + case + '.fdtd.json' - with open(fn, 'w') as modified_json: - json.dump(input_json, modified_json) + with open(fn, 'w') as modified_json_file: + json.dump(input_json, modified_json_file) makeCopy(tmp_path, EXCITATIONS_FOLDER+'gauss.exc') solver = FDTD(input_filename = fn, path_to_exe=SEMBA_EXE) solver.run() - probe_files = solver.getSolvedProbeFilenames("Far") # semba-fdtd seems to always use the name Far for "far field" probes. + assert solver.hasFinishedSuccessfully() + far_field_probe_files = solver.getSolvedProbeFilenames("Far") # semba-fdtd seems to always use the name Far for "far field" probes. assert solver.hasFinishedSuccessfully() == True - assert len(probe_files) == 1 - - p = Probe(probe_files[0]) - assert p.type == 'farField' \ No newline at end of file + assert len(far_field_probe_files) == 1 + p = Probe(far_field_probe_files[0]) + assert p.type == 'farField' + + electric_field_movie_files = solver.getSolvedProbeFilenames("electric_field_movie") + assert solver.hasFinishedSuccessfully() == True + assert len(electric_field_movie_files) == 3 + p = Probe(electric_field_movie_files[0]) + assert p.type == 'movie' + \ No newline at end of file diff --git a/test/pyWrapper/utils.py b/test/pyWrapper/utils.py index dc0f93b3..f40f920f 100644 --- a/test/pyWrapper/utils.py +++ b/test/pyWrapper/utils.py @@ -30,7 +30,14 @@ def copyInputFiles(temp_dir, input, excitation, executable): makeCopy(temp_dir, executable) def getProbeFile(prefix, probe_name): - return ([x for x in glob.glob('*dat') if re.match(prefix + '_' + probe_name + '.*dat',x)])[0] + extensions = ["dat", "xdmf", "h5", "bin"] + + probeFiles = [] + for ext in extensions: + newFiles = ([x for x in glob.glob('*'+ext) if re.match(prefix + '_' + probe_name + '.*'+ext, x)])[0] + probeFiles.append(newFiles) + + return probeFiles def countLinesInFile(probe_fn): with open(probe_fn, 'r') as f: From b86c8b9ff5bd10794f7c46445f6ace7ac4b89d9e Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Sat, 9 Nov 2024 12:26:13 +0100 Subject: [PATCH 07/13] Removes CompileWithXDMF --- CMakeLists.txt | 1 - src_main_pub/errorreport.F90 | 4 ---- src_main_pub/semba_fdtd.F90 | 5 ----- src_main_pub/timestepping.F90 | 8 ++------ src_main_pub/xdmf.F90 | 2 -- 5 files changed, 2 insertions(+), 18 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index f160667e..b9b12c42 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -148,7 +148,6 @@ add_definitions( -DCompileWithDMMA -DCompileWithSGBC -DCompileWithWires --DCompileWithXDMF ) diff --git a/src_main_pub/errorreport.F90 b/src_main_pub/errorreport.F90 index 69ebb436..80467f08 100755 --- a/src_main_pub/errorreport.F90 +++ b/src_main_pub/errorreport.F90 @@ -25,9 +25,7 @@ Module Report use FDETYPES -#ifdef CompileWithXDMF use snapxdmf -#endif implicit none private @@ -1160,7 +1158,6 @@ subroutine Timing(sgg, b, n, n_info, layoutnumber, size, maxCPUtime,flushseconds call MPI_Barrier(MPI_COMM_WORLD,ierr) #endif -#ifdef CompileWithXDMF if ((mustsnap.and.(lmaxval (layoutnumber+1)> snapLevel)).or.(countersnap > 0)) then countersnap=countersnap + 1 ! @@ -1264,7 +1261,6 @@ subroutine Timing(sgg, b, n, n_info, layoutnumber, size, maxCPUtime,flushseconds countersnap=0 endif endif -#endif #ifdef CompileWithMPI call MPI_Barrier(MPI_COMM_WORLD,ierr) !TODOS STOCH O NO 060619 diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index b8b9f25b..cade29e2 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -55,10 +55,7 @@ PROGRAM SEMBA_FDTD_launcher USE Preprocess_m USE storeData - -#ifdef CompileWithXDMF USE xdmf_h5 -#endif ! #ifdef CompileWithMPI USE MPIcomm @@ -394,7 +391,6 @@ PROGRAM SEMBA_FDTD_launcher end if #endif -#ifdef CompileWithXDMF #ifdef CompileWithHDF !!!!tunel a lo bestia para crear el .h5 a 021219 if (l%createh5filefromsinglebin) then @@ -418,7 +414,6 @@ PROGRAM SEMBA_FDTD_launcher #endif stop endif -#endif #endif IF (status /= 0) then diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 6b73926f..d21bec79 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -53,9 +53,7 @@ module Solver use nodalsources use Lumped use PMLbodies -#ifdef CompileWithXDMF use xdmf -#endif use vtk #ifdef CompileWithMPI use MPIcomm @@ -1957,10 +1955,10 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx call print11(layoutnumber,dubuf) call print11(layoutnumber,SEPARADOR//separador//separador) somethingdone=.false. -#ifdef CompileWithXDMF + if (Thereare%Observation) call createxdmfOnTheFly(sgg,layoutnumber,size,vtkindex,createh5bin,somethingdone,mpidir) if (createh5bin) call createh5bintxt(sgg,layoutnumber,size) !lo deben llamar todos haya on on thereare%observation -#endif + #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) @@ -2177,11 +2175,9 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx write(dubuf,*) SEPARADOR//separador//separador call print11(layoutnumber,dubuf) somethingdone=.false. -#ifdef CompileWithXDMF if (Thereare%Observation) call createxdmf(sgg,layoutnumber,size,vtkindex,createh5bin,somethingdone,mpidir) if (createh5bin) call createh5bintxt(sgg,layoutnumber,size) !lo deben llamar todos haya o no thereare%observation ! call create_interpreted_mesh(sgg) -#endif #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_main_pub/xdmf.F90 b/src_main_pub/xdmf.F90 index 162d5ac4..31633e79 100644 --- a/src_main_pub/xdmf.F90 +++ b/src_main_pub/xdmf.F90 @@ -1,6 +1,5 @@ MODULE xdmf ! -#ifdef CompileWithXDMF USE fdetypes USE Observa use report @@ -575,7 +574,6 @@ SUBROUTINE createxdmfOnTheFly (sgg,layoutnumber,size,vtkindex,createh5bin,someth RETURN END SUBROUTINE createxdmfOnTheFly -#endif END MODULE xdmf ! ! From 98b4fae55f74590f7a8536e44a8ee5feddc312be Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Sat, 9 Nov 2024 12:36:17 +0100 Subject: [PATCH 08/13] Removes CompileWithN2FF --- CMakeLists.txt | 1 - src_main_pub/errorreport.F90 | 9 --------- src_main_pub/farfield.F90 | 4 ---- src_main_pub/interpreta_switches.F90 | 8 -------- src_main_pub/observation.F90 | 24 ++++-------------------- src_main_pub/resuming.F90 | 4 ---- 6 files changed, 4 insertions(+), 46 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b9b12c42..9a801a07 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -144,7 +144,6 @@ add_definitions( -DCompileWithOpenMP -DCompileWithAnisotropic -DCompileWithEDispersives --DCompileWithNF2FF -DCompileWithDMMA -DCompileWithSGBC -DCompileWithWires diff --git a/src_main_pub/errorreport.F90 b/src_main_pub/errorreport.F90 index 80467f08..fbbec1c1 100755 --- a/src_main_pub/errorreport.F90 +++ b/src_main_pub/errorreport.F90 @@ -298,15 +298,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML call print11(layoutnumber,SEPARADOR//sEPARADOR//SEPARADOR) !!! ! - IF (thereare%FarFields) then -#ifdef CompileWithNF2FF - continue -#else - buff=trim(adjustl(whoami))//' NF2FF unsupported. Recompile' - call stoponerror(layoutnumber,size,buff) -#endif - endif - ! IF (thereare%SGBCs) then #ifdef CompileWithSGBC continue diff --git a/src_main_pub/farfield.F90 b/src_main_pub/farfield.F90 index ad041658..9c4c9422 100755 --- a/src_main_pub/farfield.F90 +++ b/src_main_pub/farfield.F90 @@ -29,9 +29,6 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! module farfield_m - -#ifdef CompileWithNF2FF - use fdetypes USE REPORT @@ -3576,5 +3573,4 @@ function average (pasadas,z1,z2) result (z) RETURN END FUNCTION -#endif END MODULE farfield_m diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index 6e8ee834..50a45e87 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -1608,12 +1608,10 @@ subroutine print_help(l) CALL print11 (l%layoutnumber, '-clip : Permits to clip a bigger problem truncating wires.') CALL print11 (l%layoutnumber, '-wirecrank : Uses Crank-Nicolson for wires (development) ') #endif -#ifdef CompileWithNF2FF CALL print11 (l%layoutnumber, '-noNF2FF string : Supress a NF2FF plane for calculation ') CALL print11 (l%layoutnumber, '& String can be: up, down, left, right, back , front') CALL print11 (l%layoutnumber, '-NF2FFDecim : Uses decimation in NF2FF calculation (faster). ') CALL print11 (l%layoutnumber, '& WARNING: High-freq aliasing may occur ') -#endif CALL print11 (l%layoutnumber, '-vtkindex : Output index instead of real point in 3D slices. ') CALL print11 (l%layoutnumber, '-ignoreerrors : Run even if errors reported in *Warnings.txt file.') CALL print11 (l%layoutnumber, '___________________________________________________________________________') @@ -1695,11 +1693,7 @@ subroutine print_help(l) #else !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Conformal algorithm') #endif -#ifdef CompileWithNF2FF CALL print11 (l%layoutnumber, 'SUPPORTED: Near-to-Far field probes') -#else - !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Near-to-Far field probes') -#endif #ifdef CompileWithAnisotropic CALL print11 (l%layoutnumber, 'SUPPORTED: Lossy anistropic materials, both electric and magnetic') #else @@ -1725,14 +1719,12 @@ subroutine print_help(l) #else !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Isotropic Multilayer Skin-depth Materials (l%mibc)') #endif - #ifdef CompileWithWires CALL print11 (l%layoutnumber, 'SUPPORTED: Loaded and grounded thin-wires with juntions') #else !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Loaded and grounded thin-wires with juntions') #endif CALL print11 (l%layoutnumber, 'SUPPORTED: Nodal hard/soft electric and magnetic sources') - #ifdef CompileWithHDF CALL print11 (l%layoutnumber, 'SUPPORTED: .xdmf+.h5 probes ') #else diff --git a/src_main_pub/observation.F90 b/src_main_pub/observation.F90 index c06b5df3..32708936 100755 --- a/src_main_pub/observation.F90 +++ b/src_main_pub/observation.F90 @@ -50,10 +50,7 @@ module Observa use WiresSlanted_Constants #endif use report - -#ifdef CompileWithNF2FF use farfield_m -#endif use nodalsources ! IMPLICIT NONE @@ -428,7 +425,6 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s endif #endif case (FarField) -#ifdef CompileWithNF2FF if ( (sgg%observation(ii)%P(1)%ZI > sgg%SINPMLSweep(IHz)%ZE).or. & !MPI NO DUPLICAR CALCULOS (sgg%observation(ii)%P(1)%ZE < sgg%SINPMLSweep(iHz)%ZI)) then @@ -450,9 +446,6 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s endif #endif ! -#else - call stoponerror(layoutnumber,size,'Current version does not support Near to Far field. Recompile') -#endif end select end do end do @@ -2086,8 +2079,8 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s endif endif endif -#ifdef CompileWithNF2FF - case (farfield) + + case (farfield) ThereAreFarFields=.true. ! write(chari ,'(i7)') sgg%observation(ii)%P(1)%XI @@ -2153,7 +2146,6 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s ,output(ii)%item(i)%MPISubComm,output(ii)%item(i)%MPIRoot & #endif ,eps0,mu0) -#endif !no es necesario hacer wipe out pq en DF se van machacando end select end do loop_ob @@ -3668,7 +3660,6 @@ subroutine UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz endif endif !!!!!!!!fin sondas corriente -#ifdef CompileWithNF2FF case( FarField) if (planewavecorr) then Excor=Ex-Exvac; Eycor=Ey-Eyvac; Ezcor=Ez-Ezvac; @@ -3677,8 +3668,6 @@ subroutine UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz else call UpdateFarField(ntime, b, Ex, Ey, Ez,Hx,Hy,Hz) endif - -#endif endselect !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!FREQMAIN !!!!!!!!!!!!!!!!!!!! @@ -4212,11 +4201,10 @@ subroutine FlushObservationFiles(sgg,nInit,FinalInstant,layoutnumber,size, dxe,d #ifdef CompileWithMPI endif #endif -#ifdef CompileWithNF2FF - CASe (FarField) !no emplear tiempo calculando rcs por el camino solo al final + + case (FarField) !no emplear tiempo calculando rcs por el camino solo al final at=sgg%tiempo(FinalInstant) if (flushFF) call FlushFarfield(layoutnumber,size, b, dxe, dye, dze, dxh, dyh, dzh,facesNF2FF,at) -#endif case (iMHC,iHxC,iHyC,iHzC,iMEC,iExC,iEyC,iEzC,icur,iCurX,iCurY,iCurZ,mapvtk) DO N=nInit,FinalInstant at=sgg%tiempo(N) @@ -4486,14 +4474,12 @@ subroutine DestroyObservation(sgg) case (iBloqueMz,iBloqueJz,iEx,iEy,iEz,iHx,iHy,iHz) deallocate (output(ii)%item(i)%valor) -#ifdef CompileWithNF2FF case (farfield) call DestroyFarField #ifdef CompileWithMPI if (output(ii)%item(i)%MPISubComm /= -1) then call MPI_Group_free(output(ii)%item(i)%MPIgroupindex,ierr) endif -#endif #endif end select end do @@ -4577,10 +4563,8 @@ function prefix(campo) result(ext) ext='BCY_' case (iCurZ) ext='BCZ_' -#ifdef CompileWithNF2FF case (farfield) ext='FF_' -#endif end select return diff --git a/src_main_pub/resuming.F90 b/src_main_pub/resuming.F90 index 08c39da4..ab9d46d0 100755 --- a/src_main_pub/resuming.F90 +++ b/src_main_pub/resuming.F90 @@ -56,9 +56,7 @@ module resuming use MDispersives #endif -#ifdef CompileWithNF2FF use farfield_m -#endif !Wires Thin Module #ifdef CompileWithWires @@ -366,9 +364,7 @@ subroutine flush_and_save_resume(sgg, b, layoutnumber, size, nentradaroot, nresu if( Thereare%MDispersives) call StoreFieldsMDispersives #endif if( Thereare%PlaneWaveBoxes) call StorePlaneWaves(sgg) -#ifdef CompileWithNF2FF if( Thereare%FarFields) call StoreFarFields(b) !called at initobservation -#endif #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) #endif From b1a666c18e424c34c036aa46781c6122bd24d9fe Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Sat, 9 Nov 2024 12:42:03 +0100 Subject: [PATCH 09/13] Removes CompileWithAnisotropic --- CMakeLists.txt | 1 - src_main_pub/anisotropic.F90 | 5 ----- src_main_pub/errorreport.F90 | 11 ----------- src_main_pub/interpreta_switches.F90 | 10 ---------- src_main_pub/semba_fdtd.F90 | 10 ---------- src_main_pub/timestepping.F90 | 21 ++++++--------------- 6 files changed, 6 insertions(+), 52 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 9a801a07..2ae6ad95 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -142,7 +142,6 @@ add_definitions( -DCompileWithInt2 -DCompileWithReal4 -DCompileWithOpenMP --DCompileWithAnisotropic -DCompileWithEDispersives -DCompileWithDMMA -DCompileWithSGBC diff --git a/src_main_pub/anisotropic.F90 b/src_main_pub/anisotropic.F90 index 788e45e2..cd980a45 100755 --- a/src_main_pub/anisotropic.F90 +++ b/src_main_pub/anisotropic.F90 @@ -32,9 +32,6 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! module Anisotropic - -#ifdef CompileWithAnisotropic - use fdetypes implicit none private @@ -1581,6 +1578,4 @@ Subroutine CalculateCoeff(epr,mur,sigma,sigmam,dt,coeff) end subroutine -#endif - end module Anisotropic diff --git a/src_main_pub/errorreport.F90 b/src_main_pub/errorreport.F90 index fbbec1c1..580c41ff 100755 --- a/src_main_pub/errorreport.F90 +++ b/src_main_pub/errorreport.F90 @@ -316,15 +316,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML endif ! ! - IF (thereare%Anisotropic) then -#ifdef CompileWithAnisotropic - continue -#else - buff=trim(adjustl(whoami))//' Anisotropic unsupported. Recompile' - call stoponerror(layoutnumber,size,buff) -#endif - endif - ! IF (thereare%ThinSlot) then #ifdef CompileWithDMMA continue @@ -397,7 +388,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML buff= ' has Thin metal Materials' call warnerrreport(buff) endif -#ifdef CompileWithAnisotropic IF ((thereare%Anisotropic).and.(.not.thereare%ThinSlot)) then buff= ' has pure anisotropic media' call warnerrreport(buff) @@ -407,7 +397,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML buff= ' has Thin Slots' call warnerrreport(buff) endif -#endif #endif ! #ifdef CompileWithEDispersives diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index 50a45e87..c9e4d4fe 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -1019,12 +1019,6 @@ subroutine interpreta(l,statuse) END IF #endif -#ifdef CompileWithDMMA -#ifndef CompileWithAnisotropic - CALL stoponerror (l%layoutnumber, l%size, 'ERROR: DMMA without Anisotropic support. Recompile!') -#endif -#endif - IF (l%connectendings .AND. l%strictOLD) THEN CALL stoponerror (l%layoutnumber, l%size, 'l%strictOLD option not compatible with -l%connectendings',.true.); statuse=-1; !goto 668 END IF @@ -1694,11 +1688,7 @@ subroutine print_help(l) !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Conformal algorithm') #endif CALL print11 (l%layoutnumber, 'SUPPORTED: Near-to-Far field probes') -#ifdef CompileWithAnisotropic CALL print11 (l%layoutnumber, 'SUPPORTED: Lossy anistropic materials, both electric and magnetic') -#else - !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Lossy anistropic materials, both electric and magnetic') -#endif #ifdef CompileWithDMMA CALL print11 (l%layoutnumber, 'SUPPORTED: Thin Slots ') #else diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index cade29e2..6ea06526 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -649,16 +649,6 @@ PROGRAM SEMBA_FDTD_launcher IF (sgg%Med(i)%Is%ThinSlot) THEN #ifndef CompileWithDMMA CALL stoponerror (l%layoutnumber, l%size, 'Slots without Slots support. Recompile!') -#endif -#ifndef CompileWithAnisotropic - CALL stoponerror (l%layoutnumber, l%size, 'Slots without Anisotropic support. Recompile!') -#endif - CONTINUE - END IF - ! - IF (sgg%Med(i)%Is%Anisotropic) THEN -#ifndef CompileWithAnisotropic - CALL stoponerror (l%layoutnumber, l%size, 'Anisotropics without Anisotropic support. Recompile!') #endif CONTINUE END IF diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index d21bec79..68284940 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -77,9 +77,7 @@ module Solver use EDispersives use MDispersives #endif -#ifdef CompileWithAnisotropic use Anisotropic -#endif #ifdef CompileWithWires use HollandWires #endif @@ -861,9 +859,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif #endif - - -#ifdef CompileWithAnisotropic !Anisotropic #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) @@ -876,12 +871,11 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx call MPI_Barrier(SUBCOMM_MPI,ierr) call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif - if (l_auxoutput) then - write (dubuf,*) '----> there are Structured anisotropic elements'; call print11(layoutnumber,dubuf) - else - write(dubuf,*) '----> no Structured anisotropic elements found'; call print11(layoutnumber,dubuf) - endif -#endif + if (l_auxoutput) then + write (dubuf,*) '----> there are Structured anisotropic elements'; call print11(layoutnumber,dubuf) + else + write(dubuf,*) '----> no Structured anisotropic elements found'; call print11(layoutnumber,dubuf) + endif #ifdef CompileWithSGBC IF (sgbc) then @@ -1328,12 +1322,11 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx if (thereareplanewave) call print11(layoutnumber,dubuf) endif endif -#ifdef CompileWithAnisotropic + !Anisotropic !Must be previous to the main stepping since the main stepping overrides the past components with the last and the !lossy part of the anisotropic STILL requires the past info on adjacent components IF (Thereare%Anisotropic) call AdvanceAnisotropicE(sgg%alloc,ex,ey,ez,hx,hy,hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh) -#endif !!electric Fields Maxwell AND CPML Zone !!for tuning @@ -1534,12 +1527,10 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx ! !Magnetic Fields Maxwell AND CPML Zone -#ifdef CompileWithAnisotropic !Anisotropic !Must be previous to the main stepping since the main stepping overrides the past components with the last and the !lossy part of the anisotropic STILL requires the past info on adjacent components IF (Thereare%Anisotropic) call AdvanceAnisotropicH(sgg%alloc,ex,ey,ez,hx,hy,hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh) -#endif !************************************************************************************************** !***[conformal] ******************************************************************* From d2e6fb68c5370d55532e095b3c9e150e656898c1 Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Sat, 9 Nov 2024 12:47:08 +0100 Subject: [PATCH 10/13] Removes CompileWithSGBC --- CMakeLists.txt | 1 - src_main_pub/errorreport.F90 | 8 -------- src_main_pub/interpreta_switches.F90 | 7 +------ src_main_pub/maloney_nostoch.F90 | 3 --- src_main_pub/resuming.F90 | 8 +------- src_main_pub/semba_fdtd.F90 | 3 --- src_main_pub/timestepping.F90 | 16 ---------------- 7 files changed, 2 insertions(+), 44 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2ae6ad95..0e8e2998 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -144,7 +144,6 @@ add_definitions( -DCompileWithOpenMP -DCompileWithEDispersives -DCompileWithDMMA --DCompileWithSGBC -DCompileWithWires ) diff --git a/src_main_pub/errorreport.F90 b/src_main_pub/errorreport.F90 index 580c41ff..5ea30952 100755 --- a/src_main_pub/errorreport.F90 +++ b/src_main_pub/errorreport.F90 @@ -298,14 +298,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML call print11(layoutnumber,SEPARADOR//sEPARADOR//SEPARADOR) !!! ! - IF (thereare%SGBCs) then -#ifdef CompileWithSGBC - continue -#else - buff=trim(adjustl(whoami))//' SGBC unsupported. Recompile' - call stoponerror(layoutnumber,size,buff) -#endif - endif IF ((thereare%Multiports).or.(thereare%AnisMultiports)) then #ifdef CompileWithNIBC continue diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index c9e4d4fe..d23ab89d 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -1533,7 +1533,6 @@ subroutine print_help(l) #endif CALL print11 (l%layoutnumber, '-prioritizeCOMPOoverPEC: Uses Composites instead of PEC in conflicts. ') CALL print11 (l%layoutnumber, '-prioritizeISOTROPICBODYoverall: Uses ISOTROPIC BODY FOR conflicts (JUST FOR SIVA). ') -#ifdef CompileWithSGBC CALL print11 (l%layoutnumber, '-sgbc : Enables the defaults sgbc model for composites. Default sgbc:') CALL print11 (l%layoutnumber, '-nosgbc : Disables the defaults sgbc model for composites. Default sgbc:') CALL print11 (l%layoutnumber, '& -sgbfreq 3e9 -sgbresol 1 -sgbcrank ') @@ -1543,7 +1542,7 @@ subroutine print_help(l) CALL print11 (l%layoutnumber, '-sgbccrank : Uses sgbc Crank-Nicolson (default) ') CALL print11 (l%layoutnumber, '-sgbcdepth number : Overrides automatic calculation of number of cells ') CALL print11 (l%layoutnumber, '& within sgbc ') -#endif + CALL print11 (l%layoutnumber, '-pmlalpha factor order : CPML Alpha factor (>=0, <1 sug.) & polyn. grading.') CALL print11 (l%layoutnumber, '& alpha=factor * maximum_PML_sigma , order=polynom. ') write(buff,'(a,2e10.2e3)') '& Default= ',l%alphamaxpar,l%alphaOrden @@ -1699,11 +1698,7 @@ subroutine print_help(l) #else !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Electric and Magnetic Dispersive materials ') #endif -#ifdef CompileWithSGBC CALL print11 (l%layoutnumber, 'SUPPORTED: Isotropic Multilayer Skin-depth Materials (sgbc)') -#else - !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Isotropic Multilayer Skin-depth Materials (sgbc)') -#endif #ifdef CompileWithNIBC CALL print11 (l%layoutnumber, 'SUPPORTED: Isotropic Multilayer Skin-depth Materials (l%mibc)') #else diff --git a/src_main_pub/maloney_nostoch.F90 b/src_main_pub/maloney_nostoch.F90 index fae1044d..38f50865 100755 --- a/src_main_pub/maloney_nostoch.F90 +++ b/src_main_pub/maloney_nostoch.F90 @@ -38,8 +38,6 @@ module SGBC_nostoch - -#ifdef CompileWithSGBC #ifndef CompileWithStochastic use Report @@ -1717,7 +1715,6 @@ subroutine solve_tridiag_iguales(aa,bb,cc,a1,b1,c1,an,bn,cn,d,x,n) end subroutine solve_tridiag_iguales #endif -#endif end module SGBC_nostoch diff --git a/src_main_pub/resuming.F90 b/src_main_pub/resuming.F90 index ab9d46d0..084f0b06 100755 --- a/src_main_pub/resuming.F90 +++ b/src_main_pub/resuming.F90 @@ -35,14 +35,11 @@ module resuming !Thin metals - -#ifdef CompileWithSGBC #ifdef CompileWithStochastic use SGBC_stoch #else use SGBC_NOstoch #endif -#endif use PMLbodies use Lumped @@ -342,7 +339,6 @@ subroutine flush_and_save_resume(sgg, b, layoutnumber, size, nentradaroot, nresu #endif if (ThereAre%Lumpeds) call StoreFieldsLumpeds(stochastic) -#ifdef CompileWithSGBC #ifdef CompileWithMPI #ifdef CompileWithStochastic if (stochastic) then @@ -352,9 +348,7 @@ subroutine flush_and_save_resume(sgg, b, layoutnumber, size, nentradaroot, nresu #endif if( Thereare%SGBCs) then call StoreFieldsSGBCs(stochastic) - endif - -#endif + endif #ifdef CompileWithNIBC if( Thereare%Multiports) call StoreFieldsMultiports #endif diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index 6ea06526..b86dd149 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -657,10 +657,7 @@ PROGRAM SEMBA_FDTD_launcher #ifndef CompileWithNIBC if (l%mibc) CALL stoponerror (l%layoutnumber, l%size, 'l%mibc Multiports without support. Recompile!') #endif - -#ifndef CompileWithSGBC if (l%sgbc) CALL stoponerror (l%layoutnumber, l%size, 'sgbc thin metals without support. Recompile!') -#endif if (.not.(l%mibc.or.l%sgbc)) & CALL stoponerror (l%layoutnumber, l%size, 'Choose some treatment for multiports (-l%mibc,-sgbc)') CONTINUE diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 68284940..281298c9 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -65,13 +65,11 @@ module Solver use Multiports #endif -#ifdef CompileWithSGBC #ifdef CompileWithStochastic use sgbc_stoch #else use sgbc_NOstoch #endif -#endif #ifdef CompileWithEDispersives use EDispersives @@ -877,7 +875,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx write(dubuf,*) '----> no Structured anisotropic elements found'; call print11(layoutnumber,dubuf) endif -#ifdef CompileWithSGBC IF (sgbc) then #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) @@ -897,7 +894,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx write(dubuf,*) '----> no Structured sgbc elements found'; call print11(layoutnumber,dubuf) endif endif -#endif !!!! #ifdef CompileWithNIBC @@ -1214,7 +1210,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx #endif #endif !!!no se si el orden wires - sgbcs del sync importa 150519 -#ifdef CompileWithSGBC #ifdef CompileWithMPI #ifdef CompileWithStochastic if (stochastic) then @@ -1222,7 +1217,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif #endif #endif -#endif #ifdef CompileWithMPI #ifdef CompileWithStochastic @@ -1469,13 +1463,10 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx IF (Thereare%Multiports.and.(mibc)) call AdvanceMultiportE(sgg%alloc,Ex, Ey, Ez) #endif - -#ifdef CompileWithSGBC !MultiportS H-field advancing IF (Thereare%sgbcs.and.(sgbc)) then call AdvancesgbcE(real(sgg%dt,RKIND),sgbcDispersive,simu_devia,stochastic) endif -#endif !!! if (ThereAre%Lumpeds) call AdvanceLumpedE(sgg,n,simu_devia,stochastic) !!! @@ -1638,13 +1629,10 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx call CloneMagneticPeriodic(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,layoutnumber,size) endif ! - -#ifdef CompileWithSGBC !MultiportS H-field advancing IF (Thereare%sgbcs.and.(sgbc)) then call AdvancesgbcH endif -#endif #ifdef CompileWithEDispersives !MDispersives (only updated here. No need to update in the E-field part) @@ -1749,14 +1737,12 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx #endif !!!no se si el orden wires - sgbcs del sync importa 150519 -#ifdef CompileWithSGBC #ifdef CompileWithMPI #ifdef CompileWithStochastic if (stochastic) then call syncstoch_mpi_sgbcs(simu_devia,layoutnumber,size) endif #endif -#endif #endif #ifdef CompileWithMPI @@ -3251,9 +3237,7 @@ subroutine Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe call DestroyMultiports(sgg) #endif -#ifdef CompileWithSGBC call destroysgbcs(sgg) !!todos deben destruir pq alocatean en funcion de sgg no de si contienen estos materiales que lo controla therearesgbcs. Lo que habia era IF ((Thereare%sgbcs).and.(sgbc)) -#endif call destroyLumped(sgg) #ifdef CompileWithEDispersives call DestroyEDispersives(sgg) From 9aaf4d2e524267c9140423cff31719e8dd68c681 Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Sat, 9 Nov 2024 12:51:03 +0100 Subject: [PATCH 11/13] Removes CompileWithDMMA flag --- CMakeLists.txt | 1 - src_main_pub/dmma_thin_slot.F90 | 6 ------ src_main_pub/errorreport.F90 | 11 ----------- src_main_pub/interpreta_switches.F90 | 14 +------------- src_main_pub/preprocess_geom.F90 | 12 ++---------- src_main_pub/semba_fdtd.F90 | 7 ------- 6 files changed, 3 insertions(+), 48 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0e8e2998..0258c3bb 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -143,7 +143,6 @@ add_definitions( -DCompileWithReal4 -DCompileWithOpenMP -DCompileWithEDispersives --DCompileWithDMMA -DCompileWithWires ) diff --git a/src_main_pub/dmma_thin_slot.F90 b/src_main_pub/dmma_thin_slot.F90 index e16ab35c..7e32b73c 100755 --- a/src_main_pub/dmma_thin_slot.F90 +++ b/src_main_pub/dmma_thin_slot.F90 @@ -23,10 +23,6 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! MODULE DMMA - - -#ifdef CompileWithDMMA - USE FDETYPES IMPLICIT NONE PRIVATE @@ -162,6 +158,4 @@ END SUBROUTINE dmma_thin_Slot ! ! -#endif - END MODULE diff --git a/src_main_pub/errorreport.F90 b/src_main_pub/errorreport.F90 index 5ea30952..9c198bee 100755 --- a/src_main_pub/errorreport.F90 +++ b/src_main_pub/errorreport.F90 @@ -308,15 +308,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML endif ! ! - IF (thereare%ThinSlot) then -#ifdef CompileWithDMMA - continue -#else - buff=trim(adjustl(whoami))//' Thin slots unsupported. Recompile' - call stoponerror(layoutnumber,size,buff) -#endif - endif - ! IF (thereare%EDispersives.or.thereare%MDispersives) then #ifdef CompileWithEDispersives continue @@ -384,12 +375,10 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML buff= ' has pure anisotropic media' call warnerrreport(buff) endif -#ifdef CompileWithDMMA IF (thereare%ThinSlot) then buff= ' has Thin Slots' call warnerrreport(buff) endif -#endif ! #ifdef CompileWithEDispersives IF (thereare%EDispersives) then diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index d23ab89d..9b78b60c 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -454,13 +454,12 @@ subroutine interpreta(l,statuse) END IF l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) // ' ' // trim (adjustl(f)) ! -#ifdef CompileWithDMMA CASE ('-dmma') l%run_with_dmma = .TRUE. l%run_with_abrezanjas = .FALSE. l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) !! i = i + 1; -#endif + #ifdef CompileWithConformal CASE ('-abrezanjas') !Provisional FEB-2018 @@ -1622,9 +1621,7 @@ subroutine print_help(l) CALL print11 (l%layoutnumber, '-conf file : conformal file ') CALL print11 (l%layoutnumber, '-abrezanjas : Thin-gaps treated in conformal manner ') #endif -#ifdef CompileWithDMMA CALL print11 (l%layoutnumber, '-dmma : Thin-gaps treated in DMMA manner ') -#endif #ifdef CompileWithMPI CALL print11 (l%layoutnumber, '-mpidir {x,y,z} : Rotate model to force MPI along z be the largest ') CALL print11 (l%layoutnumber, '-force cutplane : Force a MPI layout to begin at cutplane (debug!) ') @@ -1688,11 +1685,7 @@ subroutine print_help(l) #endif CALL print11 (l%layoutnumber, 'SUPPORTED: Near-to-Far field probes') CALL print11 (l%layoutnumber, 'SUPPORTED: Lossy anistropic materials, both electric and magnetic') -#ifdef CompileWithDMMA CALL print11 (l%layoutnumber, 'SUPPORTED: Thin Slots ') -#else - !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Thin Slots ') -#endif #ifdef CompileWithEDispersives CALL print11 (l%layoutnumber, 'SUPPORTED: Electric and Magnetic Dispersive materials ') #else @@ -2173,12 +2166,7 @@ subroutine default_flags(l) l%relaunching=.false. l%forcestop=.false. l%input_conformal_flag = .false. -!thin gaps -#ifdef CompileWithDMMA l%run_with_dmma = .true. -#else - l%run_with_dmma = .false. -#endif #ifdef CompileWithConformal l%run_with_dmma = .false. ! todo esto para el abrezanjas. se precisa tambien el l%input_conformal_flag diff --git a/src_main_pub/preprocess_geom.F90 b/src_main_pub/preprocess_geom.F90 index 339e107f..2a1d96ee 100644 --- a/src_main_pub/preprocess_geom.F90 +++ b/src_main_pub/preprocess_geom.F90 @@ -38,9 +38,7 @@ MODULE Preprocess_m USE CreateMatrices !typos que leo desde mi FDE USE FDEtypes -#ifdef CompileWithDMMA USE DMMA -#endif #ifdef CompileWithConformal USE CONFORMAL_INI_CLASS USE CONFORMAL_TOOLS @@ -113,14 +111,12 @@ SUBROUTINE read_geomData (sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sg character (LEN=BUFSIZE) :: chari,charj,chark,chari2,charj2,chark2 ! logical :: paraerrhilo,groundwires,islossy,DENTRO -#ifdef CompileWithDMMA REAL (KIND=RKIND) :: width, dir (1:3), epr1, mur1 LOGICAL :: oriX, oriY, oriZ, oriX2, oriY2, oriZ2, oriX3, oriY3, oriZ3, iguales LOGICAL :: oriX4, oriY4, oriZ4 REAL (KIND=RKIND), DIMENSION (3, 3) :: EprSlot, MurSlot INTEGER (KIND=4) :: indicemedio INTEGER (KIND=4) :: i11, j11 -#endif ! type (tagtype_t) :: tagtype TYPE (FreqDepenMaterial), POINTER :: fdgeom @@ -195,13 +191,12 @@ SUBROUTINE read_geomData (sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sg !echo por demas, habria que precontar pero es complicado porque depende del procesamiento !thin Slots -#ifdef CompileWithDMMA if (run_with_dmma) then DO j = 1, this%tSlots%n_tg contamedia = contamedia + this%tSlots%Tg(j)%N_tgc END DO endif -#endif + !end thin Slots !PARA LA CAPA EXTRA 2013 if (medioextra%exists) then @@ -2567,9 +2562,6 @@ SUBROUTINE read_geomData (sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sg ENDIF !FIN WIRES - !!?!?!? - ! -#ifdef CompileWithDMMA if (run_with_dmma) then !always at the end since the orientation is found from the PEC one !thin Slots @@ -2834,7 +2826,7 @@ SUBROUTINE read_geomData (sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sg END DO ! endif !del run_with_dmma -#endif + !debe ir al final para respetar el tipo de medio que haya SI SE TRATASE COMO A UN MEDIO !nodalsource !precounting diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index b86dd149..52336d72 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -642,13 +642,6 @@ PROGRAM SEMBA_FDTD_launcher IF (sgg%Med(i)%Is%MDispersive) THEN #ifndef CompileWithEDispersives CALL stoponerror (l%layoutnumber, l%size, 'Mdispersives without Edispersives support. Recompile!') -#endif - CONTINUE - END IF - ! - IF (sgg%Med(i)%Is%ThinSlot) THEN -#ifndef CompileWithDMMA - CALL stoponerror (l%layoutnumber, l%size, 'Slots without Slots support. Recompile!') #endif CONTINUE END IF From de0fe17b982b9aeee22f4eb471ed9fb1820a9933 Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Sat, 9 Nov 2024 12:54:43 +0100 Subject: [PATCH 12/13] Removes CompileWithEDispersive flag --- CMakeLists.txt | 1 - src_main_pub/electricdispersive.F90 | 3 --- src_main_pub/errorreport.F90 | 12 ------------ src_main_pub/interpreta_switches.F90 | 4 ---- src_main_pub/magneticdispersive.F90 | 3 --- src_main_pub/resuming.F90 | 13 ------------- src_main_pub/semba_fdtd.F90 | 14 -------------- src_main_pub/timestepping.F90 | 11 ----------- 8 files changed, 61 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0258c3bb..ecc0f2d3 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -142,7 +142,6 @@ add_definitions( -DCompileWithInt2 -DCompileWithReal4 -DCompileWithOpenMP --DCompileWithEDispersives -DCompileWithWires ) diff --git a/src_main_pub/electricdispersive.F90 b/src_main_pub/electricdispersive.F90 index 9ce7885b..5b6a907d 100755 --- a/src_main_pub/electricdispersive.F90 +++ b/src_main_pub/electricdispersive.F90 @@ -33,7 +33,6 @@ module EDispersives -#ifdef CompileWithEDispersives use fdetypes USE REPORT @@ -442,6 +441,4 @@ subroutine DestroyEDispersives(sgg) end subroutine -#endif - end module EDispersives diff --git a/src_main_pub/errorreport.F90 b/src_main_pub/errorreport.F90 index 9c198bee..deacb9b6 100755 --- a/src_main_pub/errorreport.F90 +++ b/src_main_pub/errorreport.F90 @@ -304,16 +304,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML #else buff=trim(adjustl(whoami))//' MIBC unsupported. Recompile' call stoponerror(layoutnumber,size,buff) -#endif - endif - ! - ! - IF (thereare%EDispersives.or.thereare%MDispersives) then -#ifdef CompileWithEDispersives - continue -#else - buff=trim(adjustl(whoami))//' Dispersive materials unsupported. Recompile' - call stoponerror(layoutnumber,size,buff) #endif endif ! @@ -380,7 +370,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML call warnerrreport(buff) endif ! -#ifdef CompileWithEDispersives IF (thereare%EDispersives) then buff= ' has electric dispersives' call warnerrreport(buff) @@ -389,7 +378,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML buff= ' has magnetic dispersives' call warnerrreport(buff) endif -#endif #ifdef CompileWithWires If (thereare%Wires) then buff= ' has Holland WIREs' diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index 9b78b60c..855d3057 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -1686,11 +1686,7 @@ subroutine print_help(l) CALL print11 (l%layoutnumber, 'SUPPORTED: Near-to-Far field probes') CALL print11 (l%layoutnumber, 'SUPPORTED: Lossy anistropic materials, both electric and magnetic') CALL print11 (l%layoutnumber, 'SUPPORTED: Thin Slots ') -#ifdef CompileWithEDispersives CALL print11 (l%layoutnumber, 'SUPPORTED: Electric and Magnetic Dispersive materials ') -#else - !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Electric and Magnetic Dispersive materials ') -#endif CALL print11 (l%layoutnumber, 'SUPPORTED: Isotropic Multilayer Skin-depth Materials (sgbc)') #ifdef CompileWithNIBC CALL print11 (l%layoutnumber, 'SUPPORTED: Isotropic Multilayer Skin-depth Materials (l%mibc)') diff --git a/src_main_pub/magneticdispersive.F90 b/src_main_pub/magneticdispersive.F90 index 21756df7..cdb3a0fd 100755 --- a/src_main_pub/magneticdispersive.F90 +++ b/src_main_pub/magneticdispersive.F90 @@ -33,7 +33,6 @@ module Mdispersives -#ifdef CompileWithEDispersives !mismo switch electrico y magnetico use fdetypes @@ -441,6 +440,4 @@ subroutine DestroyMdispersives(sgg) end subroutine -#endif - end module Mdispersives diff --git a/src_main_pub/resuming.F90 b/src_main_pub/resuming.F90 index 084f0b06..d2bbb6e9 100755 --- a/src_main_pub/resuming.F90 +++ b/src_main_pub/resuming.F90 @@ -31,28 +31,18 @@ module resuming Use Report use fdetypes - - - - !Thin metals #ifdef CompileWithStochastic use SGBC_stoch #else use SGBC_NOstoch #endif use PMLbodies - use Lumped #ifdef CompileWithNIBC use Multiports #endif - - !EDispersives -#ifdef CompileWithEDispersives use EDispersives use MDispersives -#endif - use farfield_m !Wires Thin Module @@ -352,11 +342,8 @@ subroutine flush_and_save_resume(sgg, b, layoutnumber, size, nentradaroot, nresu #ifdef CompileWithNIBC if( Thereare%Multiports) call StoreFieldsMultiports #endif - -#ifdef CompileWithEDispersives if( Thereare%EDispersives) call StoreFieldsEDispersives if( Thereare%MDispersives) call StoreFieldsMDispersives -#endif if( Thereare%PlaneWaveBoxes) call StorePlaneWaves(sgg) if( Thereare%FarFields) call StoreFarFields(b) !called at initobservation #ifdef CompileWithMPI diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index 52336d72..bcdd3d6d 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -628,20 +628,6 @@ PROGRAM SEMBA_FDTD_launcher if ((l%wiresflavor=='slanted').or.(l%wiresflavor=='semistructured')) then CALL stoponerror (l%layoutnumber, l%size, 'slanted Wires without support. Recompile!') endif -#endif - CONTINUE - END IF - ! - IF (sgg%Med(i)%Is%EDispersive) THEN -#ifndef CompileWithEDispersives - CALL stoponerror (l%layoutnumber, l%size, 'Edispersives without Edispersives support. Recompile!') -#endif - CONTINUE - END IF - ! - IF (sgg%Med(i)%Is%MDispersive) THEN -#ifndef CompileWithEDispersives - CALL stoponerror (l%layoutnumber, l%size, 'Mdispersives without Edispersives support. Recompile!') #endif CONTINUE END IF diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 281298c9..1c35e655 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -70,11 +70,8 @@ module Solver #else use sgbc_NOstoch #endif - -#ifdef CompileWithEDispersives use EDispersives use MDispersives -#endif use Anisotropic #ifdef CompileWithWires use HollandWires @@ -956,7 +953,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif #endif -#ifdef CompileWithEDispersives #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) #endif @@ -989,7 +985,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx else write(dubuf,*) '----> no Structured Magnetic dispersive elements found'; call print11(layoutnumber,dubuf) endif -#endif #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) @@ -1470,10 +1465,8 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx !!! if (ThereAre%Lumpeds) call AdvanceLumpedE(sgg,n,simu_devia,stochastic) !!! -#ifdef CompileWithEDispersives !EDispersives (only updated here. No need to update in the H-field part) IF (Thereare%Edispersives) call AdvanceEDispersiveE(sgg) -#endif !PMC are only called in the H-field part (image theory method) @@ -1634,10 +1627,8 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx call AdvancesgbcH endif -#ifdef CompileWithEDispersives !MDispersives (only updated here. No need to update in the E-field part) IF (Thereare%Mdispersives) call AdvanceMDispersiveH(sgg) -#endif #ifdef CompileWithNIBC !Multiports H-field advancing @@ -3239,10 +3230,8 @@ subroutine Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe call destroysgbcs(sgg) !!todos deben destruir pq alocatean en funcion de sgg no de si contienen estos materiales que lo controla therearesgbcs. Lo que habia era IF ((Thereare%sgbcs).and.(sgbc)) call destroyLumped(sgg) -#ifdef CompileWithEDispersives call DestroyEDispersives(sgg) call DestroyMDispersives(sgg) -#endif #ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then From 5592652761398bf11ebce0b5abdcf9cbea1c8e2a Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Mon, 11 Nov 2024 16:38:16 +0100 Subject: [PATCH 13/13] Removes CompileWithWires flag --- CMakeLists.txt | 1 - src_main_pub/errorreport.F90 | 20 ------------ src_main_pub/interpreta_switches.F90 | 16 ---------- src_main_pub/mpicomm.F90 | 12 +------ src_main_pub/observation.F90 | 47 ++++++---------------------- src_main_pub/resuming.F90 | 8 ----- src_main_pub/semba_fdtd.F90 | 3 -- src_main_pub/timestepping.F90 | 31 ++++-------------- src_wires_pub/wires.F90 | 3 -- 9 files changed, 16 insertions(+), 125 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ecc0f2d3..12b21ec7 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -142,7 +142,6 @@ add_definitions( -DCompileWithInt2 -DCompileWithReal4 -DCompileWithOpenMP --DCompileWithWires ) diff --git a/src_main_pub/errorreport.F90 b/src_main_pub/errorreport.F90 index deacb9b6..1f053128 100755 --- a/src_main_pub/errorreport.F90 +++ b/src_main_pub/errorreport.F90 @@ -306,24 +306,6 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML call stoponerror(layoutnumber,size,buff) #endif endif - ! - If (thereare%Wires) then -#ifdef CompileWithWires - continue -#else -#ifdef CompileWithBerengerWires - continue -#else -#ifdef CompileWithSlantedWires - continue -#else - buff=trim(adjustl(whoami))//' WIREs unsupported. Recompile' - call stoponerror(layoutnumber,size,buff) -#endif -#endif -#endif - endif - ! !!!!!!!!!!!!! if (thereAre%MagneticMedia) then buff=' has special H-media' @@ -378,12 +360,10 @@ subroutine ReportExistence(sgg,layoutnumber,size,thereare,mur_second,MurAfterPML buff= ' has magnetic dispersives' call warnerrreport(buff) endif -#ifdef CompileWithWires If (thereare%Wires) then buff= ' has Holland WIREs' call warnerrreport(buff) endif -#endif #ifdef CompileWithBerengerWires If (thereare%Wires) then buff= ' has Multi-WIREs' diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index 855d3057..b3a5a542 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -694,7 +694,6 @@ subroutine interpreta(l,statuse) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) CASE ('-saveall') l%saveall = .TRUE. -#ifdef CompileWithWires CASE ('-attw') i = i + 1 CALL getcommandargument (l%chaininput, i, f, l%length, statuse) @@ -837,14 +836,12 @@ subroutine interpreta(l,statuse) endif end select #endif -#ifdef CompileWithWires select case (trim(adjustl(l%wiresflavor))) case ('berenger','slanted','experimental','transition') if (l%wirethickness/=1) then CALL stoponerror (l%layoutnumber, l%size, 'Thickness>1 unsupported for this wireflavor',.true.); statuse=-1; !goto 668 endif end select -#endif #ifndef CompileWithBerengerWires select case (trim(adjustl(l%wiresflavor))) case ('berenger') @@ -884,7 +881,6 @@ subroutine interpreta(l,statuse) GO TO 180 179 CALL stoponerror (l%layoutnumber, l%size, 'Invalid inductance order',.true.); statuse=-1; !goto 668 180 l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) // ' ' // trim (adjustl(f)) -#endif CASE ('-prefix') i = i + 1 CALL getcommandargument (l%chaininput, i, f, l%length, statuse) @@ -1552,16 +1548,13 @@ subroutine print_help(l) CALL print11 (l%layoutnumber, '& sigma=factor * maximum_PML_sigma, depth= # layers ') CALL print11 (l%layoutnumber, '-mur1 : Supplement PMLs with 1st order Mur ABCs ') CALL print11 (l%layoutnumber, '-mur2 : Supplement PMLs with 2nd order Mur ABCs ') -#ifdef CompileWithWires CALL print11 (l%layoutnumber, '-wiresflavor {holland.or.old} : model for the wires ') -#endif #ifdef CompileWithBerengerWires CALL print11 (l%layoutnumber, '-wiresflavor {berenger} : model for the wires ') #endif #ifdef CompileWithSlantedWires CALL print11 (l%layoutnumber, '-wiresflavor {new/Slanted.or.experimental.or.slanted/transition/semistructured l%precision} : model for the wires ') #endif -#ifdef CompileWithWires CALL print11 (l%layoutnumber, '& (default '//trim(adjustl(l%wiresflavor))//') ') CALL print11 (l%layoutnumber, '-mtlnwires : Use mtln solver to advance wires currents ') CALL print11 (l%layoutnumber, '-notaparrabos : Do not remove extra double tails at the end of the wires ') @@ -1599,7 +1592,6 @@ subroutine print_help(l) CALL print11 (l%layoutnumber, '-maxwireradius number : Bounds globally the wire radius ') CALL print11 (l%layoutnumber, '-clip : Permits to clip a bigger problem truncating wires.') CALL print11 (l%layoutnumber, '-wirecrank : Uses Crank-Nicolson for wires (development) ') -#endif CALL print11 (l%layoutnumber, '-noNF2FF string : Supress a NF2FF plane for calculation ') CALL print11 (l%layoutnumber, '& String can be: up, down, left, right, back , front') CALL print11 (l%layoutnumber, '-NF2FFDecim : Uses decimation in NF2FF calculation (faster). ') @@ -1693,11 +1685,7 @@ subroutine print_help(l) #else !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Isotropic Multilayer Skin-depth Materials (l%mibc)') #endif -#ifdef CompileWithWires CALL print11 (l%layoutnumber, 'SUPPORTED: Loaded and grounded thin-wires with juntions') -#else - !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Loaded and grounded thin-wires with juntions') -#endif CALL print11 (l%layoutnumber, 'SUPPORTED: Nodal hard/soft electric and magnetic sources') #ifdef CompileWithHDF CALL print11 (l%layoutnumber, 'SUPPORTED: .xdmf+.h5 probes ') @@ -1719,11 +1707,7 @@ subroutine print_help(l) #else !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Permittivity scaling accelerations') #endif -#ifdef CompileWithWires CALL print11 (l%layoutnumber, 'SUPPORTED: Holland Wires') -#else - !CALL print11 (l%layoutnumber, 'UNSUPPORTED: Holland Wires') -#endif #ifdef CompileWithBerengerWires CALL print11 (l%layoutnumber, 'SUPPORTED: Multi-Wires') #else diff --git a/src_main_pub/mpicomm.F90 b/src_main_pub/mpicomm.F90 index 035aab2f..f749c4fb 100755 --- a/src_main_pub/mpicomm.F90 +++ b/src_main_pub/mpicomm.F90 @@ -32,17 +32,13 @@ module MPIcomm Use Report use fdetypes -#ifdef CompileWithWires use wiresHolland_constants use HollandWires -#endif implicit none private -#ifdef CompileWithWires type(Thinwires_t), pointer :: HwiresMPI -#endif Type buffer_t @@ -68,10 +64,8 @@ module MPIcomm public FlushMPI_E,FlushMPI_H,InitMPI,MPIupdateMin, InitGeneralMPI,MPIdivide public MPIupdateBloques, MPIinitSubcomm -#ifdef CompileWithWires !public InitWiresMPI public newInitWiresMPI,NewFlushWiresMPI -#endif public InitExtraFlushMPI @@ -649,7 +643,7 @@ subroutine FlushMPI_E(sggalloc,layoutnumber,size, Ex,Ey,Ez) ! -#ifdef CompileWithWires + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! new routine: works without the MediaMatrix Info ! supports multiwires @@ -1219,10 +1213,6 @@ subroutine FlushWiresMPIorigindexInfo(layoutnumber,size) !!! return !!!end subroutine newFlushWiresMPIindexmedInfo -#endif - !del compilewithwires - - subroutine InitExtraFlushMPI (layoutnumber,sggsweep,sggalloc,med,nummed,sggmiez,sggMiHz) type (XYZlimit_t), dimension(1:6) :: sggalloc,sggsweep integer (kind=4) :: layoutnumber diff --git a/src_main_pub/observation.F90 b/src_main_pub/observation.F90 index 32708936..002ad58e 100755 --- a/src_main_pub/observation.F90 +++ b/src_main_pub/observation.F90 @@ -33,14 +33,13 @@ module Observa use MPIcomm #endif -#ifdef CompileWithWires use wiresHolland_constants use HollandWires + #ifdef CompileWithMTLN use Wire_bundles_mtln_mod use mtln_solver_mod , mtln_solver_t => mtln_t #endif -#endif #ifdef CompileWithBerengerWires use WiresBerenger #endif @@ -66,9 +65,9 @@ module Observa complex( kind = CKIND), dimension( :,:), allocatable :: valorComplex_Hx,valorComplex_Hy,valorComplex_Hz end type Serialized_t type item_t -#ifdef CompileWithWires - type (CurrentSegments), pointer :: segmento !segmento de hilo que se observa si lo hubiere -#endif + + type (CurrentSegments), pointer :: segmento !segmento de hilo que se observa si lo hubiere + #ifdef CompileWithBerengerWires type (TSegment) , pointer :: segmento_Berenger !segmento de hilo que se observa si lo hubiere #endif @@ -105,11 +104,7 @@ module Observa complex( kind = CKIND), dimension( :), allocatable :: auxExp_E,auxExp_H,dftEntrada !para sondas freqdomain end type output_t - - -#ifdef CompileWithWires type(Thinwires_t), pointer :: Hwireslocal -#endif #ifdef CompileWithBerengerWires type(TWires) , pointer :: Hwireslocal_Berenger #endif @@ -477,12 +472,10 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s 9138 if(my_iostat /= 0) write(*,fmt='(a)',advance='no') '.' !!if(my_iostat /= 0) print '(i5,a1,i4,2x,a)',9138,'.',layoutnumber,trim(adjustl(nEntradaRoot))//'_Outputrequests_'//trim(adjustl(whoamishort))//'.txt' open (19,file=trim(adjustl(nEntradaRoot))//'_Outputrequests_'//trim(adjustl(whoamishort))//'.txt',err=9138,iostat=my_iostat,status='new',action='write') -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then if (Therearewires) Hwireslocal => GetHwires() endif -#endif #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then if (Therearewires) Hwireslocal_Berenger => GetHwires_Berenger() @@ -754,7 +747,7 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s endif allocate (output(ii)%item(i)%valor(0 : BuffObse)) output(ii)%item(i)%valor(0 : BuffObse)=0.0_RKIND -#ifdef CompileWithWires + if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then found=.false. @@ -819,7 +812,7 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s CALL WarnErrReport (buff,.true.) endif endif -#endif + #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then found=.false. @@ -1304,9 +1297,7 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s call nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag, & init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) -#ifdef CompileWithWires call wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic,wiresflavor,sggMtag) -#endif endif !!! do kkk=sgg%Observation(ii)%P(i)%ZI, sgg%Observation(ii)%P(i)%ZE @@ -1613,9 +1604,7 @@ subroutine InitObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,s INIT=.false.; geom=.true. ; asigna=.false.; magnetic=.false. ; electric=.true. call nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag,& init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) -#ifdef CompileWithWires call wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic,wiresflavor,sggMtag) -#endif endif !!! do kkk=sgg%Observation(ii)%P(i)%ZI, sgg%Observation(ii)%P(i)%ZE @@ -2671,9 +2660,8 @@ subroutine UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz real (kind = RKIND) :: jx,jy,jz integer(kind=4) :: conta !para realmente dar tangenciales de campos en los medios superficiales character(len=*), INTENT(in) :: wiresflavor -#ifdef CompileWithWires + type( CurrentSegments), pointer :: segmDumm !segmento de hilo que se observa si lo hubiere -#endif ! #ifdef CompileWithBerengerWires type(TSegment) , pointer :: segmDumm_Berenger !segmento de hilo que se observa si lo hubiere @@ -2876,8 +2864,8 @@ subroutine UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz output( ii)%item( i)%valor(nTime-nInit) + & (Ey( i1_m, JJJ_m, k1_m) - Ey( i2_m+1, JJJ_m, k1_m)) * dye( JJJ_m ) enddo + case( iJx, iJy, iJz) -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then output( ii)%item( i)%valor(nTime-nInit) = 0.0_RKIND !wipe value @@ -2908,7 +2896,7 @@ subroutine UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz endif !!!!!!!!!!!!!!!!!! endif -#endif + #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then SegmDumm_Berenger => output( ii)%item( i)%Segmento_Berenger @@ -3453,9 +3441,7 @@ subroutine UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz call nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag,& init,geom,asigna,electric,magnetic,conta,i,ii,output,Ntimeforvolumic) -#ifdef CompileWithWires call wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic,wiresflavor,sggMtag) -#endif endif !!! do KKK = k1, k2 @@ -4114,8 +4100,6 @@ subroutine FlushObservationFiles(sgg,nInit,FinalInstant,layoutnumber,size, dxe,d endif endif ! - -#ifdef CompileWithWires case(iJx,iJy,iJz) if (singlefilewrite) then unidad=output(ii)%item(i)%unitmaster @@ -4133,7 +4117,6 @@ subroutine FlushObservationFiles(sgg,nInit,FinalInstant,layoutnumber,size, dxe,d output(ii)%item(i)%valor4(n-nInit) , & ! Vminus output(ii)%item(i)%valor5(n-nInit) ! vplus-vminus endif -#endif end select endif endif @@ -4432,10 +4415,8 @@ subroutine DestroyObservation(sgg) field=sgg%observation(ii)%P(i)%what select case(field) case (iJx,iJy,iJz) -#ifdef CompileWithWires deallocate (output(ii)%item(i)%valor) deallocate (output(ii)%item(i)%valor2,output(ii)%item(i)%valor3,output(ii)%item(i)%valor4,output(ii)%item(i)%valor5) !en caso de hilos se necesitan -#endif case (iBloqueJx,iBloqueJy,iBloqueMx,iBloqueMy) deallocate (output(ii)%item(i)%valor) #ifdef CompileWithMPI @@ -5153,9 +5134,6 @@ subroutine nodalvtk(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag, return end subroutine - - -#ifdef CompileWithWires subroutine wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic,wiresflavor,sggMtag) type (SGGFDTDINFO), intent(IN) :: sgg @@ -5181,12 +5159,10 @@ subroutine wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic !print *,'----antes wires init,geom,asigna,conta,i,ii',init,geom,asigna,conta,i,ii if (init) then -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then Hwireslocal => GetHwires() endif -#endif #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then Hwireslocal_Berenger => GetHwires_Berenger() @@ -5241,7 +5217,6 @@ subroutine wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic endif endif #endif -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then if (geom) then @@ -5285,7 +5260,6 @@ subroutine wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic end do endif endif -#endif #ifdef CompileWithSlantedWires if ((trim(adjustl(wiresflavor))=='slanted').or.(trim(adjustl(wiresflavor))=='semistructured')) then !parsea los hilos @@ -5335,9 +5309,6 @@ subroutine wirebundlesvtk(sgg,init,geom,asigna,conta,i,ii,output,Ntimeforvolumic return end subroutine -#endif - - !!!!!!!!!!!!!!!!!!!!!!!!!!!! !Function to publish the private output data (used in postprocess) !!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/src_main_pub/resuming.F90 b/src_main_pub/resuming.F90 index d2bbb6e9..db831128 100755 --- a/src_main_pub/resuming.F90 +++ b/src_main_pub/resuming.F90 @@ -44,11 +44,7 @@ module resuming use EDispersives use MDispersives use farfield_m - - !Wires Thin Module -#ifdef CompileWithWires use HollandWires -#endif #ifdef CompileWithBerengerWires use WiresBerenger #ifdef CompileWithMPI @@ -278,7 +274,6 @@ subroutine flush_and_save_resume(sgg, b, layoutnumber, size, nentradaroot, nresu #ifdef CompileWithMPI !do an update of the currents to later read the currents OK if (size>1) then -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then if ((size>1).and.(thereare%wires)) then @@ -290,7 +285,6 @@ subroutine flush_and_save_resume(sgg, b, layoutnumber, size, nentradaroot, nresu endif #endif endif -#endif #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then call FlushWiresMPI_Berenger(layoutnumber,size) @@ -301,12 +295,10 @@ subroutine flush_and_save_resume(sgg, b, layoutnumber, size, nentradaroot, nresu #endif if( Thereare%Wires) then -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then call StoreFieldsWires endif -#endif #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then call StoreFieldsWires_Berenger diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index bcdd3d6d..b6bcaa0e 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -616,9 +616,6 @@ PROGRAM SEMBA_FDTD_launcher !check that simulation can actually be done for the kind of media requested DO i = 1, sgg%nummedia IF (sgg%Med(i)%Is%ThinWire) THEN -#ifndef CompileWithWires - CALL stoponerror (l%layoutnumber, l%size, 'Wires without wire support. Recompile!') -#endif #ifndef CompileWithBerengerWires if ((l%wiresflavor=='berenger')) then CALL stoponerror (l%layoutnumber, l%size, 'Berenger Wires without support. Recompile!') diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 1c35e655..93fd51c4 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -73,14 +73,11 @@ module Solver use EDispersives use MDispersives use Anisotropic -#ifdef CompileWithWires use HollandWires -#endif -#ifdef CompileWithWires + #ifdef CompileWithMTLN use Wire_bundles_mtln_mod #endif -#endif #ifdef CompileWithBerengerWires use WiresBerenger @@ -88,6 +85,7 @@ module Solver use WiresBerenger_MPI #endif #endif + #ifdef CompileWithSlantedWires use WiresSlanted use estructura_slanted_m @@ -729,7 +727,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx ! one more MM for right adjancencies dtcritico=sgg%dt -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then #ifdef CompileWithMPI @@ -752,7 +749,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif endif -#endif #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then @@ -843,8 +839,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - -#ifdef CompileWithWires if (use_mtln_wires) then #ifdef CompileWithMTLN call InitWires_mtln(sgg,Ex,Ey,Ez,eps0, mu0, mtln_parsed,thereAre%MTLNbundles) @@ -852,7 +846,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx write(buff,'(a)') 'WIR_ERROR: Executable was not compiled with MTLN modules.' #endif endif -#endif !Anisotropic #ifdef CompileWithMPI @@ -1093,7 +1086,7 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx Ex,Ey,Ez,Hx,Hy,Hz) call MPI_Barrier(SUBCOMM_MPI,ierr) write(dubuf,*) '[OK]'; call print11(layoutnumber,dubuf) -#ifdef CompileWithWires + !this modifies the initwires stuff and must be called after initwires (typically at the end) !llamalo siempre aunque no HAYA WIRES!!! para que no se quede colgado en hilos terminales if ((trim(adjustl(wiresflavor))=='holland') .or. & @@ -1103,7 +1096,7 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx call MPI_Barrier(SUBCOMM_MPI,ierr) write(dubuf,*) '[OK]'; call print11(layoutnumber,dubuf) endif -#endif + #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then write(dubuf,*) 'Init MPI Multi-Wires...'; call print11(layoutnumber,dubuf) @@ -1123,12 +1116,11 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx !must be called now in case the MPI has changed the connectivity info -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then call ReportWireJunctions(layoutnumber,size,thereare%wires,sgg%Sweep(iHz)%ZI, sgg%Sweep(iHz)%ZE,groundwires,strictOLD,verbose) endif -#endif + #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then call ReportWireJunctionsBerenger(layoutnumber,size,thereare%wires,sgg%Sweep(iHz)%ZI, sgg%Sweep(iHz)%ZE,groundwires,strictOLD,verbose) @@ -1185,7 +1177,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx call MPI_Barrier(SUBCOMM_MPI,ierr) call FlushMPI_H_Cray endif -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then if ((size>1).and.(thereare%wires)) then @@ -1197,7 +1188,7 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif #endif endif -#endif + #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then if ((size>1).and.(thereare%wires)) call FlushWiresMPI_Berenger(layoutnumber,size) @@ -1386,7 +1377,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx !******************************************************************************* !******************************************************************************* !!!lamo aqui los hilos por coherencia con las PML que deben absorber los campos creados por los hilos -#ifdef CompileWithWires !Wires (only updated here. No need to update in the H-field part) if (( (trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) .and. .not. use_mtln_wires) then @@ -1404,7 +1394,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif endif endif -#endif #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then IF (Thereare%Wires) call AdvanceWiresE_Berenger(sgg,n) @@ -1417,7 +1406,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx call AdvanceWiresE_Slanted(sgg,n) endif #endif -#ifdef CompileWithWires if (use_mtln_wires) then #ifdef CompileWithMTLN call AdvanceWiresE_mtln(sgg,Idxh,Idyh,Idzh,eps0,mu0) @@ -1425,7 +1413,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx write(buff,'(a)') 'WIR_ERROR: Executable was not compiled with MTLN modules.' #endif end if -#endif If (Thereare%PMLbodies) then !waveport absorbers call AdvancePMLbodyE endif @@ -1660,7 +1647,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx !Must be called here again at the end to enforce any of the previous changes !Posible Wire for thickwires advancing in the H-field part -#ifdef CompileWithWires !Wires (only updated here. No need to update in the H-field part) if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then @@ -1672,7 +1658,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif endif endif -#endif !PMC BORDERS H-field advancing (duplicates the H-fields at the interface changing their sign) If (Thereare%PMCBorders) call MinusCloneMagneticPMC(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,layoutnumber,size) !Periodic BORDERS H-field mirroring @@ -1707,7 +1692,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx call MPI_Barrier(SUBCOMM_MPI,ierr) call FlushMPI_H_Cray endif -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then if ((size>1).and.(thereare%wires)) then @@ -1719,7 +1703,6 @@ subroutine launch_simulation(sgg,sggMtag,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx endif #endif endif -#endif #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then if ((size>1).and.(thereare%wires)) call FlushWiresMPI_Berenger(layoutnumber,size) @@ -3232,12 +3215,10 @@ subroutine Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe call destroyLumped(sgg) call DestroyEDispersives(sgg) call DestroyMDispersives(sgg) -#ifdef CompileWithWires if ((trim(adjustl(wiresflavor))=='holland') .or. & (trim(adjustl(wiresflavor))=='transition')) then call DestroyWires(sgg) endif -#endif #ifdef CompileWithBerengerWires if (trim(adjustl(wiresflavor))=='berenger') then call DestroyWires_Berenger(sgg) diff --git a/src_wires_pub/wires.F90 b/src_wires_pub/wires.F90 index bbd48c93..aa41b5d6 100755 --- a/src_wires_pub/wires.F90 +++ b/src_wires_pub/wires.F90 @@ -28,7 +28,6 @@ module HollandWires ! -#ifdef CompileWithWires use report use fdetypes @@ -7031,7 +7030,5 @@ subroutine wiresconstantes(fieldtotl,dummy,G2,sgg) end subroutine wiresconstantes -#endif - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end module HollandWires