Merge pull request #74 from OpenSEMBA/feature/smbjson

Feature/smbjson

src_json_parser/idchildtable.F90

@@ -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))

src_json_parser/mesh.F90

@@ -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
 
@@ -54,6 +54,7 @@ module mesh_mod
 
       procedure :: printCoordHashInfo => mesh_printCoordHashInfo
       procedure :: allocateCoordinates => mesh_allocateCoordinates
+      procedure :: allocateElements => mesh_allocateElements
    end type
 
 
@@ -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
@@ -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

src_json_parser/smbjson.F90

@@ -30,7 +30,6 @@ module smbjson
 
    contains
       procedure :: readProblemDescription
-      procedure :: initializeJson
 
       ! private
       procedure :: readGeneral
@@ -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
@@ -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)

test/smbjson/CMakeLists.txt

@@ -17,6 +17,7 @@ add_library (smbjson_test_fortran
     "test_read_mtln.F90"
     "test_read_sphere.F90"
     "test_read_airplane.F90"
+    "test_read_large_airplane_mtln.F90"
 )
 target_link_libraries(smbjson_test_fortran
     smbjson 

test/smbjson/smbjson_tests.h

@@ -21,24 +21,26 @@ extern "C" int test_read_shieldedpair();
 extern "C" int test_read_mtln();
 extern "C" int test_read_sphere();
 extern "C" int test_read_airplane();
+extern "C" int test_read_large_airplane_mtln();
 
 TEST(smbjson, idchildtable_fhash)     {EXPECT_EQ(0, test_idchildtable_fhash()); }
 TEST(smbjson, idchildtable_add_get)   {EXPECT_EQ(0, test_idchildtable()); }
 
-TEST(smbjson, mesh_cells)             { EXPECT_EQ(0, test_cells()); }
-TEST(smbjson, mesh_add_get)           { EXPECT_EQ(0, test_mesh_add_get()); }
-TEST(smbjson, mesh_add_get_long_list) { EXPECT_EQ(0, test_mesh_add_get_long_list()); }
-TEST(smbjson, mesh_node_to_pixel)     { EXPECT_EQ(0, test_mesh_node_to_pixel()); }
-TEST(smbjson, mesh_polyline_to_linel) { EXPECT_EQ(0, test_mesh_polyline_to_linel()); }
-
-TEST(smbjson, parser_ctor)            { EXPECT_EQ(0, test_parser_ctor()); }
-TEST(smbjson, parser_read_mesh)       { EXPECT_EQ(0, test_parser_read_mesh()); }
-TEST(smbjson, read_planewave)         { EXPECT_EQ(0, test_read_planewave()); }
-TEST(smbjson, read_holland1981)       { EXPECT_EQ(0, test_read_holland1981()); }
-TEST(smbjson, read_towelhanger)       { EXPECT_EQ(0, test_read_towelhanger()); }
-TEST(smbjson, read_connectedwires)    { EXPECT_EQ(0, test_read_connectedwires()); }
-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()); }
+TEST(smbjson, mesh_cells)                { EXPECT_EQ(0, test_cells()); }
+TEST(smbjson, mesh_add_get)              { EXPECT_EQ(0, test_mesh_add_get()); }
+TEST(smbjson, mesh_add_get_long_list)    { EXPECT_EQ(0, test_mesh_add_get_long_list()); }
+TEST(smbjson, mesh_node_to_pixel)        { EXPECT_EQ(0, test_mesh_node_to_pixel()); }
+TEST(smbjson, mesh_polyline_to_linel)    { EXPECT_EQ(0, test_mesh_polyline_to_linel()); }
+
+TEST(smbjson, parser_ctor)               { EXPECT_EQ(0, test_parser_ctor()); }
+TEST(smbjson, parser_read_mesh)          { EXPECT_EQ(0, test_parser_read_mesh()); }
+TEST(smbjson, read_planewave)            { EXPECT_EQ(0, test_read_planewave()); }
+TEST(smbjson, read_holland1981)          { EXPECT_EQ(0, test_read_holland1981()); }
+TEST(smbjson, read_towelhanger)          { EXPECT_EQ(0, test_read_towelhanger()); }
+TEST(smbjson, read_connectedwires)       { EXPECT_EQ(0, test_read_connectedwires()); }
+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()); }
+TEST(smbjson, read_large_airplane_mtln)  { EXPECT_EQ(0, test_read_large_airplane_mtln()); }

test/smbjson/test_parser.F90

@@ -82,8 +82,8 @@ integer function test_parser_read_mesh() bind(C) result(err)
    err = 0
 
    parser = parser_t(filename)
-   call parser%initializeJson()
    mesh = parser%readMesh()
+
    call mesh%printCoordHashInfo()
    expected%position = [10,2,1]
 

test/smbjson/test_read_large_airplane_mtln.F90

@@ -0,0 +1,18 @@
+integer function test_read_large_airplane_mtln() bind (C) result(err)
+   use smbjson
+   use smbjson_testingTools
+
+   character(len=*),parameter :: filename = PATH_TO_TEST_DATA//'cases/large_airplane_mtln.fdtd.json'
+   type(Parseador) :: pr
+   type(parser_t) :: parser
+
+   err = 0
+
+   parser = parser_t(filename)
+
+   pr = parser%readProblemDescription()
+
+contains
+
+end function
+