Skip to content

Commit

Permalink
Merge pull request #75 from OpenSEMBA/dev
Browse files Browse the repository at this point in the history
Foxes bug with intel parsing files with many elements
  • Loading branch information
lmdiazangulo authored Nov 13, 2024
2 parents 40156a2 + c293304 commit a57ae37
Show file tree
Hide file tree
Showing 36 changed files with 48,283 additions and 583 deletions.
9 changes: 2 additions & 7 deletions CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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"
)
Expand All @@ -140,13 +142,6 @@ add_definitions(
-DCompileWithInt2
-DCompileWithReal4
-DCompileWithOpenMP
-DCompileWithAnisotropic
-DCompileWithEDispersives
-DCompileWithNF2FF
-DCompileWithNodalSources
-DCompileWithDMMA
-DCompileWithSGBC
-DCompileWithWires
)


4 changes: 2 additions & 2 deletions doc/smbjson.md
Original file line number Diff line number Diff line change
Expand Up @@ -634,15 +634,15 @@ 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
{
"name": "electric_field_movie",
"type": "movie",
"field": "electric",
"components": ["x"],
"component": "x",
"elementIds": [4]
}
```
Expand Down
2 changes: 1 addition & 1 deletion src_json_parser/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ add_library (jsonfortran
)

add_library(smbjson
"labels_mod.F90"
"smbjson_labels.F90"
"cells.F90"
"smbjson.F90"
"idchildtable.F90"
Expand Down
7 changes: 5 additions & 2 deletions src_json_parser/idchildtable.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -29,10 +29,13 @@ function ctor(core, root, path) result(res)
integer :: id
integer :: i
logical :: found
integer :: numberOfEntries

call core%get(root, path, jentries, found)
if (.not. found) return
do i = 1, core%count(jentries)
numberOfEntries = core%count(jentries)
call res%idToChilds%allocate(10*numberOfEntries)
do i = 1, numberOfEntries
call core%get_child(jentries, i, jentry)
call core%get(jentry, J_ID, id)
call res%idToChilds%set(key(id), json_value_ptr(jentry))
Expand Down
32 changes: 27 additions & 5 deletions src_json_parser/mesh.F90
Original file line number Diff line number Diff line change
Expand Up @@ -40,10 +40,10 @@ module mesh_mod
procedure :: checkId => mesh_checkId

procedure :: addElement => mesh_addElement
procedure :: addCellRegion => mesh_addCellRegion

procedure :: getNode => mesh_getNode
procedure :: getPolyline => mesh_getPolyline

procedure :: addCellRegion => mesh_addCellRegion
procedure :: getCellRegion => mesh_getCellRegion
procedure :: getCellRegions => mesh_getCellRegions

Expand All @@ -54,6 +54,7 @@ module mesh_mod

procedure :: printCoordHashInfo => mesh_printCoordHashInfo
procedure :: allocateCoordinates => mesh_allocateCoordinates
procedure :: allocateElements => mesh_allocateElements
end type


Expand All @@ -65,6 +66,13 @@ subroutine mesh_allocateCoordinates(this, buck)
integer :: buck
call this%coordinates%allocate(buck)
end subroutine

subroutine mesh_allocateElements(this, buck)
class(mesh_t) :: this
integer :: buck
call this%elements%allocate(buck)
end subroutine


subroutine mesh_printCoordHashInfo(this)
class(mesh_t) :: this
Expand Down Expand Up @@ -193,12 +201,26 @@ function mesh_getCellRegions(this, ids) result (res)
integer, dimension(:), intent(in) :: ids
type(cell_region_t) :: cR
logical :: found
integer :: i
integer :: i, j
integer :: numberOfCellRegions

allocate(res(0))
! Precounts
numberOfCellRegions = 0
do i = 1, size(ids)
cR = this%getCellRegion(ids(i), found)
if (found) res = [res, cR]
if (found) then
numberOfCellRegions = numberOfCellRegions + 1
end if
end do

allocate(res(numberOfCellRegions))
j = 1
do i = 1, size(ids)
cR = this%getCellRegion(ids(i), found)
if (found) then
res(j) = cR
j = j + 1
end if
end do

end function
Expand Down
1 change: 0 additions & 1 deletion src_json_parser/parser_tools.F90
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
module parser_tools_mod

#ifdef CompileWithSMBJSON
use labels_mod
use mesh_mod
use cells_mod
use json_module
Expand Down
134 changes: 58 additions & 76 deletions src_json_parser/smbjson.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -30,7 +30,6 @@ module smbjson

contains
procedure :: readProblemDescription
procedure :: initializeJson

! private
procedure :: readGeneral
Expand Down Expand Up @@ -93,112 +92,96 @@ function parser_ctor(filename) result(res)
type(parser_t) :: res
character(len=*), intent(in) :: filename
res%filename = filename
end function

subroutine initializeJson(this)
class(parser_t) :: this
integer :: stat

allocate(this%jsonfile)
call this%jsonfile%initialize()
if (this%jsonfile%failed()) then
call this%jsonfile%print_error_message(error_unit)

allocate(res%jsonfile)
call res%jsonfile%initialize()
if (res%jsonfile%failed()) then
call res%jsonfile%print_error_message(error_unit)
return
end if

call this%jsonfile%load(filename = this%filename)
if (this%jsonfile%failed()) then
call this%jsonfile%print_error_message(error_unit)
call res%jsonfile%load(filename = res%filename)
if (res%jsonfile%failed()) then
call res%jsonfile%print_error_message(error_unit)
return
end if

allocate(this%core)
call this%jsonfile%get_core(this%core)
call this%jsonfile%get('.', this%root)
end subroutine
allocate(res%core)
call res%jsonfile%get_core(res%core)
call res%jsonfile%get('.', res%root)
end function

function readProblemDescription(this) result (res)
class(parser_t) :: this
type(Parseador) :: res
integer :: stat

allocate(this%jsonfile)
call this%jsonfile%initialize()
if (this%jsonfile%failed()) then
call this%jsonfile%print_error_message(error_unit)
return
end if

call this%jsonfile%load(filename = this%filename)
if (this%jsonfile%failed()) then
call this%jsonfile%print_error_message(error_unit)
return
end if

allocate(this%core)
call this%jsonfile%get_core(this%core)
call this%jsonfile%get('.', this%root)

this%mesh = this%readMesh()
this%matTable = IdChildTable_t(this%core, this%root, J_MATERIALS)

call initializeProblemDescription(res)

! Basics
res%general = this%readGeneral()
res%matriz = this%readMediaMatrix()
res%despl = this%readGrid()
res%front = this%readBoundary()

! Materials
res%pecRegs = this%readPECRegions()
res%pmcRegs = this%readPMCRegions()

! Sources
res%plnSrc = this%readPlanewaves()
res%nodSrc = this%readNodalSources()

! Probes
res%oldSonda = this%readProbes()
res%sonda = this%readMoreProbes()
res%BloquePrb = this%readBlockProbes()
res%VolPrb = this%readVolumicProbes()

! Thin elements
res%tWires = this%readThinWires()
res%mtln = this%readMTLN(res%despl)

! Cleanup
call this%core%destroy()
call this%jsonfile%destroy()
nullify(this%root)
!! Cleanup
!call this%core%destroy()
!call this%jsonfile%destroy()
!nullify(this%root)

end function

function readMesh(this) result(res)
class(parser_t) :: this
type(Mesh_t) :: res
type(json_value), pointer :: jcs, jc
integer :: id, i
real, dimension(:), allocatable :: pos
type(coordinate_t) :: c
integer :: stat
logical :: found

call this%core%get(this%root, J_MESH//'.'//J_COORDINATES, jcs, found=found)
if (found) then
call res%allocateCoordinates(10*this%core%count(jcs))
do i = 1, this%core%count(jcs)
call this%core%get_child(jcs, i, jc)
call this%core%get(jc, J_ID, id)
call this%core%get(jc, J_COORDINATE_POS, pos)
c%position = pos
call res%addCoordinate(id, c)
end do
end if
call addCoordinates(res)
call addElements(res)

contains
subroutine addCoordinates(mesh)
type(mesh_t), intent(inout) :: mesh
type(json_value), pointer :: jcs, jc
integer :: id, i
real, dimension(:), allocatable :: pos
type(coordinate_t) :: c
integer :: numberOfCoordinates
logical :: found

call this%core%get(this%root, J_MESH//'.'//J_COORDINATES, jcs, found=found)
if (found) then
numberOfCoordinates = this%core%count(jcs)
call res%allocateCoordinates(10*numberOfCoordinates)
do i = 1, numberOfCoordinates
call this%core%get_child(jcs, i, jc)
call this%core%get(jc, J_ID, id)
call this%core%get(jc, J_COORDINATE_POS, pos)
c%position = pos
call mesh%addCoordinate(id, c)
end do
end if
end subroutine

subroutine addElements(mesh)
type(mesh_t), intent(inout) :: mesh
character (len=:), allocatable :: elementType
Expand All @@ -207,10 +190,15 @@ subroutine addElements(mesh)
type(node_t) :: node
type(polyline_t) :: polyline
integer, dimension(:), allocatable :: coordIds
integer :: numberOfElements
logical :: found

call this%core%get(this%root, J_MESH//'.'//J_ELEMENTS, jes, found=found)
numberOfElements = this%core%count(jes)
call res%allocateElements(10*numberOfElements)

if (found) then
do i = 1, this%core%count(jes)
do i = 1, numberOfElements
call this%core%get_child(jes, i, je)
call this%core%get(je, J_ID, id)
call this%core%get(je, J_TYPE, elementType)
Expand Down Expand Up @@ -985,19 +973,13 @@ 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
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
Expand Down
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module labels_mod
module smbjson_labels_mod

#ifdef CompileWithSMBJSON
! LABELS
Expand Down Expand Up @@ -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_COMPONENT = "component"

character (len=*), parameter :: J_PR_FAR_FIELD_THETA = "theta"
character (len=*), parameter :: J_PR_FAR_FIELD_PHI = "phi"
Expand Down
5 changes: 0 additions & 5 deletions src_main_pub/anisotropic.F90
Original file line number Diff line number Diff line change
Expand Up @@ -32,9 +32,6 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

module Anisotropic

#ifdef CompileWithAnisotropic

use fdetypes
implicit none
private
Expand Down Expand Up @@ -1581,6 +1578,4 @@ Subroutine CalculateCoeff(epr,mur,sigma,sigmam,dt,coeff)

end subroutine

#endif

end module Anisotropic
Loading

0 comments on commit a57ae37

Please sign in to comment.