ReadMTLN: Use status signal to check if id was found in hash table

.github/workflows/ubuntu.yml

@@ -46,14 +46,15 @@ jobs:
           #   mtln: "Yes"
           #   hdf: "Yes"
           #   double-precision: "No"
-
-          - os: ubuntu-latest
-            compiler: {name: 'nvidia-hpc', version: '24.5'}
-            build-type: "Release"
-            mpi: "No"
-            mtln: "No"
-            hdf: "No"
-            double-precision: "No"
+
+          # Disable by lack of space on github action
+          # - os: ubuntu-latest
+          #   compiler: {name: 'nvidia-hpc', version: '24.5'}
+          #   build-type: "Release"
+          #   mpi: "No"
+          #   mtln: "No"
+          #   hdf: "No"
+          #   double-precision: "No"
 
           - os: ubuntu-latest # This is the only test with double precision.
             compiler: {name: 'intel', version: '2025.1'}

CMakeLists.txt

@@ -60,7 +60,7 @@ if (CMAKE_SYSTEM_NAME MATCHES "Linux")
 		set(CMAKE_CXX_FLAGS_RELEASE "-Ofast")
 		set(CMAKE_Fortran_FLAGS_RELEASE "-Ofast")
 
-		set(CMAKE_Fortran_FLAGS_DEBUG "-g -O0")
+		set(CMAKE_Fortran_FLAGS_DEBUG "-g -O0 -fno-inline -fcheck=all -fbacktrace")
 
 	elseif(CMAKE_Fortran_COMPILER_ID MATCHES "IntelLLVM")
 		message(STATUS "Using IntelLLVM (ifx) flags")

src_json_parser/smbjson.F90

@@ -2722,6 +2722,7 @@ function buildNode(termination_list, label, index, id) result(res)
          type(polyline_t) :: polyline
          type(aux_node_t) :: res
          integer :: cable_index
+         integer :: stat
          call this%core%get_child(termination_list, index, termination)
 
          res%node%termination%termination_type = readTerminationType(termination)
@@ -2735,17 +2736,18 @@ function buildNode(termination_list, label, index, id) result(res)
          res%node%side = label
          res%node%conductor_in_cable = index
 
-         call elemIdToCable%get(key(id), value=cable_index)
+         call elemIdToCable%get(key(id), value=cable_index, stat=stat)
+         if (stat == 0) then
          res%node%belongs_to_cable => mtln_res%cables(cable_index)%ptr
 
          polyline = this%mesh%getPolyline(id)
-
-         if (label == TERMINAL_NODE_SIDE_INI) then
-            res%cId = polyline%coordIds(1)
-            res%relPos = this%mesh%getCoordinate(polyline%coordIds(1))
-         else if (label == TERMINAL_NODE_SIDE_END) then
-            res%cId = polyline%coordIds(ubound(polyline%coordIds,1))
-            res%relPos = this%mesh%getCoordinate(polyline%coordIds(ubound(polyline%coordIds,1)))
+            if (label == TERMINAL_NODE_SIDE_INI) then
+               res%cId = polyline%coordIds(1)
+               res%relPos = this%mesh%getCoordinate(polyline%coordIds(1))
+            else if (label == TERMINAL_NODE_SIDE_END) then
+               res%cId = polyline%coordIds(ubound(polyline%coordIds,1))
+               res%relPos = this%mesh%getCoordinate(polyline%coordIds(ubound(polyline%coordIds,1)))
+            end if
          end if
       end function
 
@@ -3176,9 +3178,10 @@ function getPointerToParentCable(cables, id) result(res)
          call elemIdToCable%check_key(key(id), mStat)
          if (mStat /= 0) then
             res => null()
+         else
+            call elemIdToCable%get(key(id), value=index)
+            res => cables(index)%ptr
          end if
-         call elemIdToCable%get(key(id), value=index)
-         res => cables(index)%ptr
       end function
 
       function findConnectorWithId(conn_Id) result(res)
@@ -3480,29 +3483,54 @@ function buildSegments(j_cable, despl) result(res)
          end do
       end function
 
+      pure integer function clip(i, lo, hi)
+         integer, intent(in) :: i, lo, hi
+         clip = max(lo, min(i, hi))
+      end function clip
+
       function getdualBoxYZ(segment, despl) result (res)
          type(Desplazamiento), intent(in) :: despl
          type(segment_t), intent(in) :: segment
          type(box_2d_t) :: res
-         res%min = [-0.5*despl%desY(segment%y-1),-0.5*despl%desZ(segment%z-1)]
-         res%max = [ 0.5*despl%desY(segment%y),   0.5*despl%desZ(segment%z)]
+         integer :: y0, y1, z0, z1
+
+         y0 = clip(segment%y-1, 0, size(despl%desY)-1)
+         y1 = clip(segment%y,   0, size(despl%desY)-1)
+         z0 = clip(segment%z-1, 0, size(despl%desZ)-1)
+         z1 = clip(segment%z,   0, size(despl%desZ)-1)
+
+         res%min = [-0.5 * despl%desY(y0), -0.5 * despl%desZ(z0)]
+         res%max = [ 0.5 * despl%desY(y1),  0.5 * despl%desZ(z1)]
       end function
 
       function getdualBoxXY(segment, despl) result (res)
          type(Desplazamiento), intent(in) :: despl
          type(segment_t), intent(in) :: segment
          type(box_2d_t) :: res
-         res%min = [-0.5*despl%desX(segment%x-1),-0.5*despl%desY(segment%y-1)]
-         res%max = [ 0.5*despl%desX(segment%x),   0.5*despl%desY(segment%y)]
+         integer :: x0, x1, y0, y1
+
+         x0 = clip(segment%x-1, 0, size(despl%desX)-1)
+         x1 = clip(segment%x,   0, size(despl%desX)-1)
+         y0 = clip(segment%y-1, 0, size(despl%desY)-1)
+         y1 = clip(segment%y,   0, size(despl%desY)-1)
+
+         res%min = [-0.5 * despl%desX(x0), -0.5 * despl%desY(y0)]
+         res%max = [ 0.5 * despl%desX(x1),  0.5 * despl%desY(y1)]
       end function
 
       function getdualBoxZX(segment, despl) result (res)
          type(Desplazamiento), intent(in) :: despl
          type(segment_t), intent(in) :: segment
          type(box_2d_t) :: res
-         res%min = [-0.5*despl%desZ(segment%z-1),-0.5*despl%desX(segment%x-1)]
-         res%max = [ 0.5*despl%desZ(segment%z),   0.5*despl%desX(segment%x)]
+         integer :: z0, z1, x0, x1
+
+         z0 = clip(segment%z-1, 0, size(despl%desZ)-1)
+         z1 = clip(segment%z,   0, size(despl%desZ)-1)
+         x0 = clip(segment%x-1, 0, size(despl%desX)-1)
+         x1 = clip(segment%x,   0, size(despl%desX)-1)
 
+         res%min = [-0.5 * despl%desZ(z0), -0.5 * despl%desX(x0)]
+         res%max = [ 0.5 * despl%desZ(z1),  0.5 * despl%desX(x1)]
       end function
 
       function buildStepSize(segments, despl) result(res)

src_main_pub/observation.F90

@@ -699,8 +699,8 @@ subroutine InitObservation(sgg, media, tag_numbers, &
     allocate (InvEps(0:sgg%NumMedia), InvMu(0:sgg%NumMedia))
 
     incident = .false.
-    InvEps(0:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(0:sgg%NumMedia)%Epr)
-    InvMu(0:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(0:sgg%NumMedia)%Mur)
+    InvEps(1:sgg%NumMedia) = 1.0_RKIND/(Eps0*sgg%Med(1:sgg%NumMedia)%Epr)
+    InvMu(1:sgg%NumMedia) = 1.0_RKIND/(Mu0*sgg%Med(1:sgg%NumMedia)%Mur)
 
     allocate (output(1:sgg%NumberRequest))
     output(1:sgg%NumberRequest)%Trancos = -1

test/observation/observation_testingTools.F90

@@ -59,7 +59,11 @@ subroutine check_shape_real(arr, n_expected, test_err, name)
       integer, allocatable :: shp(:)
       character(len=:), allocatable :: nm
 
-      nm = merge(name, "array", present(name))
+      if (present(name)) then
+          nm = trim(adjustl(name))
+      else
+          nm = "array"
+      end if
 
       rank_arr = rank(arr)
       shp = shape(arr)
@@ -82,7 +86,11 @@ subroutine check_shape_complex(arr, n_expected, test_err, name)
       integer, allocatable :: shp(:)
       character(len=:), allocatable :: nm
 
-      nm = merge(name, "array", present(name))
+      if (present(name)) then
+          nm = trim(adjustl(name))
+      else
+          nm = "array"
+      end if
 
       rank_arr = rank(arr)
       shp = shape(arr)
@@ -105,7 +113,11 @@ subroutine check_size(arr, n_expected, test_err, name)
       integer :: siz
       character(len=:), allocatable :: nm
 
-      nm = merge(name, "array", present(name))
+      if (present(name)) then
+          nm = trim(adjustl(name))
+      else
+          nm = "array"
+      end if
 
       rank_arr = rank(arr)
       siz = size(arr)

test/observation/test_observation_init.F90

@@ -29,7 +29,7 @@ integer function test_init_time_movie_observation() bind(C) result(err)
     ThereAreWires = .false.
     ThereAreFarFields = .false.
 
-    initialtimestep = 0
+    initialtimestep = 1
     lastexecutedtime = 0.0_RKIND_tiempo
 
     SINPML_fullsize = create_limit_t(0,4,0,4,0,4,3,3,3)

test/observation/test_observation_update.F90

@@ -31,7 +31,7 @@ integer function test_update_time_movie_observation() bind(C) result(err)
     ThereAreWires = .false.
     ThereAreFarFields = .false.
 
-    initialtimestep = 0
+    initialtimestep = 1
     lastexecutedtime = 0.0_RKIND_tiempo
 
     SINPML_fullsize = create_limit_t(0,4,0,4,0,4,3,3,3)

test/smbjson/test_read_mtln.F90

@@ -129,7 +129,7 @@ function expectedProblemDescription() result (expected)
       ! cable 1 - wire
       allocate(unshielded_multiwire_t :: expected%mtln%cables(1)%ptr)
       ptr => expected%mtln%cables(1)%ptr
-      call initializeCablePULParameters(ptr)
+      call initializeCablePULParameters(ptr, n=1)
       select type(ptr)
       type is (unshielded_multiwire_t)
          ptr%name = "line_0_0"
@@ -156,7 +156,7 @@ function expectedProblemDescription() result (expected)
       ! cable 2 - shieldedMultiwire
       allocate(shielded_multiwire_t :: expected%mtln%cables(2)%ptr)
       ptr => expected%mtln%cables(2)%ptr
-      call initializeCablePULParameters(ptr)
+      call initializeCablePULParameters(ptr, n=1)
       select type(ptr)
       type is (shielded_multiwire_t)
          ptr%name = "line_1_0"
@@ -244,7 +244,7 @@ function expectedProblemDescription() result (expected)
       ! cable 4 - wire
       allocate(unshielded_multiwire_t :: expected%mtln%cables(4)%ptr)
       ptr => expected%mtln%cables(4)%ptr
-      call initializeCablePULParameters(ptr)
+      call initializeCablePULParameters(ptr, n=1)
       select type(ptr)
       type is (unshielded_multiwire_t)
          ptr%name = "line_0_1"
@@ -272,7 +272,7 @@ function expectedProblemDescription() result (expected)
       ! cable 5 - shieldedMultiwire
       allocate(shielded_multiwire_t :: expected%mtln%cables(5)%ptr)
       ptr => expected%mtln%cables(5)%ptr
-      call initializeCablePULParameters(ptr)
+      call initializeCablePULParameters(ptr, n=1)
       select type(ptr)
       type is (shielded_multiwire_t)
          ptr%name = "line_1_1"
@@ -346,7 +346,7 @@ function expectedProblemDescription() result (expected)
       ! cable 7 - wire
       allocate(unshielded_multiwire_t :: expected%mtln%cables(7)%ptr)
       ptr => expected%mtln%cables(7)%ptr
-      call initializeCablePULParameters(ptr)
+      call initializeCablePULParameters(ptr, n=1)
       select type(ptr)
       type is (unshielded_multiwire_t)
          ptr%name = "line_0_2"
@@ -374,7 +374,7 @@ function expectedProblemDescription() result (expected)
       ! cable 8 - shieldedMultiwire
       allocate(shielded_multiwire_t :: expected%mtln%cables(8)%ptr)
       ptr => expected%mtln%cables(8)%ptr
-      call initializeCablePULParameters(ptr)
+      call initializeCablePULParameters(ptr, n=1)
       select type(ptr)
       type is (shielded_multiwire_t)
          ptr%name = "line_1_2"
@@ -408,7 +408,7 @@ function expectedProblemDescription() result (expected)
       ! cable 9 - shieldedMultiwire
       allocate(shielded_multiwire_t :: expected%mtln%cables(9)%ptr)
       ptr => expected%mtln%cables(9)%ptr
-      call initializeCablePULParameters(ptr,6)
+      call initializeCablePULParameters(ptr,n=6)
       select type(ptr)
       type is (shielded_multiwire_t)
          ptr%name = "line_2_5"

test/smbjson/test_read_shieldedPair.F90

@@ -101,7 +101,7 @@ function expectedProblemDescription() result (expected)
       allocate(expected%mtln%cables(2))
       ! cable 1 - wire
       allocate(unshielded_multiwire_t :: expected%mtln%cables(1)%ptr)
-      call initializeCablePULParameters(expected%mtln%cables(1)%ptr)
+      call initializeCablePULParameters(expected%mtln%cables(1)%ptr, n=1)
       ptr => expected%mtln%cables(1)%ptr
       select type(ptr)
       type is(unshielded_multiwire_t)
@@ -134,7 +134,7 @@ function expectedProblemDescription() result (expected)
       end select
       ! cable 2 - shieldedMultiwire
       allocate(shielded_multiwire_t :: expected%mtln%cables(2)%ptr)
-      call initializeCablePULParameters(expected%mtln%cables(2)%ptr)
+      call initializeCablePULParameters(expected%mtln%cables(2)%ptr, n=2)
       ptr => expected%mtln%cables(2)%ptr
       select type(ptr)
       type is(shielded_multiwire_t)