diff --git a/.gitignore b/.gitignore index 8f411d52..c7db396e 100755 --- a/.gitignore +++ b/.gitignore @@ -67,3 +67,5 @@ testData/outputs/paul/paul_8.6_square.txt testing_hdf5_writing_and_reading.h5 build fort.17 + +testData/input_examples/*txt \ No newline at end of file diff --git a/CMakeLists.txt b/CMakeLists.txt index 461a7bda..d4d00f5b 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -221,6 +221,7 @@ if(SEMBA_FDTD_COMPONENTS_LIB) "src_main_pub/farfield.F90" "src_wires_pub/wires.F90" "src_wires_pub/wires_mtln.F90" + "src_main_pub/evolution_operator.F90" ) target_link_libraries(semba-components semba-types semba-reports ${MTLN_LIBRARIES}) endif() @@ -241,6 +242,7 @@ endif() if(SEMBA_FDTD_MAIN_LIB) add_library(semba-main + "src_main_pub/semba_fdtd.F90" "src_main_pub/calc_constants.F90" "src_main_pub/nfde_rotate.F90" "src_main_pub/EpsMuTimeScale.F90" @@ -262,13 +264,14 @@ endif() if (SEMBA_FDTD_EXECUTABLE) add_executable(semba-fdtd - "src_main_pub/semba_fdtd.F90" + "src_main_pub/launcher.F90" ) target_link_libraries(semba-fdtd semba-main semba-reports) target_link_libraries(semba-fdtd ${MPI_Fortran_LIBRARIES}) endif() + include_directories(${CMAKE_BINARY_DIR}/mod) include_directories(${HDF5_INCLUDE_DIRS}) include_directories(${FHASH_INCLUDES}) diff --git a/src_main_pub/bordersother.F90 b/src_main_pub/bordersother.F90 index a7cca4e2..f705d245 100755 --- a/src_main_pub/bordersother.F90 +++ b/src_main_pub/bordersother.F90 @@ -81,7 +81,7 @@ subroutine MinusCloneMagneticPMC(sggalloc,sggBorder,Hx,Hy,Hz,c,layoutnumber,size if (layoutnumber == size-1) Hy( : , : ,C(iHy)%ZE+1)=-Hy( : , : ,C(iHy)%ZE) endif ! - !Hz Down + !Hz Back if (sggBorder%IsBackPMC) then Hz(C(iHz)%XI-1, : , : )=-Hz(C(iHz)%XI, : , : ) endif diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 new file mode 100644 index 00000000..05d2f797 --- /dev/null +++ b/src_main_pub/evolution_operator.F90 @@ -0,0 +1,867 @@ +module evolution_operator + + use Resuming + use Solver_mod + use fdetypes + use Report + use SEMBA_FDTD_mod + use smbjson_testingTools + + use fhash, key => fhash_key + + implicit none + + type :: field_array_t + real(RKIND), allocatable, dimension(:,:,:) :: data + character(len=2) :: field_type ! 'Ex', 'Ey', 'Ez', 'Hx', etc. + end type + + type :: int_array + integer, allocatable :: data(:) + end type + + private + + public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap, get_field_bounds_from_sembaFullsize, field_array_t + public :: GenerateColumnIndexMap, GenerateEvolutionOperator, EvolveState, EvolveStateMultipleSteps, GenerateStateFromFields, GenerateFieldArrayFromState, ResetSolverFields + +contains + + subroutine GenerateElectricalInputBasis(M, dim1, dim2, M_ee, M_eo, M_oe, M_oo) + + real(RKIND), intent(in) :: M(:,:,:) + integer, intent(in) :: dim1, dim2 + + real(RKIND), intent(out) :: M_ee(size(M,1), size(M,2), size(M,3)) + real(RKIND), intent(out) :: M_eo(size(M,1), size(M,2), size(M,3)) + real(RKIND), intent(out) :: M_oe(size(M,1), size(M,2), size(M,3)) + real(RKIND), intent(out) :: M_oo(size(M,1), size(M,2), size(M,3)) + + integer :: i, j, k + integer :: ijk(3) + integer :: v1, v2 + integer :: sz(3) + sz = shape(M) + + M_ee = 0.0_RKIND + M_eo = 0.0_RKIND + M_oe = 0.0_RKIND + M_oo = 0.0_RKIND + + do i = 0, sz(1)-1 + do j = 0, sz(2)-1 + do k = 0, sz(3)-1 + ijk = [i, j, k] + v1 = ijk(dim1) + v2 = ijk(dim2) + + select case (2*mod(v1,2) + mod(v2,2)) + case (0); M_ee(i+1,j+1,k+1) = 1.0_RKIND + case (1); M_eo(i+1,j+1,k+1) = 1.0_RKIND + case (2); M_oe(i+1,j+1,k+1) = 1.0_RKIND + case (3); M_oo(i+1,j+1,k+1) = 1.0_RKIND + end select + end do + end do + end do + end subroutine + + subroutine GenerateMagneticalInputBasis(A, M1, M2, M3, M) + + real(RKIND), intent(in) :: A(:,:,:) + integer, intent(in) :: M1, M2, M3 + + ! Output + real(RKIND), allocatable, intent(out) :: M(:,:,:,:,:,:) + ! M(m1, m2, m3, i, j, k) + + integer :: i, j, k + integer :: sz(3) + integer :: idx1, idx2, idx3 + + sz = shape(A) + allocate(M(M1, M2, M3, sz(1), sz(2), sz(3))) + M = 0.0_RKIND + + do i = 0, sz(1)-1 + do j = 0, sz(2)-1 + do k = 0, sz(3)-1 + idx1 = mod(i, M1) + idx2 = mod(j, M2) + idx3 = mod(k, M3) + M(idx1+1, idx2+1, idx3+1, i+1, j+1, k+1) = 1.0_RKIND + end do + end do + end do + end subroutine + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!! Creation of the basis for the input fields + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine GenerateInputFieldsBasis(b, FieldList) + + type (bounds_t), intent( IN) :: b + type(field_array_t), allocatable, intent(OUT) :: FieldList(:) + + ! Generating the basis for the electical fields + real (kind = RKIND), dimension ( b%Ex%NX, b%Ex%NY, b%Ex%NZ) :: Ex + real (kind = RKIND), dimension ( b%Ey%NX, b%Ey%NY, b%Ey%NZ) :: Ey + real (kind = RKIND), dimension ( b%Ez%NX, b%Ez%NY, b%Ez%NZ) :: Ez + + ! Generating the basis for the magnetical fields + real (kind = RKIND), dimension ( b%HX%NX, b%HX%NY, b%HX%NZ) :: Hx + real (kind = RKIND), dimension ( b%Hy%NX, b%Hy%NY, b%Hy%NZ) :: Hy + real (kind = RKIND), dimension ( b%Hz%NX, b%Hz%NY, b%Hz%NZ) :: Hz + + ! Allocating the basis for the electrical fields + real (kind = RKIND), dimension (b%Ex%NX,b%Ex%NY, b%Ex%NZ ) :: Ex_ee + real (kind = RKIND), dimension (b%Ex%NX,b%Ex%NY, b%Ex%NZ ) :: Ex_eo + real (kind = RKIND), dimension (b%Ex%NX,b%Ex%NY, b%Ex%NZ ) :: Ex_oe + real (kind = RKIND), dimension (b%Ex%NX,b%Ex%NY, b%Ex%NZ ) :: Ex_oo + real (kind = RKIND), dimension (b%Ey%NX,b%Ey%NY, b%Ey%NZ ) :: Ey_ee + real (kind = RKIND), dimension (b%Ey%NX,b%Ey%NY, b%Ey%NZ ) :: Ey_eo + real (kind = RKIND), dimension (b%Ey%NX,b%Ey%NY, b%Ey%NZ ) :: Ey_oe + real (kind = RKIND), dimension (b%Ey%NX,b%Ey%NY, b%Ey%NZ ) :: Ey_oo + real (kind = RKIND), dimension (b%Ez%NX,b%Ez%NY, b%Ez%NZ ) :: Ez_ee + real (kind = RKIND), dimension (b%Ez%NX,b%Ez%NY, b%Ez%NZ ) :: Ez_eo + real (kind = RKIND), dimension (b%Ez%NX,b%Ez%NY, b%Ez%NZ ) :: Ez_oe + real (kind = RKIND), dimension (b%Ez%NX,b%Ez%NY, b%Ez%NZ ) :: Ez_oo + + ! Allocating the basis for the magnetical fields + real (kind = RKIND), allocatable, dimension(:,:,:,:,:,:) :: Hx_m + real (kind = RKIND), allocatable, dimension(:,:,:,:,:,:) :: Hy_m + real (kind = RKIND), allocatable, dimension(:,:,:,:,:,:) :: Hz_m + + integer :: idx, i1, i2, i3 + + allocate(FieldList(66)) + + Ex = 0.0_RKIND + Ey = 0.0_RKIND + Ez = 0.0_RKIND + + Hx = 0.0_RKIND + Hy = 0.0_RKIND + Hz = 0.0_RKIND + + call GenerateElectricalInputBasis(Ex, 2, 3, Ex_ee, Ex_eo, Ex_oe, Ex_oo) + call GenerateElectricalInputBasis(Ey, 1, 3, Ey_ee, Ey_eo, Ey_oe, Ey_oo) + call GenerateElectricalInputBasis(Ez, 1, 2, Ez_ee, Ez_eo, Ez_oe, Ez_oo) + + ! Storing the electrical fields in the FieldList + FieldList(1)%data = Ex_ee + FieldList(2)%data = Ex_eo + FieldList(3)%data = Ex_oe + FieldList(4)%data = Ex_oo + + FieldList(5)%data = Ey_ee + FieldList(6)%data = Ey_eo + FieldList(7)%data = Ey_oe + FieldList(8)%data = Ey_oo + + FieldList(9)%data = Ez_ee + FieldList(10)%data = Ez_eo + FieldList(11)%data = Ez_oe + FieldList(12)%data = Ez_oo + + + call GenerateMagneticalInputBasis(Hx, 2, 3, 3, Hx_m) + call GenerateMagneticalInputBasis(Hy, 3, 2, 3, Hy_m) + call GenerateMagneticalInputBasis(Hz, 3, 3, 2, Hz_m) + + ! Storing the magnetical fields in the FieldList + + idx = 0 + + do idx = 1, 12 + if (idx <= 4) then + FieldList(idx)%field_type = 'Ex' + else if (idx <= 8) then + FieldList(idx)%field_type = 'Ey' + else if (idx <= 12) then + FieldList(idx)%field_type = 'Ez' + end if + end do + + do i1 = 1, 2 + do i2 = 1, 3 + do i3 = 1, 3 + FieldList(idx)%data = Hx_m(i1, i2, i3, :, :, :) + FieldList(idx)%field_type = 'Hx' + idx = idx + 1 + end do + end do + end do + + do i1 = 1, 3 + do i2 = 1, 2 + do i3 = 1, 3 + FieldList(idx)%data = Hy_m(i1, i2, i3, :, :, :) + FieldList(idx)%field_type = 'Hy' + idx = idx + 1 + end do + end do + end do + + do i1 = 1, 3 + do i2 = 1, 3 + do i3 = 1, 2 + FieldList(idx)%data = Hz_m(i1, i2, i3, :, :, :) + FieldList(idx)%field_type = 'Hz' + idx = idx + 1 + end do + end do + end do + + end subroutine + + subroutine AddElectricFieldIndices(RowIndexMap, Efield, H1field, H2field, startingIndex_Efield, startingIndex_H1field, startingIndex_H2field, shiftDirection_H1, shiftDirection_H2) + type(fhash_tbl_t), intent(inout) :: RowIndexMap + type(limit_t), intent(in) :: Efield, H1field, H2field + integer, intent(in) :: startingIndex_Efield, startingIndex_H1field, startingIndex_H2field + character(len=1), intent(in) :: shiftDirection_H1, shiftDirection_H2 + + integer :: i, j, k + integer :: combinedIndex_E, combinedIndex_H1, combinedIndex_H2 + integer :: indexShift_H1, indexShift_H2, auxiliarIndexShift_H1, auxiliarIndexShift_H2 + + type(int_array) :: wrapper + integer, allocatable :: indexList(:) + integer :: countIndex, positionList + + + do i = 1, Efield%Nx + do j = 1, Efield%Ny + do k = 1, Efield%Nz + combinedIndex_E = ((i - 1)*Efield%Ny + (j - 1))*Efield%Nz + k + combinedIndex_H1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + k + combinedIndex_H2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + k + + countIndex = 1 + positionList = 1 + + + select case (shiftDirection_H1) + case ('i') + if (i > 1 .and. i < Efield%Nx) then + indexShift_H1 = ((i - 2)*H1field%Ny + (j - 1))*H1field%Nz + k + countIndex = countIndex + 2 + else if (i == 1) then + indexShift_H1 = -1 + countIndex = countIndex + 1 + else + indexShift_H1 = -2 + auxiliarIndexShift_H1 = ((i - 2)*H1field%Ny + (j - 1))*H1field%Nz + k + countIndex = countIndex + 1 + end if + case ('j') + if (j > 1 .and. j < Efield%Ny) then + indexShift_H1 = ((i - 1)*H1field%Ny + (j - 2))*H1field%Nz + k + countIndex = countIndex + 2 + else if (j == 1) then + indexShift_H1 = -1 + countIndex = countIndex + 1 + else + indexShift_H1 = -2 + auxiliarIndexShift_H1 = ((i - 1)*H1field%Ny + (j - 2))*H1field%Nz + k + countIndex = countIndex + 1 + end if + case ('k') + if (k > 1 .and. k < Efield%Nz) then + indexShift_H1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + (k - 1) + countIndex = countIndex + 2 + else if (k == 1) then + indexShift_H1 = -1 + countIndex = countIndex + 1 + else + indexShift_H1 = -2 + auxiliarIndexShift_H1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + (k - 1) + countIndex = countIndex + 1 + end if + end select + + select case (shiftDirection_H2) + case ('i') + if (i > 1 .and. i < Efield%Nx) then + indexShift_H2 = ((i - 2)*H2field%Ny + (j - 1))*H2field%Nz + k + countIndex = countIndex + 2 + else if (i == 1) then + indexShift_H2 = -1 + countIndex = countIndex + 1 + else + indexShift_H2 = -2 + auxiliarIndexShift_H2 = ((i - 2)*H2field%Ny + (j - 1))*H2field%Nz + k + countIndex = countIndex + 1 + end if + case ('j') + if (j > 1 .and. j < Efield%Ny) then + indexShift_H2 = ((i - 1)*H2field%Ny + (j - 2))*H2field%Nz + k + countIndex = countIndex + 2 + else if (j == 1) then + indexShift_H2 = -1 + countIndex = countIndex + 1 + else + indexShift_H2 = -2 + auxiliarIndexShift_H2 = ((i - 1)*H2field%Ny + (j - 2))*H2field%Nz + k + countIndex = countIndex + 1 + end if + case ('k') + if (k > 1 .and. k < Efield%Nz) then + indexShift_H2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + (k - 1) + countIndex = countIndex + 2 + else if (k == 1) then + indexShift_H2 = -1 + countIndex = countIndex + 1 + else + indexShift_H2 = -2 + auxiliarIndexShift_H2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + (k - 1) + countIndex = countIndex + 1 + end if + end select + + + allocate(indexList(countIndex)) + indexList(positionList) = startingIndex_Efield + combinedIndex_E + positionList = positionList + 1 + + + if (indexShift_H2 /= -1 .and. indexShift_H2 /= -2) then + indexList(positionList) = startingIndex_H2field + combinedIndex_H2 + indexList(positionList + 1) = startingIndex_H2field + indexShift_H2 + positionList = positionList + 2 + else if (indexShift_H2 == -1) then ! Border at the beginning + indexList(positionList) = startingIndex_H2field + combinedIndex_H2 + positionList = positionList + 1 + else ! Border at the end + indexList(positionList) = startingIndex_H2field + auxiliarIndexShift_H2 + positionList = positionList + 1 + end if + + if (indexShift_H1 /= -1 .and. indexShift_H1 /= -2) then + indexList(positionList) = startingIndex_H1field + combinedIndex_H1 + indexList(positionList + 1) = startingIndex_H1field + indexShift_H1 + positionList = positionList + 2 + else if (indexShift_H1 == -1) then ! Border at the beginning + indexList(positionList) = startingIndex_H1field + combinedIndex_H1 + positionList = positionList + 1 + else ! Border at the end + indexList(positionList) = startingIndex_H1field + auxiliarIndexShift_H1 + positionList = positionList + 1 + end if + + + wrapper%data = indexList + call RowIndexMap%set(key(startingIndex_Efield + combinedIndex_E), value=wrapper) + deallocate(indexList) + end do + end do + end do + end subroutine + + subroutine AddMagneticFieldIndices(RowIndexMap, Hfield, E1field, E2field, startingIndex_Hfield, startingIndex_E1field, startingIndex_E2field, shiftDirection_E1, shiftDirection_E2) + type(fhash_tbl_t), intent(inout) :: RowIndexMap + type(limit_t), intent(in) :: Hfield, E1field, E2field + integer, intent(in) :: startingIndex_Hfield, startingIndex_E1field, startingIndex_E2field + character(len=1), intent(in) :: shiftDirection_E1, shiftDirection_E2 + + integer :: i, j, k + integer :: combinedIndex_H, combinedIndex_E1, combinedIndex_E2 + integer :: indexShift_E1, indexShift_E2 + + integer, allocatable :: fullIndexList(:), uniqueIndexList(:) + type(int_array) :: relatedIndices_E1, relatedIndices_E1_shift, relatedIndices_E2, relatedIndices_E2_shift, wrapper + integer :: relatedIndices_maximumSize + + + do i = 1, Hfield%Nx + do j = 1, Hfield%Ny + do k = 1, Hfield%Nz + combinedIndex_H = ((i - 1)*Hfield%Ny + (j - 1))*Hfield%Nz + k + combinedIndex_E1 = ((i - 1)*E1field%Ny + (j - 1))*E1field%Nz + k + combinedIndex_E2 = ((i - 1)*E2field%Ny + (j - 1))*E2field%Nz + k + + select case (shiftDirection_E1) + case ('i') + indexShift_E1 = ( i *E1field%Ny + (j - 1))*E1field%Nz + k + case ('j') + indexShift_E1 = ((i - 1)*E1field%Ny + j )*E1field%Nz + k + case ('k') + indexShift_E1 = ((i - 1)*E1field%Ny + (j - 1))*E1field%Nz + (k + 1) + end select + + select case (shiftDirection_E2) + case ('i') + indexShift_E2 = ( i *E2field%Ny + (j - 1))*E2field%Nz + k + case ('j') + indexShift_E2 = ((i - 1)*E2field%Ny + j )*E2field%Nz + k + case ('k') + indexShift_E2 = ((i - 1)*E2field%Ny + (j - 1))*E2field%Nz + (k + 1) + end select + + call fhash_get_int_array(RowIndexMap, key(startingIndex_E1field + combinedIndex_E1), relatedIndices_E1) + call fhash_get_int_array(RowIndexMap, key(startingIndex_E1field + indexShift_E1 ), relatedIndices_E1_shift) + call fhash_get_int_array(RowIndexMap, key(startingIndex_E2field + combinedIndex_E2), relatedIndices_E2) + call fhash_get_int_array(RowIndexMap, key(startingIndex_E2field + indexShift_E2 ), relatedIndices_E2_shift) + + + relatedIndices_maximumSize = size(relatedIndices_E1%data) + size(relatedIndices_E1_shift%data) + size(relatedIndices_E2%data) + size(relatedIndices_E2_shift%data) + allocate(fullIndexList(relatedIndices_maximumSize)) + + fullIndexList(1:size(relatedIndices_E1%data)) = relatedIndices_E1%data + fullIndexList(size(relatedIndices_E1%data)+1:size(relatedIndices_E1%data)+size(relatedIndices_E1_shift%data)) = relatedIndices_E1_shift%data + fullIndexList(size(relatedIndices_E1%data)+size(relatedIndices_E1_shift%data)+1:size(relatedIndices_E1%data)+size(relatedIndices_E1_shift%data)+size(relatedIndices_E2%data)) = relatedIndices_E2%data + fullIndexList(size(relatedIndices_E1%data)+size(relatedIndices_E1_shift%data)+size(relatedIndices_E2%data)+1:) = relatedIndices_E2_shift%data + + call RemoveDuplicates(fullIndexList, uniqueIndexList) + + wrapper%data = uniqueIndexList + + call RowIndexMap%set(key(startingIndex_Hfield + combinedIndex_H), value=wrapper) + + deallocate(fullIndexList, uniqueIndexList) + end do + end do + end do + end subroutine + + subroutine RemoveDuplicates(inputArray, outputArray) + integer, intent(in) :: inputArray(:) + integer, allocatable, intent(out) :: outputArray(:) + integer :: i, j, n + logical :: found + integer, allocatable :: fullIndexList(:) + + allocate(fullIndexList(size(inputArray))) + n = 0 + + do i = 1, size(inputArray) + found = .false. + do j = 1, n + if (fullIndexList(j) == inputArray(i)) then + found = .true. + exit + end if + end do + if (.not. found) then + n = n + 1 + fullIndexList(n) = inputArray(i) + end if + end do + + allocate(outputArray(n)) + outputArray = fullIndexList(1:n) + deallocate(fullIndexList) + end subroutine + + subroutine GenerateRowIndexMap(bounds, RowIndexMap) + + type(bounds_t), intent(IN) :: bounds + type(fhash_tbl_t), intent(OUT) :: RowIndexMap + integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz + + shiftEx = 0 + shiftEy = shiftEx + bounds%Ex%Nx * bounds%Ex%Ny * bounds%Ex%Nz + shiftEz = shiftEy + bounds%Ey%Nx * bounds%Ey%Ny * bounds%Ey%Nz + shiftHx = shiftEz + bounds%Ez%Nx * bounds%Ez%Ny * bounds%Ez%Nz + shiftHy = shiftHx + bounds%Hx%Nx * bounds%Hx%Ny * bounds%Hx%Nz + shiftHz = shiftHy + bounds%Hy%Nx * bounds%Hy%Ny * bounds%Hy%Nz + + + call AddElectricFieldIndices(RowIndexMap, bounds%Ex, bounds%Hy, bounds%Hz, shiftEx, shiftHy, shiftHz, 'k', 'j') + call AddElectricFieldIndices(RowIndexMap, bounds%Ey, bounds%Hx, bounds%Hz, shiftEy, shiftHx, shiftHz, 'k', 'i') + call AddElectricFieldIndices(RowIndexMap, bounds%Ez, bounds%Hx, bounds%Hy, shiftEz, shiftHx, shiftHy, 'j', 'i') + + call AddMagneticFieldIndices(RowIndexMap, bounds%Hx, bounds%Ez, bounds%Ey, shiftHx, shiftEz, shiftEy, 'j', 'k') + call AddMagneticFieldIndices(RowIndexMap, bounds%Hy, bounds%Ex, bounds%Ez, shiftHy, shiftEx, shiftEz, 'k', 'i') + call AddMagneticFieldIndices(RowIndexMap, bounds%Hz, bounds%Ex, bounds%Ey, shiftHz, shiftEx, shiftEy, 'j', 'i') + + + end subroutine GenerateRowIndexMap + + subroutine GenerateColumnIndexMap(bounds, ColIndexMap) + + type(bounds_t), intent(IN) :: bounds + type(fhash_tbl_t), intent(OUT) :: ColIndexMap + type(fhash_tbl_t) :: RowIndexMap + integer :: m1, m2, dataIdx, listPosition, countSize, totalElements + type(int_array) :: wrapper1, wrapper2, wrapperColumn + integer, allocatable :: tempData(:) + + + totalElements = bounds%Ex%NX * bounds%Ex%NY * bounds%Ex%NZ + & + bounds%Ey%NX * bounds%Ey%NY * bounds%Ey%NZ + & + bounds%Ez%NX * bounds%Ez%NY * bounds%Ez%NZ + & + bounds%Hx%NX * bounds%Hx%NY * bounds%Hx%NZ + & + bounds%Hy%NX * bounds%Hy%NY * bounds%Hy%NZ + & + bounds%Hz%NX * bounds%Hz%NY * bounds%Hz%NZ + + call GenerateRowIndexMap(bounds, RowIndexMap) + + do m1 = 1, totalElements + call fhash_get_int_array(RowIndexMap, key(m1), wrapper1) + + do dataIdx = 1, size(wrapper1%data) + listPosition = 1 + countSize = 0 + + do m2 = 1, totalElements + call fhash_get_int_array(RowIndexMap, key(m2), wrapper2) + + if (any(wrapper2%data == wrapper1%data(dataIdx))) then + countSize = countSize + 1 + end if + end do + + allocate(tempData(countSize)) + + do m2 = 1, totalElements + call fhash_get_int_array(RowIndexMap, key(m2), wrapper2) + + if (any(wrapper2%data == wrapper1%data(dataIdx))) then + tempData(listPosition) = m2 + listPosition = listPosition + 1 + end if + end do + + wrapperColumn%data = tempData + call ColIndexMap%set(key(wrapper1%data(dataIdx)), value=wrapperColumn) + deallocate(tempData) + end do + end do + + end subroutine GenerateColumnIndexMap + + subroutine fhash_get_int_array(tbl, k, val) + type(fhash_tbl_t), intent(in) :: tbl + class(fhash_key_t), intent(in) :: k + type(int_array), intent(out) :: val + + integer :: stat + class(*), allocatable :: raw + + call tbl%get_raw(k, raw, stat) + + if (stat /= 0) then + allocate(val%data(0)) + return + end if + + select type(d => raw) + type is (int_array) + val = d + class default + allocate(val%data(0)) + end select + end subroutine + + subroutine get_field_bounds_from_sembaFullsize(field_bounds, fullsize) + type(bounds_t), intent(out) :: field_bounds + TYPE (limit_t), DIMENSION (1:6) :: fullsize + type(integer) :: Nx, Ny, Nz + + Nx = fullsize(1)%xe - fullsize(1)%xi + 1 + Ny = fullsize(2)%ye - fullsize(2)%yi + 1 + Nz = fullsize(3)%ze - fullsize(3)%zi + 1 + + field_bounds%Ex%NX = nX + field_bounds%Ex%NY = nY + 1 + field_bounds%Ex%NZ = nZ + 1 + + field_bounds%Ey%NX = nX + 1 + field_bounds%Ey%NY = nY + field_bounds%Ey%NZ = nZ + 1 + + field_bounds%Ez%NX = nX + 1 + field_bounds%Ez%NY = nY + 1 + field_bounds%Ez%NZ = nZ + + field_bounds%Hx%NX = field_bounds%Ex%Nx + 1 + field_bounds%Hx%NY = field_bounds%Ex%Ny - 1 + field_bounds%Hx%NZ = field_bounds%Ex%Nz - 1 + + field_bounds%Hy%NX = field_bounds%Ey%Nx - 1 + field_bounds%Hy%NY = field_bounds%Ey%Ny + 1 + field_bounds%Hy%NZ = field_bounds%Ey%Nz - 1 + + field_bounds%Hz%NX = field_bounds%Ez%Nx - 1 + field_bounds%Hz%NY = field_bounds%Ez%Ny - 1 + field_bounds%Hz%NZ = field_bounds%Ez%Nz + 1 + end subroutine + + subroutine GenerateEvolutionOperator(semba, solver, evolutionOperator) + + type(semba_fdtd_t), intent(inout) :: semba + type(solver_t), intent(inout) :: solver + real (kind = RKIND), allocatable, dimension(:, :), intent(out) :: evolutionOperator + + type(field_array_t), allocatable :: fieldInputList(:) + type(int_array) :: wrapper + + type (bounds_t) :: bounds + type(fhash_tbl_t) :: ColIndexMap + + integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz + integer :: i, j, k, m, m_shifted, totalElements, fieldIdx + integer :: i_rel, j_rel, k_rel, m_rel, wrapperIdx + real(kind = RKIND) :: fieldValue + integer, dimension(3) :: dims + + + call get_field_bounds_from_sembaFullsize(bounds, semba%fullsize) + + shiftEx = 0 + shiftEy = 0 + bounds%Ex%Nx * bounds%Ex%Ny * bounds%Ex%Nz + shiftEz = shiftEy + bounds%Ey%Nx * bounds%Ey%Ny * bounds%Ey%Nz + shiftHx = shiftEz + bounds%Ez%Nx * bounds%Ez%Ny * bounds%Ez%Nz + shiftHy = shiftHx + bounds%Hx%Nx * bounds%Hx%Ny * bounds%Hx%Nz + shiftHz = shiftHy + bounds%Hy%Nx * bounds%Hy%Ny * bounds%Hy%Nz + + totalElements = bounds%Ex%NX * bounds%Ex%NY * bounds%Ex%NZ + & + bounds%Ey%NX * bounds%Ey%NY * bounds%Ey%NZ + & + bounds%Ez%NX * bounds%Ez%NY * bounds%Ez%NZ + & + bounds%Hx%NX * bounds%Hx%NY * bounds%Hx%NZ + & + bounds%Hy%NX * bounds%Hy%NY * bounds%Hy%NZ + & + bounds%Hz%NX * bounds%Hz%NY * bounds%Hz%NZ + + allocate(evolutionOperator(totalElements, totalElements)) + evolutionOperator = 0.0_RKIND + fieldValue = 0.0_RKIND + + call GenerateColumnIndexMap(bounds, ColIndexMap) + call GenerateInputFieldsBasis(bounds, fieldInputList) + + do fieldIdx = 1, size(fieldInputList) + dims = shape(fieldInputList(fieldIdx)%data) + + do i = 1, dims(1) + do j = 1, dims(2) + do k = 1, dims(3) + select case (fieldInputList(fieldIdx)%field_type) + case ('Ex') + call solver%set_field_value(iEx, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInputList(fieldIdx)%data(i,j,k)) + case ('Ey') + call solver%set_field_value(iEy, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInputList(fieldIdx)%data(i,j,k)) + case ('Ez') + call solver%set_field_value(iEz, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInputList(fieldIdx)%data(i,j,k)) + case ('Hx') + call solver%set_field_value(iHx, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInputList(fieldIdx)%data(i,j,k)) + case ('Hy') + call solver%set_field_value(iHy, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInputList(fieldIdx)%data(i,j,k)) + case ('Hz') + call solver%set_field_value(iHz, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInputList(fieldIdx)%data(i,j,k)) + end select + end do + end do + end do + + + call solver%step(semba%sgg, semba%eps0, semba%mu0, semba%SINPML_FULLSIZE, semba%tag_numbers) + + + do i = 1, dims(1) + do j = 1, dims(2) + do k = 1, dims(3) + m = ((i - 1)*dims(2) + (j - 1))*dims(3) + k + + select case (fieldInputList(fieldIdx)%field_type) + case ('Ex') + call fhash_get_int_array(ColIndexMap, key(shiftEx + m), wrapper) + m_shifted = shiftEx + m + case ('Ey') + call fhash_get_int_array(ColIndexMap, key(shiftEy + m), wrapper) + m_shifted = shiftEy + m + case ('Ez') + call fhash_get_int_array(ColIndexMap, key(shiftEz + m), wrapper) + m_shifted = shiftEz + m + case ('Hx') + call fhash_get_int_array(ColIndexMap, key(shiftHx + m), wrapper) + m_shifted = shiftHx + m + case ('Hy') + call fhash_get_int_array(ColIndexMap, key(shiftHy + m), wrapper) + m_shifted = shiftHy + m + case ('Hz') + call fhash_get_int_array(ColIndexMap, key(shiftHz + m), wrapper) + m_shifted = shiftHz + m + end select + + do wrapperIdx = 1, size(wrapper%data) + m_rel = wrapper%data(wrapperIdx) + + if (m_rel <= shiftEy) then + k_rel = mod(m_rel - shiftEx - 1, bounds%Ex%Nz) + 1 + j_rel = mod((m_rel - shiftEx - 1) / bounds%Ex%Nz, bounds%Ex%Ny) + 1 + i_rel = (m_rel - shiftEx - 1) / (bounds%Ex%Nz * bounds%Ex%Ny) + 1 + + fieldValue = solver%get_field_value(iEx, i_rel - 1, j_rel - 1, k_rel - 1) + else if (m_rel <= shiftEz) then + k_rel = mod(m_rel - shiftEy - 1, bounds%Ey%Nz) + 1 + j_rel = mod((m_rel - shiftEy - 1) / bounds%Ey%Nz, bounds%Ey%Ny) + 1 + i_rel = (m_rel - shiftEy - 1) / (bounds%Ey%Nz * bounds%Ey%Ny) + 1 + + fieldValue = solver%get_field_value(iEy, i_rel - 1, j_rel - 1, k_rel - 1) + else if (m_rel <= shiftHx) then + k_rel = mod(m_rel - shiftEz - 1, bounds%Ez%Nz) + 1 + j_rel = mod((m_rel - shiftEz - 1) / bounds%Ez%Nz, bounds%Ez%Ny) + 1 + i_rel = (m_rel - shiftEz - 1) / (bounds%Ez%Nz * bounds%Ez%Ny) + 1 + + fieldValue = solver%get_field_value(iEz, i_rel - 1, j_rel - 1, k_rel - 1) + else if (m_rel <= shiftHy) then + k_rel = mod(m_rel - shiftHx - 1, bounds%Hx%Nz) + 1 + j_rel = mod((m_rel - shiftHx - 1) / bounds%Hx%Nz, bounds%Hx%Ny) + 1 + i_rel = (m_rel - shiftHx - 1) / (bounds%Hx%Nz * bounds%Hx%Ny) + 1 + + fieldValue = solver%get_field_value(iHx, i_rel - 1, j_rel - 1, k_rel - 1) + else if (m_rel <= shiftHz) then + k_rel = mod(m_rel - shiftHy - 1, bounds%Hy%Nz) + 1 + j_rel = mod((m_rel - shiftHy - 1) / bounds%Hy%Nz, bounds%Hy%Ny) + 1 + i_rel = (m_rel - shiftHy - 1) / (bounds%Hy%Nz * bounds%Hy%Ny) + 1 + + fieldValue = solver%get_field_value(iHy, i_rel - 1, j_rel - 1, k_rel - 1) + else + k_rel = mod(m_rel - shiftHz - 1, bounds%Hz%Nz) + 1 + j_rel = mod((m_rel - shiftHz - 1) / bounds%Hz%Nz, bounds%Hz%Ny) + 1 + i_rel = (m_rel - shiftHz - 1) / (bounds%Hz%Nz * bounds%Hz%Ny) + 1 + + fieldValue = solver%get_field_value(iHz, i_rel - 1, j_rel - 1, k_rel - 1) + end if + + evolutionOperator(m_rel, m_shifted) = fieldValue + end do + + end do + end do + end do + + call ResetSolverFields(solver) + + end do + end subroutine + + subroutine GenerateStateFromFields(fieldArray, stateVector) + type(field_array_t), intent(in) :: fieldArray(:) + real (kind = RKIND), allocatable, dimension(:), intent(out) :: stateVector + real (kind = RKIND), allocatable, dimension(:,:,:) :: tempField + + integer :: i, j, k, m, shiftField + integer :: nFields, totalElements + + totalElements = 0 + do nFields = 1, size(fieldArray) + tempField = fieldArray(nFields)%data + + do i = 1, size(tempField, 1) + do j = 1, size(tempField, 2) + do k = 1, size(tempField, 3) + totalElements = totalElements + 1 + end do + end do + end do + end do + + allocate(stateVector(totalElements)) + + shiftField = 0 + do nFields = 1, size(fieldArray) + tempField = fieldArray(nFields)%data + + do i = 1, size(tempField, 1) + do j = 1, size(tempField, 2) + do k = 1, size(tempField, 3) + m = ((i - 1)*size(tempField, 2) + (j - 1))*size(tempField, 3) + k + stateVector(shiftField + m) = tempField(i, j, k) + end do + end do + end do + + shiftField = shiftField + size(tempField, 1) * size(tempField, 2) * size(tempField, 3) + end do + + + end subroutine + + subroutine EvolveState(semba, solver, initialState, finalState) + + type(semba_fdtd_t), intent(inout) :: semba + type(solver_t), intent(inout) :: solver + real (kind = RKIND), intent(in), dimension(:) :: initialState + real (kind = RKIND), intent(out), dimension(:), allocatable :: finalState + + type (bounds_t) :: bounds + real (kind = RKIND), allocatable, dimension(:, :) :: evolutionOperator + + call GenerateEvolutionOperator(semba, solver, evolutionOperator) + allocate(finalState(size(initialState))) + + finalState = matmul(evolutionOperator, initialState) + + end subroutine + + subroutine EvolveStateMultipleSteps(semba, solver, nSteps, initialState, finalState) + + type(semba_fdtd_t), intent(inout) :: semba + type(solver_t), intent(inout) :: solver + integer, intent(in) :: nSteps + real (kind = RKIND), intent(in), dimension(:) :: initialState + real (kind = RKIND), intent(out), dimension(:), allocatable :: finalState + + real (kind = RKIND), allocatable, dimension(:, :) :: evolutionOperator + real (kind = RKIND), allocatable, dimension(:) :: tempState + integer :: step + + call GenerateEvolutionOperator(semba, solver, evolutionOperator) + + tempState = initialState + allocate(finalState(size(initialState))) + + do step = 1, nSteps + finalState = matmul(evolutionOperator, tempState) + tempState = finalState + end do + + end subroutine + + subroutine GenerateFieldArrayFromState(stateVector, fieldArrayInput, fieldArrayOutput) + real (kind = RKIND), intent(in), dimension(:) :: stateVector + type(field_array_t), intent(in) :: fieldArrayInput(:) + type(field_array_t), allocatable, intent(out) :: fieldArrayOutput(:) + + integer :: i, j, k, m, shiftField + integer :: nFields + + m = size(stateVector) + shiftField = 0 + allocate(fieldArrayOutput(size(fieldArrayInput))) + + do nFields = 1, size(fieldArrayInput) + allocate(fieldArrayOutput(nFields)%data(size(fieldArrayInput(nFields)%data, 1), size(fieldArrayInput(nFields)%data, 2), size(fieldArrayInput(nFields)%data, 3))) + fieldArrayOutput(nFields)%field_type = fieldArrayInput(nFields)%field_type + + do i = 1, size(fieldArrayInput(nFields)%data, 1) + do j = 1, size(fieldArrayInput(nFields)%data, 2) + do k = 1, size(fieldArrayInput(nFields)%data, 3) + m = ((i - 1)*size(fieldArrayInput(nFields)%data, 2) + (j - 1))*size(fieldArrayInput(nFields)%data, 3) + k + fieldArrayOutput(nFields)%data(i, j, k) = stateVector(shiftField + m) + end do + end do + end do + + shiftField = shiftField + size(fieldArrayInput(nFields)%data, 1) * size(fieldArrayInput(nFields)%data, 2) * size(fieldArrayInput(nFields)%data, 3) + end do + + + + end subroutine + + subroutine ResetSolverFields(solver) + type(solver_t), intent(inout) :: solver + + call solver%set_field_value(iEx, [solver%bounds%Ex%xi, solver%bounds%Ex%xe], [solver%bounds%Ex%yi, solver%bounds%Ex%ye], [solver%bounds%Ex%zi, solver%bounds%Ex%ze], 0.0) + call solver%set_field_value(iEy, [solver%bounds%Ey%xi, solver%bounds%Ey%xe], [solver%bounds%Ey%yi, solver%bounds%Ey%ye], [solver%bounds%Ey%zi, solver%bounds%Ey%ze], 0.0) + call solver%set_field_value(iEz, [solver%bounds%Ez%xi, solver%bounds%Ez%xe], [solver%bounds%Ez%yi, solver%bounds%Ez%ye], [solver%bounds%Ez%zi, solver%bounds%Ez%ze], 0.0) + call solver%set_field_value(iHx, [solver%bounds%Hx%xi, solver%bounds%Hx%xe], [solver%bounds%Hx%yi, solver%bounds%Hx%ye], [solver%bounds%Hx%zi, solver%bounds%Hx%ze], 0.0) + call solver%set_field_value(iHy, [solver%bounds%Hy%xi, solver%bounds%Hy%xe], [solver%bounds%Hy%yi, solver%bounds%Hy%ye], [solver%bounds%Hy%zi, solver%bounds%Hy%ze], 0.0) + call solver%set_field_value(iHz, [solver%bounds%Hz%xi, solver%bounds%Hz%xe], [solver%bounds%Hz%yi, solver%bounds%Hz%ye], [solver%bounds%Hz%zi, solver%bounds%Hz%ze], 0.0) + + end subroutine + +end module \ No newline at end of file diff --git a/src_main_pub/fdetypes.F90 b/src_main_pub/fdetypes.F90 index c2a3a2f1..4a841a3f 100755 --- a/src_main_pub/fdetypes.F90 +++ b/src_main_pub/fdetypes.F90 @@ -651,11 +651,13 @@ module FDETYPES permitscaling,mtlnberenger,niapapostprocess, & stochastic, verbose, dontwritevtk, & use_mtln_wires, resume_fromold, vtkindex,createh5bin,wirecrank,fatalerror - - ! REAL (kind=8) :: time_desdelanzamiento - REAL (kind=rkind) :: cfl, attfactorc,attfactorw, alphamaxpar, & - alphaOrden, kappamaxpar, mindistwires,sgbcFreq,sgbcresol - real (kind=rkind_wires) :: factorradius,factordelta !maxSourceValue +#ifdef CompileWithConformal + logical :: input_conformal_flag +#endif + REAL (kind=8) :: time_desdelanzamiento + REAL (kind=RKIND) :: cfl, attfactorc,attfactorw, alphamaxpar, & + alphaOrden, kappamaxpar, mindistwires,sgbcFreq,sgbcresol, maxSourceValue + real (kind=rkind_wires) :: factorradius,factordelta character (len=BUFSIZE) :: nEntradaRoot, inductance_model,wiresflavor, nresumeable2 CHARACTER (LEN=BUFSIZE) :: opcionestotales, ficherohopf diff --git a/src_main_pub/getargs.F90 b/src_main_pub/getargs.F90 index 11804210..f54d2f58 100755 --- a/src_main_pub/getargs.F90 +++ b/src_main_pub/getargs.F90 @@ -5,18 +5,23 @@ Module Getargs implicit none private - public getcommandargument,commandargumentcount + public getBinaryPath, getcommandargument,commandargumentcount contains - subroutine getcommandargument(chain2,posic,argum,length,status) + function getBinaryPath() result(res) + character (LEN=BUFSIZE) :: res + CALL getarg(0, res) + end function + + subroutine getcommandargument(chain2,posic,argum,length,status, binaryPath) character (LEN=BUFSIZE) ::chain2, argum, argument, binaryPath integer (kind=4) :: length, status, posic, binaryPathLenght, argumentStart, argumentEnd integer (kind=4) :: n, i, j CALL removeDoubleWhiteSpaces(chain2) - CALL getarg(0, binaryPath) + ! CALL getarg(0, binaryPath) binaryPathLenght = len(trim(adjustl(binaryPath))) !!Check if binary path is surrounded by double quotes. In that case, returns corrected binary path and lenght @@ -80,13 +85,13 @@ subroutine removeDoubleWhiteSpaces(chain2) end subroutine - function commandargumentcount(chain2) + function commandargumentcount(chain2, binaryPath) character (LEN=BUFSIZE) :: chain2, binaryPath integer (kind=4) :: status,n,commandargumentcount, binaryPathLenght, i CALL removeDoubleWhiteSpaces(chain2) - CALL getarg(0, binaryPath) + ! CALL getarg(0, binaryPath) binaryPathLenght = len(trim(adjustl(binaryPath))) !!Check if binary path is surrounded by double quotes. In that case, returns corrected binary path and lenght diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index 1232670b..b070c675 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -89,7 +89,8 @@ module interpreta_switches_m noconformalmapvtk , & createh5filefromsinglebin , & creditosyaprinteados , & - use_mtln_wires + use_mtln_wires , & + read_command_line integer (kind=4) :: & wirethickness ,& @@ -176,7 +177,7 @@ subroutine interpreta(l,statuse) type (entrada_t), intent(INOUT) :: l !!!!!!!!! - CHARACTER (LEN=BUFSIZE) :: chari,f,dubuf,buff + CHARACTER (LEN=BUFSIZE) :: chari,f,dubuf,buff, binaryPath logical :: existiarunningigual,mpidirset,resume3 integer (kind=4) :: i,j,donde,n, newmpidir,statuse real (KIND=RKIND) :: pausetime @@ -189,7 +190,8 @@ subroutine interpreta(l,statuse) existiarunningigual=.false. statuse=0 !!!!!!!!!!!!!!! - n = commandargumentcount (l%chaininput) + binaryPath = getBinaryPath() + n = commandargumentcount (l%chaininput, binaryPath) IF (n == 0) THEN call print_basic_help(l) call stoponerror(l%layoutnumber,l%size,'Error: NO arguments neither command line nor in launch file. Correct and remove pause...',.true.) @@ -198,7 +200,7 @@ subroutine interpreta(l,statuse) END IF l%opcionestotales='' do i=1,n - CALL getcommandargument (l%chaininput,i,l%chain,l%length,statuse) + CALL getcommandargument (l%chaininput,i,l%chain,l%length, statuse, binaryPath) IF (statuse /= 0) THEN CALL stoponerror (l%layoutnumber, l%size, 'Reading input',.true.) statuse=-1 @@ -212,7 +214,7 @@ subroutine interpreta(l,statuse) IF (n > 0) THEN i = 2 ! se empieza en 2 porque el primer argumento es siempre el nombre del ejecutable DO while (i <= n) - CALL getcommandargument (l%chaininput, i, l%chain, l%length, statuse) + CALL getcommandargument (l%chaininput, i, l%chain, l%length, statuse, binaryPath) IF (statuse /= 0) THEN CALL stoponerror (l%layoutnumber, l%size, 'Reading input',.true.) statuse=-1 @@ -221,15 +223,15 @@ subroutine interpreta(l,statuse) SELECT CASE (trim(adjustl(l%chain))) CASE ('-i') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) continue !ya interpretado case ('-a') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) continue !ya interpretado CASE ('-mpidir') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) select case (trim (adjustl(f))) case ('x','X') newmpidir=1 !!!lo cambie por error !161018 @@ -255,7 +257,7 @@ subroutine interpreta(l,statuse) case ('-pause') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to integer READ (f,*, ERR=7312) pausetime GO TO 8312 @@ -294,7 +296,7 @@ subroutine interpreta(l,statuse) !!! CASE ('-maxmessages') !!! i = i + 1 - !!! CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + !!! CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) !!! READ (f,*, ERR=1012) maxmessages !!! GO TO 2012 !!!1012 CALL stoponerror (l%layoutnumber, l%size, 'Invalid Number of maxmessages',.true.) @@ -307,7 +309,7 @@ subroutine interpreta(l,statuse) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) // ' ' // trim (adjustl(f)) CASE ('-noNF2FF') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) select case (trim (adjustl(f))) case ('back','BACK') l%facesNF2FF%TR=.FALSE. @@ -334,7 +336,7 @@ subroutine interpreta(l,statuse) CASE ('-force') l%forcing = .TRUE. i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) READ (f,*, ERR=412) l%forced GO TO 312 412 CALL stoponerror (l%layoutnumber, l%size, 'Invalid cut',.true.) @@ -383,7 +385,7 @@ subroutine interpreta(l,statuse) #endif CASE ('-cpumax') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to integer READ (f,*, ERR=712) l%maxCPUtime GO TO 812 @@ -400,7 +402,7 @@ subroutine interpreta(l,statuse) l%freshstart = .TRUE. CASE ('-flush') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to integer READ (f,*, ERR=300) l%flushminutesFields GO TO 400 @@ -414,7 +416,7 @@ subroutine interpreta(l,statuse) END IF CASE ('-flushdata') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to integer READ (f,*, ERR=301) l%flushminutesData GO TO 401 @@ -441,7 +443,7 @@ subroutine interpreta(l,statuse) l%hopf=.true. i = i + 1; l%ficherohopf = char(0); - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) l%ficherohopf = trim(adjustl(f)); INQUIRE (file=trim(adjustl(f)), EXIST=l%existeNFDE) IF ( .NOT. l%existeNFDE) THEN @@ -488,7 +490,7 @@ subroutine interpreta(l,statuse) l%input_conformal_flag = .true.; l%conformal_file_input_name = char(0); - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) l%conformal_file_input_name = trim(adjustl(f)); INQUIRE (file=trim(adjustl(f)), EXIST=l%existeNFDE) @@ -546,7 +548,7 @@ subroutine interpreta(l,statuse) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) CASE ('-pmlalpha') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=7621) l%alphamaxpar GO TO 8621 @@ -560,7 +562,7 @@ subroutine interpreta(l,statuse) END IF i = i + 1 ! l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain))// ' ' // trim (adjustl(f)) - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=7121) l%alphaOrden GO TO 8121 @@ -575,7 +577,7 @@ subroutine interpreta(l,statuse) ! l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain))// ' ' // trim (adjustl(f)) CASE ('-pmlkappa') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=7622) l%kappamaxpar GO TO 8622 @@ -591,7 +593,7 @@ subroutine interpreta(l,statuse) CASE ('-pmlcorr') l%MEDIOEXTRA%exists=.true. i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=7672) l%MEDIOEXTRA%sigma GO TO 8672 @@ -606,7 +608,7 @@ subroutine interpreta(l,statuse) l%MEDIOEXTRA%sigmam=-1.0_RKIND!voids it. later overriden ! l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain))// ' ' // trim (adjustl(f)) i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=7662) l%MEDIOEXTRA%size GO TO 8662 @@ -619,7 +621,7 @@ subroutine interpreta(l,statuse) ! l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain))// ' ' // trim (adjustl(f)) CASE ('-attc') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=766) l%attfactorc GO TO 866 @@ -632,7 +634,7 @@ subroutine interpreta(l,statuse) l%mibc=.false. l%sgbc=.true. i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=7466) l%sgbcdepth GO TO 8466 @@ -645,7 +647,7 @@ subroutine interpreta(l,statuse) l%sgbc=.true. l%mibc=.false. i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=74616) l%sgbcfreq GO TO 84616 @@ -658,7 +660,7 @@ subroutine interpreta(l,statuse) l%mibc=.false. l%sgbc=.true. i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=74626) l%sgbcresol GO TO 84626 @@ -693,7 +695,7 @@ subroutine interpreta(l,statuse) l%saveall = .TRUE. CASE ('-attw') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=732) l%attfactorw GO TO 832 @@ -705,7 +707,7 @@ subroutine interpreta(l,statuse) CASE ('-maxwireradius') l%boundwireradius=.true. i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=737) l%maxwireradius GO TO 837 @@ -716,7 +718,7 @@ subroutine interpreta(l,statuse) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain))// ' ' // trim (adjustl(f)) CASE ('-mindistwires') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=1732) l%mindistwires GO TO 1832 @@ -764,7 +766,7 @@ subroutine interpreta(l,statuse) l%use_mtln_wires = .true. CASE ('-wirethickness') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=7416) l%wirethickness GO TO 8416 @@ -775,7 +777,7 @@ subroutine interpreta(l,statuse) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain))// ' ' // trim (adjustl(f)) CASE ('-wiresflavor') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) // ' ' // trim (adjustl(f)) READ (f, '(a)', ERR=3621) l%wiresflavor if (trim(adjustl(l%wiresflavor(1:1)))=='g') l%wiresflavor='slanted' @@ -792,7 +794,7 @@ subroutine interpreta(l,statuse) l%wiresflavor='semistructured' ! i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(f)) ! Converts the characters to real READ (f,*, ERR=2561) l%precision @@ -862,7 +864,7 @@ subroutine interpreta(l,statuse) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) CASE ('-inductance') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) READ (f, '(a)', ERR=361) l%inductance_model GO TO 461 361 CALL stoponerror (l%layoutnumber, l%size, 'Invalid inductance model',.true.); statuse=-1; !goto 668 @@ -873,19 +875,19 @@ subroutine interpreta(l,statuse) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) // ' ' // trim (adjustl(f)) CASE ('-inductanceorder') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) READ (f,*, ERR=179) l%inductance_order 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)) CASE ('-prefix') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) l%prefix = '_' // trim (adjustl(f)) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain)) // ' ' // trim (adjustl(f)) CASE ('-cfl') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to real READ (f,*, ERR=3762) l%cfltemp GO TO 3862 @@ -910,7 +912,7 @@ subroutine interpreta(l,statuse) l%saveall=.true. !lo salvo todo en permit scaling para evitar errores i = i + 1 buff="" - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) READ (f,*, ERR=33762) buff l%EpsMuTimeScale_input_parameters%electric=.False. l%EpsMuTimeScale_input_parameters%electric=.False. @@ -926,16 +928,16 @@ subroutine interpreta(l,statuse) GO TO 33862 end select i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(l%chain))// ' ' // trim (adjustl(f)) ! Converts the characters to real READ (f,*, ERR=33762) l%EpsMuTimeScale_input_parameters%tini i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(f)) READ (f,*, ERR=33762) l%EpsMuTimeScale_input_parameters%tend i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) l%opcionespararesumeo = trim (adjustl(l%opcionespararesumeo)) // ' ' // trim (adjustl(f)) READ (f,*, ERR=33762) l%EpsMuTimeScale_input_parameters%alpha_max GO TO 33862 @@ -952,7 +954,7 @@ subroutine interpreta(l,statuse) CASE ('-n') l%forcesteps = .TRUE. i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to integer READ (f,*, ERR=602) l%finaltimestep GO TO 702 @@ -963,7 +965,7 @@ subroutine interpreta(l,statuse) !!!!!! CASE ('-factorradius') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to integer READ (f,*, ERR=6032) l%factorradius GO TO 7032 @@ -971,7 +973,7 @@ subroutine interpreta(l,statuse) 7032 continue CASE ('-factordelta') i = i + 1 - CALL getcommandargument (l%chaininput, i, f, l%length, statuse) + CALL getcommandargument (l%chaininput, i, f, l%length, statuse, binaryPath) ! Converts the characters to integer READ (f,*, ERR=6072) l%factordelta GO TO 7072 @@ -1765,7 +1767,7 @@ subroutine buscaswitchficheroinput(l) type (entrada_t), intent(INOUT) :: l !!!!!!!!! - CHARACTER (LEN=BUFSIZE) :: dato,buff,f + CHARACTER (LEN=BUFSIZE) :: dato,buff,f, binaryPath integer (kind=4) :: i,n,statuse, NUM_NFDES,TEMP_NUMNFDES,p CHARACTER (LEN=5) :: NFDEEXTENSION, CONFEXTENSION, CMSHEXTENSION @@ -1775,7 +1777,8 @@ subroutine buscaswitchficheroinput(l) NFDEEXTENSION='.nfde'; CONFEXTENSION='.conf'; CMSHEXTENSION='.cmsh' statuse=0 !!!!!!!!!!!!!!! - n = commandargumentcount (l%chain2) + binaryPath = getBinaryPath() + n = commandargumentcount (l%chain2, binaryPath) IF (n == 0) THEN call print_basic_help(l) call stoponerror(l%layoutnumber,l%size,'Error: NO arguments neither command line nor in launch file. Correct and remove pause...',.true.) @@ -1787,7 +1790,7 @@ subroutine buscaswitchficheroinput(l) num_nfdes=0 i = 2 DO while (i <= n) - CALL getcommandargument (l%chain2, i, l%chain, l%length, statuse) + CALL getcommandargument (l%chain2, i, l%chain, l%length, statuse, binaryPath) IF (statuse /= 0) THEN CALL stoponerror (l%layoutnumber, l%size, 'Reading input',.true.) goto 667 @@ -1796,7 +1799,7 @@ subroutine buscaswitchficheroinput(l) SELECT CASE (trim(adjustl(l%chain))) CASE ('-mpidir') i = i + 1 - CALL getcommandargument (l%chain2, i, f, l%length, statuse) + CALL getcommandargument (l%chain2, i, f, l%length, statuse, binaryPath) select case (trim (adjustl(f))) case ('x','X') l%mpidir=1 !!!lo cambie por error !161018 @@ -1831,7 +1834,7 @@ subroutine buscaswitchficheroinput(l) temp_numnfdes=0 i = 2 ! se empieza en 2 porque el primer argumento es siempre el nombre del ejecutable DO while (i <= n) - CALL getcommandargument (l%chain2, i, l%chain, l%length, statuse) + CALL getcommandargument (l%chain2, i, l%chain, l%length, statuse, binaryPath) IF (statuse /= 0) THEN CALL stoponerror (l%layoutnumber, l%size, 'Reading input',.true.) goto 667 @@ -1841,7 +1844,7 @@ subroutine buscaswitchficheroinput(l) CASE ('-i') temp_numnfdes=temp_numnfdes + 1 i = i + 1 - CALL getcommandargument (l%chain2, i, f, l%length, statuse) + CALL getcommandargument (l%chain2, i, f, l%length, statuse, binaryPath) p = LEN_trim (adjustl(f)) IF ((p-4) >= 1) THEN IF (f((p-4) :(p-4)) == NFDEEXTENSION(1:1)) THEN @@ -1920,7 +1923,7 @@ subroutine buscaswitchficheroinput(l) IF (n > 0) THEN i = 2 ! se empieza en 2 porque el primer argumento es siempre el nombre del ejecutable DO while (i <= n) - CALL getcommandargument (l%chain2, i, l%chain, l%length, statuse) + CALL getcommandargument (l%chain2, i, l%chain, l%length, statuse, binaryPath) IF (statuse /= 0) THEN CALL stoponerror (l%layoutnumber, l%size, 'Reading input',.true.) goto 667 @@ -1933,7 +1936,7 @@ subroutine buscaswitchficheroinput(l) i = i + 1 if (temp_numnfdes == 1) then ! - CALL getcommandargument (l%chain2, i, f, l%length, statuse) + CALL getcommandargument (l%chain2, i, f, l%length, statuse, binaryPath) p = LEN_trim (adjustl(f)) IF ((p-4) >= 1) THEN IF (f((p-4) :(p-4)) == NFDEEXTENSION(1:1)) THEN @@ -1950,6 +1953,11 @@ subroutine buscaswitchficheroinput(l) statuse=-1 goto 667 END IF + block + CHARACTER(len=255) :: cwd + CALL getcwd(cwd) + WRITE(*,*) TRIM(cwd) + end block INQUIRE (file=trim(adjustl(l%fichin))//NFDEEXTENSION, EXIST=l%existeNFDE) IF ( .NOT. l%existeNFDE) THEN buff='The input file was not found '//trim(adjustl(l%fichin))//NFDEEXTENSION @@ -2028,6 +2036,7 @@ subroutine default_flags(l) l%facesNF2FF%ar=.true. !defaults l%use_mtln_wires = .false. + l%read_command_line = .true. l%hay_slanted_wires=.false. l%forcing = .FALSE. l%resume_fromold = .FALSE. @@ -2099,6 +2108,7 @@ subroutine default_flags(l) l%stableradholland=.false. !solo actua si se invoca con l%wiresflavor holland l%fieldtotl=.false. l%experimentalVideal=.false. + l%thereare_stoch=.false. l%forceresampled=.false. l%factorradius=1.0e+30 !para evitar division por cero 120123 l%factordelta=1.0e+30 !para evitar division por cero 120123 diff --git a/src_main_pub/launcher.F90 b/src_main_pub/launcher.F90 new file mode 100644 index 00000000..99d431df --- /dev/null +++ b/src_main_pub/launcher.F90 @@ -0,0 +1,14 @@ +program SEMBA_FDTD_launcher + use SEMBA_FDTD_mod + implicit none + + type(semba_fdtd_t) :: semba + + call semba%init() + call semba%launch() + call semba%end() + + +end program SEMBA_FDTD_launcher + + diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index ffa90064..58ad5fb5 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -1,4 +1,4 @@ -PROGRAM SEMBA_FDTD_launcher +module SEMBA_FDTD_mod USE version USE Report @@ -32,9 +32,6 @@ PROGRAM SEMBA_FDTD_launcher #endif #endif - !************************************************* - !***[conformal] ****************** - !************************************************* #ifdef CompileWithConformal USE CONFORMAL_INI_CLASS USE CONFORMAL_TOOLS @@ -43,1022 +40,1168 @@ PROGRAM SEMBA_FDTD_launcher USE Conformal_TimeSteps_m #endif use EpsMuTimeScale_m - !************************************************* - !************************************************* - !************************************************* - ! + use interpreta_switches_m use, intrinsic:: iso_fortran_env, only: stdin=>input_unit IMPLICIT NONE - ! -!!!24118 pscaling - REAL (KIND=RKIND) :: eps0,mu0,cluz -!!!241018 fin pscaling - integer (KIND=IKINDMTAG) , allocatable , dimension(:,:,:) :: sggMtag - type(taglist_t) :: tag_numbers - integer (KIND=INTEGERSIZEOFMEDIAMATRICES) , allocatable , dimension(:,:,:) :: sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz - - LOGICAL :: dummylog,finishedwithsuccess,l_auxinput, l_auxoutput, ThereArethinslots - integer (KIND=4) :: myunit,jmed - REAL (KIND=RKIND) :: maxSourceValue - ! - REAL (KIND=RKIND) :: dtantesdecorregir - integer (kind=4) :: finaltimestepantesdecorregir,NEWfinaltimestep,thefileno - TYPE (Parseador), POINTER :: parser - type (SGGFDTDINFO) :: sgg - TYPE (limit_t), DIMENSION (1:6) :: fullsize, SINPML_fullsize - ! - LOGICAL :: existe - INTEGER (KIND=4) :: status, i, field - CHARACTER (LEN=BUFSIZE) :: f, chain, chain3,chain4, chaindummy, filenombre - CHARACTER (LEN=BUFSIZE_LONG) :: slices - CHARACTER (LEN=BUFSIZE) :: whoami, whoamishort - CHARACTER (LEN=BUFSIZE) :: dubuf - integer (kind=4) :: statuse + ! should eps0 and mu0 be global variables? + + type, public :: semba_fdtd_t + type (entrada_t) :: l + TYPE (tiempo_t) :: time_comienzo + real (KIND=8) time_desdelanzamiento + integer (KIND=INTEGERSIZEOFMEDIAMATRICES) , allocatable , dimension(:,:,:) :: sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz + integer (KIND=IKINDMTAG) , allocatable , dimension(:,:,:) :: sggMtag + type (SGGFDTDINFO) :: sgg + type (limit_t), DIMENSION (1:6) :: fullsize, SINPML_fullsize + real (KIND=RKIND) :: eps0,mu0,cluz + real (KIND=RKIND) :: maxSourceValue + character (LEN=BUFSIZE) :: whoami, whoamishort +#ifdef CompileWithMTLN + type(mtln_t) :: mtln_parsed +#endif + type (taglist_t) :: tag_numbers + type (tagtype_t) :: tagtype + logical :: finishedwithsuccess - LOGICAL :: hayinput - ! - TYPE (t_NFDE_FILE), POINTER :: NFDE_FILE + contains + procedure :: init => semba_init + procedure :: launch => semba_launch + procedure :: end => semba_end + end type semba_fdtd_t + + +contains + + subroutine semba_init(this, input_flags) + class(semba_fdtd_t) :: this + character (len=*), optional :: input_flags - type (tagtype_t) :: tagtype - REAL (KIND=RKIND) :: dxmin,dymin,dzmin,dtlay + real (KIND=RKIND) :: dtantesdecorregir + real (KIND=RKIND) :: dxmin,dymin,dzmin,dtlay + logical :: dummylog,l_auxinput, l_auxoutput, ThereArethinslots + logical :: hayinput + logical :: lexis + logical :: newrotate !300124 tiramos con el rotador antiguo + + character (LEN=BUFSIZE) :: f= ' ', chain = ' ', chain3 = ' ',chain4 = ' ', chaindummy= ' ' + character (LEN=BUFSIZE_LONG) :: slices = ' ' + character (LEN=BUFSIZE) :: dubuf + character (LEN=BUFSIZE) :: buff + character (LEN=BUFSIZE) :: filename_h5bin ! File name + + integer (KIND=4) :: myunit,jmed + integer (kind=4) :: finaltimestepantesdecorregir,NEWfinaltimestep,thefileno + integer (kind=4) :: statuse + integer (KIND=4) :: status, i, field + INTEGER (KIND=4) :: verdadero_mpidir + integer (kind=4) :: my_iostat + + + type (Parseador), POINTER :: parser + type (t_NFDE_FILE), POINTER :: NFDE_FILE + type(solver_t) :: solver + #ifdef CompileWithMPI - LOGICAL :: fatalerror_aux - TYPE (XYZlimit_t), DIMENSION (1:6) :: tempalloc + LOGICAL :: fatalerror_aux + TYPE (XYZlimit_t), DIMENSION (1:6) :: tempalloc #endif - TYPE (tiempo_t) :: time_comienzo - CHARACTER (LEN=BUFSIZE) :: buff - REAL (KIND=8) time_desdelanzamiento - CHARACTER (LEN=BUFSIZE) :: filename_h5bin ! File name - !**************************************************************************** - !**************************************************************************** - !conformal existence flags ref: ##Confflag## integer (kind=4) :: conf_err #ifdef CompileWithConformal - type (conf_conflicts_t), pointer :: conf_conflicts -#endif - - !**************************************************************************** - !**************************************************************************** - !**************************************************************************** - - type (entrada_t) :: l -#ifdef CompileWithMTLN - type(mtln_t) :: mtln_parsed -#endif - logical :: lexis - integer (kind=4) :: my_iostat - - INTEGER (KIND=4) :: verdadero_mpidir - logical :: newrotate !300124 tiramos con el rotador antiguo - type(solver_t) :: solver - - newrotate=.false. !!ojo tocar luego -!!200918 !!!si se lanza con -pscal se overridea esto - Eps0= 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 - Mu0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 - cluz=1.0_RKIND/sqrt(eps0*mu0) -!!! -#ifdef CompileWithConformal - l%conformal_file_input_name=char(0); -#endif - slices = ' '; chain3 = ' ';chain4 = ' ' ;chaindummy=' ' - l%geomfile = ' '; filenombre = ' ' -!!! - l%prefix = ' ';l%fichin = ' '; f = ' '; chain = ' '; l%chain2 = ' '; l%opcionestotales = ' ' - l%nEntradaRoot = ' '; l%fileFDE = ' '; l%fileH5 = ' ' - l%prefixopci = ' '; l%prefixopci1 = ' ';l%opcionespararesumeo = ' '; l%opcionesoriginales = ' ' - l%slicesoriginales = ' '; ; l%chdummy = ' ' - l%flushsecondsFields=0.; l%flushsecondsData=0.; l%time_end=0. - l%existeNFDE=.false.; l%existeconf=.false.; l%existecmsh=.false.; l%existeh5=.false. - l%creditosyaprinteados=.false. - !activate printing through screen - CALL OnPrint - !!!!!!!!!!!! - call l%EpsMuTimeScale_input_parameters%init0() - + type (conf_conflicts_t), pointer :: conf_conflicts +#endif + ! call sleep(5) + call initEntrada(this%l) + newrotate=.false. !!ojo tocar luego + !!200918 !!!si se lanza con -pscal se overridea esto + this%eps0= 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 + this%mu0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 + this%cluz=1.0_RKIND/sqrt(this%eps0*this%mu0) + + CALL OnPrint #ifdef CompileWithMPI - CALL InitGeneralMPI (l%layoutnumber, l%size) - SUBCOMM_MPI=MPI_COMM_WORLD !default el l%stochastic es el global a menos que luego se divida + CALL InitGeneralMPI (this%l%layoutnumber, this%l%size) + SUBCOMM_MPI=MPI_COMM_WORLD !default el this%l%stochastic es el global a menos que luego se divida #else - l%size = 1 - l%layoutnumber = 0 -#endif - call setglobal(l%layoutnumber,l%size) !para crear variables globales con info MPI - - WRITE (whoamishort, '(i5)') l%layoutnumber + 1 - WRITE (whoami, '(a,i5,a,i5,a)') '(', l%layoutnumber + 1, '/', l%size, ') ' - + this%l%size = 1 + this%l%layoutnumber = 0 +#endif + call setglobal(this%l%layoutnumber,this%l%size) !para crear variables globales con info MPI + + WRITE (this%whoamishort, '(i5)') this%l%layoutnumber + 1 + WRITE (this%whoami, '(a,i5,a,i5,a)') '(', this%l%layoutnumber + 1, '/', this%l%size, ') ' + #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) #endif - call get_secnds(l%time_out2) - time_desdelanzamiento= l%time_out2%segundos + call get_secnds(this%l%time_out2) + this%time_desdelanzamiento= this%l%time_out2%segundos #ifndef keeppause - if (l%layoutnumber==0) then - OPEN (38, file='running') - write (38,*) '!END' - CLOSE (38,status='delete') - OPEN (38, file='pause') - write (38,*) '!END' - CLOSE (38,status='delete') - OPEN (38, file='relaunch') - write (38,*) '!END' - CLOSE (38,status='delete') - OPEN (38, file='forcestop') - write (38,*) '!END' - CLOSE (38,status='delete') - endif + if (this%l%layoutnumber==0) then + OPEN (38, file='running') + write (38,*) '!END' + CLOSE (38,status='delete') + OPEN (38, file='pause') + write (38,*) '!END' + CLOSE (38,status='delete') + OPEN (38, file='relaunch') + write (38,*) '!END' + CLOSE (38,status='delete') + OPEN (38, file='forcestop') + write (38,*) '!END' + CLOSE (38,status='delete') + endif #endif - if (l%layoutnumber==0) then - my_iostat=0 -3443 if(my_iostat /= 0) write(*,fmt='(a)',advance='no'), '.' - OPEN (11, file='SEMBA_FDTD_temp.log',err=3443,iostat=my_iostat,action='write') - write (11,*) '!END' - CLOSE (11,status='delete') - my_iostat=0 -3447 if(my_iostat /= 0) write(*,fmt='(a)',advance='no'), '.' !!if(my_iostat /= 0) print '(i5,a1,i4,2x,a)',3447,'.',l%layoutnumber,'SEMBA_FDTD_temp.log' - OPEN (11, file='SEMBA_FDTD_temp.log',err=3447,iostat=my_iostat,status='new',action='write') - call print_credits(l) - CLOSE (11) - endif + if (this%l%layoutnumber==0) then + my_iostat=0 + 3443 if(my_iostat /= 0) write(*,fmt='(a)',advance='no'), '.' + OPEN (11, file='SEMBA_FDTD_temp.log',err=3443,iostat=my_iostat,action='write') + write (11,*) '!END' + CLOSE (11,status='delete') + my_iostat=0 + 3447 if(my_iostat /= 0) write(*,fmt='(a)',advance='no'), '.' !!if(my_iostat /= 0) print '(i5,a1,i4,2x,a)',3447,'.',this%l%layoutnumber,'SEMBA_FDTD_temp.log' + OPEN (11, file='SEMBA_FDTD_temp.log',err=3447,iostat=my_iostat,status='new',action='write') + call print_credits(this%l) + CLOSE (11) + endif #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif -652 continue + 652 continue - CALL CLOSEWARNINGFILE(l%layoutnumber,l%size,dummylog,.false.,.false.) !aqui ya no se tiene en cuenta el l%fatalerror + CALL CLOSEWARNINGFILE(this%l%layoutnumber,this%l%size,dummylog,.false.,.false.) !aqui ya no se tiene en cuenta el this%l%fatalerror - WRITE (l%opcionespararesumeo, '(a,i4,a)') 'mpirun -n ', l%size,' ' - call default_flags(l) !set all default flags + WRITE (this%l%opcionespararesumeo, '(a,i4,a)') 'mpirun -n ', this%l%size,' ' + call default_flags(this%l) !set all default flags #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) -#endif - call get_secnds(time_comienzo) - !temporarily until later - IF (l%layoutnumber == 0) THEN - OPEN (11, file='SEMBA_FDTD_temp.log',position='append') - l%file11isopen=.true. - END IF - ! + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) +#endif + call get_secnds(this%time_comienzo) + !temporarily until later + IF (this%l%layoutnumber == 0) THEN + OPEN (11, file='SEMBA_FDTD_temp.log',position='append') + this%l%file11isopen=.true. + END IF + ! #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - !see if there is semaphore to pause continuing - INQUIRE (file='pause', EXIST=l%pausar) + !see if there is semaphore to pause continuing + INQUIRE (file='pause', EXIST=this%l%pausar) #ifdef CompileWithMPI - l%l_aux = l%pausar - CALL MPI_AllReduce (l%l_aux, l%pausar, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, l%ierr) + this%l%l_aux = this%l%pausar + CALL MPI_AllReduce (this%l%l_aux, this%l%pausar, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, this%l%ierr) #endif #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) -#endif - CALL get_secnds (l%time_out2) - l%time_begin = l%time_out2%segundos - WRITE (dubuf,*) 'Paused at ', l%time_out2%fecha(7:8), '/', l%time_out2%fecha(5:6), '/', & - & l%time_out2%fecha(1:4), ' ', l%time_out2%hora(1:2), ':', l%time_out2%hora(3:4) - IF (l%pausar) CALL print11 (l%layoutnumber, dubuf) - DO while (l%pausar) + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) +#endif + CALL get_secnds (this%l%time_out2) + this%l%time_begin = this%l%time_out2%segundos + WRITE (dubuf,*) 'Paused at ', this%l%time_out2%fecha(7:8), '/', this%l%time_out2%fecha(5:6), '/', & + & this%l%time_out2%fecha(1:4), ' ', this%l%time_out2%hora(1:2), ':', this%l%time_out2%hora(3:4) + IF (this%l%pausar) CALL print11 (this%l%layoutnumber, dubuf) + DO while (this%l%pausar) #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) #endif - CALL get_secnds (l%time_out2) - l%time_end = l%time_out2%segundos - IF (l%time_end-l%time_begin > 10.0_RKIND) THEN - INQUIRE (file='pause', EXIST=l%pausar) + CALL get_secnds (this%l%time_out2) + this%l%time_end = this%l%time_out2%segundos + IF (this%l%time_end-this%l%time_begin > 10.0_RKIND) THEN + INQUIRE (file='pause', EXIST=this%l%pausar) #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - l%l_aux = l%pausar - CALL MPI_AllReduce (l%l_aux, l%pausar, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, l%ierr) - call MPI_Barrier(SUBCOMM_MPI,l%ierr) -#endif - CALL get_secnds (l%time_out2) - l%time_begin = l%time_out2%segundos - WRITE (dubuf,*) 'Paused at ', l%time_out2%fecha(7:8), '/', l%time_out2%fecha(5:6), '/', & - & l%time_out2%fecha(1:4), ' ', l%time_out2%hora(1:2), ':', l%time_out2%hora(3:4) - IF (l%pausar) CALL print11 (l%layoutnumber, dubuf) - END IF - END DO - !fin del semaphoro + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + this%l%l_aux = this%l%pausar + CALL MPI_AllReduce (this%l%l_aux, this%l%pausar, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, this%l%ierr) + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) +#endif + CALL get_secnds (this%l%time_out2) + this%l%time_begin = this%l%time_out2%segundos + WRITE (dubuf,*) 'Paused at ', this%l%time_out2%fecha(7:8), '/', this%l%time_out2%fecha(5:6), '/', & + & this%l%time_out2%fecha(1:4), ' ', this%l%time_out2%hora(1:2), ':', this%l%time_out2%hora(3:4) + IF (this%l%pausar) CALL print11 (this%l%layoutnumber, dubuf) + END IF + END DO + !fin del semaphoro #ifdef keeppause - INQUIRE (file='forcestop', EXIST=l%forcestop) - if (l%forcestop) then - if (l%layoutnumber==0) then - OPEN (38, file='running') - write (38,*) '!END' - CLOSE (38,status='delete') - OPEN (38, file='pause') - write (38,*) '!END' - CLOSE (38,status='delete') - OPEN (38, file='relaunch') - write (38,*) '!END' - CLOSE (38,status='delete') - OPEN (38, file='forcestop') - write (38,*) '!END' - CLOSE (38,status='delete') - endif + INQUIRE (file='forcestop', EXIST=this%l%forcestop) + if (this%l%forcestop) then + if (this%l%layoutnumber==0) then + OPEN (38, file='running') + write (38,*) '!END' + CLOSE (38,status='delete') + OPEN (38, file='pause') + write (38,*) '!END' + CLOSE (38,status='delete') + OPEN (38, file='relaunch') + write (38,*) '!END' + CLOSE (38,status='delete') + OPEN (38, file='forcestop') + write (38,*) '!END' + CLOSE (38,status='delete') + endif #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - CALL MPI_FINALIZE (l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + CALL MPI_FINALIZE (this%l%ierr) #endif - STOP - endif + STOP + endif #endif #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) #endif - CALL get_secnds (l%time_out2) - ! - ! mira el command_line y el fichero launch 251022 - CALL get_command (l%chain2, l%length, status) - IF (status /= 0) then - CALL stoponerror (l%layoutnumber, l%size, 'General error',.true.); goto 652 - endif + CALL get_secnds (this%l%time_out2) + + + if (present(input_flags)) then + this%l%read_command_line = .false. + this%l%chain2 = input_flags + this%l%length = len(input_flags) + else + ! mira el command_line y el fichero launch 251022 + CALL get_command (this%l%chain2, this%l%length, status) + IF (status /= 0) then + CALL stoponerror (this%l%layoutnumber, this%l%size, 'General error',.true.); goto 652 + endif + end if - l%chain2=trim(adjustl(l%chain2)) - !concatena con lo que haya en launch - INQUIRE (file='launch', EXIST=hayinput) - if (hayinput) then - OPEN (9, file='launch', FORM='formatted',action='read') - READ (9, '(a)') chain3 - chain3=trim(adjustl(chain3)) - CLOSE (9) - print *,'----> launch input file '//trim(adjustl(chain3)) - endif + this%l%chain2=trim(adjustl(this%l%chain2)) + !concatena con lo que haya en launch + INQUIRE (file='launch', EXIST=hayinput) + if (hayinput) then + OPEN (9, file='launch', FORM='formatted',action='read') + READ (9, '(a)') chain3 + chain3=trim(adjustl(chain3)) + CLOSE (9) + print *,'----> launch input file '//trim(adjustl(chain3)) + endif #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - l%chain2=trim(adjustl(l%chain2))//' '//trim(adjustl(chain3)) + this%l%chain2=trim(adjustl(this%l%chain2))//' '//trim(adjustl(chain3)) - call buscaswitchficheroinput(l) - + call buscaswitchficheroinput(this%l) + - IF (status /= 0) then - CALL stoponerror (l%layoutnumber, l%size, 'Error in searching input file. Correct and remove pause file',.true.); goto 652 - endif -!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!! - call print_credits(l) - if (trim(adjustl(l%extension))=='.nfde') then + IF (status /= 0) then + CALL stoponerror (this%l%layoutnumber, this%l%size, 'Error in searching input file. Correct and remove pause file',.true.); goto 652 + endif + !!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!! + call print_credits(this%l) + if (trim(adjustl(this%l%extension))=='.nfde') then #ifdef CompilePrivateVersion - call cargaNFDE(l%filefde,parser) + call cargaNFDE(this%l%filefde,parser) #else - print *,'Not compiled with cargaNFDEINDEX' - stop + print *,'Not compiled with cargaNFDEINDEX' + stop #endif #ifdef CompileWithSMBJSON - elseif (trim(adjustl(l%extension))=='.json') then - call cargaFDTDJSON(l%fichin, parser) + elseif (trim(adjustl(this%l%extension))=='.json') then + call cargaFDTDJSON(this%l%fichin, parser) #endif - else - print *, 'Neither .nfde nor .json files used as input after -i' - stop - endif - + else + print *, 'Neither .nfde nor .json files used as input after -i' + stop + endif + -!!!!!!!!!!!!!!!!!!!!!!! - sgg%extraswitches=parser%switches -!!!da preferencia a los switches por linea de comando - CALL getcommandargument (l%chain2, 1, chaindummy, l%length, statuse) + this%sgg%extraswitches=parser%switches + !!!da preferencia a los switches por linea de comando + CALL getcommandargument (this%l%chain2, 1, chaindummy, this%l%length, statuse, getBinaryPath()) - l%chain2=trim(adjustl(l%chain2)) - chaindummy=trim(adjustl(chaindummy)) - l%length=len(trim(adjustl(chaindummy))) - l%chain2=trim(adjustl(chaindummy))//' '//trim(adjustl(sgg%extraswitches))//' '//trim(adjustl(l%chain2(l%length+1:))) - l%chaininput=trim(adjustl(l%chain2)) -!!!! - + this%l%chain2=trim(adjustl(this%l%chain2)) + chaindummy=trim(adjustl(chaindummy)) + this%l%length=len(trim(adjustl(chaindummy))) + this%l%chain2=trim(adjustl(chaindummy))//' '//trim(adjustl(this%sgg%extraswitches))//' '//trim(adjustl(this%l%chain2(this%l%length+1:))) + this%l%chaininput=trim(adjustl(this%l%chain2)) + !!!! + - call interpreta(l,status ) - sgg%nEntradaRoot=trim (adjustl(l%nEntradaRoot)) + call interpreta(this%l,status ) + this%sgg%nEntradaRoot=trim (adjustl(this%l%nEntradaRoot)) #ifdef CompileWithMTLN - if (parser%general%mtlnProblem) then - call solver%launch_mtln_simulation(parser%mtln, l%nEntradaRoot, l%layoutnumber) - STOP - end if + if (parser%general%mtlnProblem) then + call solver%launch_mtln_simulation(parser%mtln, this%l%nEntradaRoot, this%l%layoutnumber) + STOP + end if #endif #ifdef CompileWithHDF - if (l%createh5filefromsinglebin) then - if (l%layoutnumber==0) then - inquire(file=trim(adjustl(sgg%nEntradaRoot))//'_h5bin.txt',exist=lexis) - if (.not.lexis) goto 9083 - open(newunit=myunit,file=trim(adjustl(sgg%nEntradaRoot))//'_h5bin.txt',form='formatted',err=9083) !lista de todos los .h5bin - do - read (myunit,'(a)',end=84552) filename_h5bin - call createh5filefromsinglebin(filename_h5bin,l%vtkindex) - print *, 'Processed '//trim(adjustl(filename_h5bin)) - end do -84552 close(myunit) - print *, 'END: SUCCESS creating '//trim(adjustl(sgg%nEntradaRoot))//'_h5bin.txt' - stop -9083 CALL stoponerror (0, l%size, 'Invalid _h5bin.txt file',.true.); statuse=-1; !return - endif + !!!!tunel a lo bestia para crear el .h5 a 021219 + if (this%l%createh5filefromsinglebin) then + if (this%l%layoutnumber==0) then + inquire(file=trim(adjustl(this%sgg%nEntradaRoot))//'_h5bin.txt',exist=lexis) + if (.not.lexis) goto 9083 + open(newunit=myunit,file=trim(adjustl(this%sgg%nEntradaRoot))//'_h5bin.txt',form='formatted',err=9083) !lista de todos los .h5bin + do + read (myunit,'(a)',end=84552) filename_h5bin + call createh5filefromsinglebin(filename_h5bin,this%l%vtkindex) + print *, 'Processed '//trim(adjustl(filename_h5bin)) + end do + 84552 close(myunit) + print *, 'END: SUCCESS creating '//trim(adjustl(this%sgg%nEntradaRoot))//'_h5bin.txt' + stop + 9083 CALL stoponerror (0, this%l%size, 'Invalid _h5bin.txt file',.true.); statuse=-1; !return + endif #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - stop - endif + stop + endif #endif - IF (status /= 0) then - call print11(l%layoutnumber,'Remove running and pause files. If error persists check switches for error. '//l%chain2,.true.) - call print11(l%layoutnumber,' '); call print11(l%layoutnumber,' '); call print11(l%layoutnumber,' '); call print11(l%layoutnumber,' '); call print11(l%layoutnumber,' '); call print11(l%layoutnumber,' '); goto 652 - endif -!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!! - - call set_priorities(l%prioritizeCOMPOoverPEC,l%prioritizeISOTROPICBODYoverall,l%prioritizeTHINWIRE) !!! asigna las prioridades - if (l%finaltimestep /= -2) then - ! nfde part - CALL print11 (l%layoutnumber, 'INIT conversion internal ASCII => Binary') - CALL print11 (l%layoutnumber, SEPARADOR//SEPARADOR//SEPARADOR) - - CALL print11 (l%layoutnumber, SEPARADOR//SEPARADOR//SEPARADOR) - !!!!!!!!!!!!!!!!!!!!!! - call NFDE2sgg - l%fatalerror=l%fatalerror.or.l%fatalerrornfde2sgg - !!!!!!!!!!!!!!!!!!!!! + IF (status /= 0) then + call print11(this%l%layoutnumber,'Remove running and pause files. If error persists check switches for error. '//this%l%chain2,.true.) + call print11(this%l%layoutnumber,' '); call print11(this%l%layoutnumber,' '); call print11(this%l%layoutnumber,' '); call print11(this%l%layoutnumber,' '); call print11(this%l%layoutnumber,' '); call print11(this%l%layoutnumber,' '); goto 652 + endif + + call set_priorities(this%l%prioritizeCOMPOoverPEC,this%l%prioritizeISOTROPICBODYoverall,this%l%prioritizeTHINWIRE) !!! asigna las prioridades + if (this%l%finaltimestep /= -2) then + ! nfde part + CALL print11 (this%l%layoutnumber, 'INIT conversion internal ASCII => Binary') + CALL print11 (this%l%layoutnumber, SEPARADOR//SEPARADOR//SEPARADOR) + + CALL print11 (this%l%layoutnumber, SEPARADOR//SEPARADOR//SEPARADOR) + !!!!!!!!!!!!!!!!!!!!!! + call NFDE2sgg + this%l%fatalerror=this%l%fatalerror.or.this%l%fatalerrornfde2sgg + !!!!!!!!!!!!!!!!!!!!! #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - CALL print11 (l%layoutnumber, '[OK] Ended conversion internal ASCII => Binary') - !release memory created by newPARSER - if (l%fatalerror) then - if (allocated(sggMiEx)) deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,sggMtag) - CALL stoponerror (l%layoutnumber, l%size, 'Error in .nfde file syntax. Check all *Warnings* and *tmpWarnings* files, correct and remove pause file if any',.true.); goto 652 - endif + CALL print11 (this%l%layoutnumber, '[OK] Ended conversion internal ASCII => Binary') + !release memory created by newPARSER + if (this%l%fatalerror) then + if (allocated(this%sggMiEx)) deallocate (this%sggMiEx, this%sggMiEy, this%sggMiEz,this%sggMiHx, this%sggMiHy, this%sggMiHz,this%sggMiNo,this%sggMtag) + CALL stoponerror (this%l%layoutnumber, this%l%size, 'Error in .nfde file syntax. Check all *Warnings* and *tmpWarnings* files, correct and remove pause file if any',.true.); goto 652 + endif - !************************************************************************* - !***[conformal] ****************************************** - !************************************************************************* - !conformal conformal ini ref: ##Confini## + !************************************************************************* + !***[conformal] ****************************************** + !************************************************************************* + !conformal conformal ini ref: ##Confini## #ifdef CompileWithConformal - if (l%input_conformal_flag) then - - !md notes: - ![1] Todos los procesos parsean el archivo -conf completo. - ![2] El parseador es INDEPENDIENTE de del resto del problema (dimensiones, - ! particion MPI, ... ) - ![3] Posteriormente conf_mesh obtenido por el parseador sera tratado por cada - ! proceso atendiedo al resto del porblema y la particion MPI - - conf_parameter%output_file_report_id = 47; - !...................................................................... - write(dubuf,*) 'Init Searching for Conformal Mesh ...'; call print11(l%layoutnumber,dubuf) + if (this%l%input_conformal_flag) then + + !md notes: + ![1] Todos los procesos parsean el archivo -conf completo. + ![2] El parseador es INDEPENDIENTE de del resto del problema (dimensiones, + ! particion MPI, ... ) + ![3] Posteriormente conf_mesh obtenido por el parseador sera tratado por cada + ! proceso atendiedo al resto del porblema y la particion MPI + + conf_parameter%output_file_report_id = 47; + !...................................................................... + write(dubuf,*) 'Init Searching for Conformal Mesh ...'; call print11(this%l%layoutnumber,dubuf) #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - CALL conformal_ini (TRIM(l%conformal_file_input_name),trim(l%fileFDE),parser,& - &sgg, sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,l%run_with_abrezanjas,& - &fullsize,l%layoutnumber,l%mpidir, l%input_conformal_flag,conf_err,l%verbose) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + CALL conformal_ini (TRIM(this%l%conformal_file_input_name),trim(this%l%fileFDE),parser,& + &this%sgg, this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,this%l%run_with_abrezanjas,& + &this%fullsize,this%l%layoutnumber,this%l%mpidir, this%l%input_conformal_flag,conf_err,this%l%verbose) #endif - !...................................................................... + !...................................................................... #ifndef CompileWithMPI - !CALL conformal_ini (TRIM(l%conformal_file_input_name),trim(l%fileFDE),sgg,fullsize,0,conf_err,l%verbose) - CALL conformal_ini (TRIM(l%conformal_file_input_name),trim(l%fileFDE),parser,& - &sgg, sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,& - &l%run_with_abrezanjas,fullsize,0,l%mpidir,l%input_conformal_flag,conf_err,l%verbose) + !CALL conformal_ini (TRIM(this%l%conformal_file_input_name),trim(this%l%fileFDE),sgg,fullsize,0,conf_err,this%l%verbose) + CALL conformal_ini (TRIM(this%l%conformal_file_input_name),trim(this%l%fileFDE),parser,& + &this%sgg, this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,& + &this%l%run_with_abrezanjas,this%fullsize,0,this%l%mpidir,this%l%input_conformal_flag,conf_err,this%l%verbose) #endif - if(conf_err/=0)then - call WarnErrReport(Trim(buff),.true.) - end if + if(conf_err/=0)then + call WarnErrReport(Trim(buff),.true.) + end if #ifdef CompilePrivateVersion - if (trim(adjustl(l%extension))=='.nfde') then - CALL Destroy_Parser (parser) - DEALLOCATE (NFDE_FILE%lineas) - DEALLOCATE (NFDE_FILE) - nullify (NFDE_FILE) - endif + if (trim(adjustl(this%l%extension))=='.nfde') then + CALL Destroy_Parser (parser) + DEALLOCATE (NFDE_FILE%lineas) + DEALLOCATE (NFDE_FILE) + nullify (NFDE_FILE) + endif #endif - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!! #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - l_auxinput = l%input_conformal_flag - call MPI_Barrier(SUBCOMM_MPI,l%ierr) - call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, l%ierr) - l%input_conformal_flag = l_auxoutput -#endif - !...................................................................... + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + l_auxinput = this%l%input_conformal_flag + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, this%l%ierr) + this%l%input_conformal_flag = l_auxoutput +#endif + !...................................................................... #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - if (l%resume.and.l%flag_conf_sgg) then - CALL stoponerror (l%layoutnumber, l%size, 'l%resume -r currently unsupported by conformal solver',.true.); statuse=-1; !return - end if - if (l%input_conformal_flag.and.l%flag_conf_sgg) then - write(dubuf,*) '----> Conformal Mesh found'; call print11(l%layoutnumber,dubuf) - else - write(dubuf,*) '----> No Conformal Mesh found'; call print11(l%layoutnumber,dubuf) - endif - end if !FIN DEL: if (l%input_conformal_flag) then - + if (this%l%resume.and.this%l%flag_conf_sgg) then + CALL stoponerror (this%l%layoutnumber, this%l%size, 'this%l%resume -r currently unsupported by conformal solver',.true.); statuse=-1; !return + end if + if (this%l%input_conformal_flag.and.this%l%flag_conf_sgg) then + write(dubuf,*) '----> Conformal Mesh found'; call print11(this%l%layoutnumber,dubuf) + else + write(dubuf,*) '----> No Conformal Mesh found'; call print11(this%l%layoutnumber,dubuf) + endif + end if !FIN DEL: if (this%l%input_conformal_flag) then + #endif - !************************************************************************* - !************************************************************************* - !************************************************************************* + !************************************************************************* + !************************************************************************* + !************************************************************************* #ifdef CompileWithConformal - !************************************************************************* - !***[conformal] ****************************************** - !************************************************************************* - !conformal mapped reff: ##Confmapped## - - !call creamatricesdedibujoencadaslabmpi(sgg%alloc(iEx)%XI,....,sgg%Sweep(iEx)%...) - - if (l%input_conformal_flag) then - write(dubuf,*) '----> l%input_conformal_flag True and init'; call print11(l%layoutnumber,dubuf) - call conf_geometry_mapped_for_UGRDTD (& - &conf_conflicts, & - &sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & - &fullsize, SINPML_fullsize,l%layoutnumber,conf_err,l%verbose); - !call conf_geometry_mapped_for_UGRDTD (sgg, fullsize, SINPML_fullsize,l%layoutnumber,conf_err,l%verbose); //refactor JUL15 - if(conf_err==0)then - else - buff=''; buff = 'Program aborted.'; - call WarnErrReport(Trim(buff),.true.) + !************************************************************************* + !***[conformal] ****************************************** + !************************************************************************* + !conformal mapped reff: ##Confmapped## + + !call creamatricesdedibujoencadaslabmpi(sgg%alloc(iEx)%XI,....,sgg%Sweep(iEx)%...) + + if (this%l%input_conformal_flag) then + write(dubuf,*) '----> this%l%input_conformal_flag True and init'; call print11(this%l%layoutnumber,dubuf) + call conf_geometry_mapped_for_UGRDTD (& + &conf_conflicts, & + &this%sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz, & + &this%fullsize, this%SINPML_fullsize,this%l%layoutnumber,conf_err,this%l%verbose); + !call conf_geometry_mapped_for_UGRDTD (sgg, fullsize, this%SINPML_fullsize,this%l%layoutnumber,conf_err,this%l%verbose); //refactor JUL15 + if(conf_err==0)then + else + buff=''; buff = 'Program aborted.'; + call WarnErrReport(Trim(buff),.true.) + end if + write(dubuf,*) '----> this%l%input_conformal_flag True and exit'; call print11(this%l%layoutnumber,dubuf) end if - write(dubuf,*) '----> l%input_conformal_flag True and exit'; call print11(l%layoutnumber,dubuf) - end if #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - !************************************************************************* - !************************************************************************* - !************************************************************************* + !************************************************************************* + !************************************************************************* + !************************************************************************* #endif - if (allocated(sggMiEx)) then !para el l%skindepthpre no se allocatea nada + if (allocated(this%sggMiEx)) then !para el this%l%skindepthpre no se allocatea nada #ifdef CompileWithConformal - call AssigLossyOrPECtoNodes(sgg,sggMiNo,sggMiEx,sggMiEy,sggMiEz,& - &conf_conflicts,l%input_conformal_flag) + call AssigLossyOrPECtoNodes(this%sgg,this%sggMiNo,this%sggMiEx,this%sggMiEy,this%sggMiEz,& + &conf_conflicts,this%l%input_conformal_flag) #else - call AssigLossyOrPECtoNodes(sgg,sggMiNo,sggMiEx,sggMiEy,sggMiEz) + call AssigLossyOrPECtoNodes(this%sgg,this%sggMiNo,this%sggMiEx,this%sggMiEy,this%sggMiEz) #endif - IF (l%createmap) CALL store_geomData (sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, l%geomfile) - endif - ! + IF (this%l%createmap) CALL store_geomData (this%sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz, this%l%geomfile) + endif + ! #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - endif - write(dubuf,*) '[OK] Ended Conformal Mesh'; call print11(l%layoutnumber,dubuf) - if (l%finaltimestep==0) l%finaltimestep=sgg%TimeSteps !no quitar - IF (l%forcesteps) then - sgg%TimeSteps = l%finaltimestep - else - l%finaltimestep = sgg%TimeSteps - endif - IF (.not.l%forcesteps) then - finaltimestepantesdecorregir=l%finaltimestep - l%finaltimestep=int(dtantesdecorregir/sgg%dt*finaltimestepantesdecorregir) + endif + write(dubuf,*) '[OK] Ended Conformal Mesh'; call print11(this%l%layoutnumber,dubuf) + if (this%l%finaltimestep==0) this%l%finaltimestep=this%sgg%TimeSteps !no quitar + IF (this%l%forcesteps) then + this%sgg%TimeSteps = this%l%finaltimestep + else + this%l%finaltimestep = this%sgg%TimeSteps + endif + IF (.not.this%l%forcesteps) then + finaltimestepantesdecorregir=this%l%finaltimestep + this%l%finaltimestep=int(dtantesdecorregir/this%sgg%dt*finaltimestepantesdecorregir) #ifdef CompileWithMPI - call MPI_AllReduce( l%finaltimestep, NEWfinaltimestep, 1_4, MPI_INTEGER, MPI_MAX, SUBCOMM_MPI, l%ierr) - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - l%finaltimestep=NEWfinaltimestep -#endif - if (finaltimestepantesdecorregir/=l%finaltimestep) then - write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) - write(dubuf,*) 'Original Final Time Step= ',finaltimestepantesdecorregir - if (l%layoutnumber==0) call print11(l%layoutnumber,dubuf) - write(dubuf,*) 'Corrected Final Time Step= ',l%finaltimestep - if (l%layoutnumber==0) call print11(l%layoutnumber,dubuf) - endif - endif - !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 + call MPI_AllReduce( this%l%finaltimestep, NEWfinaltimestep, 1_4, MPI_INTEGER, MPI_MAX, SUBCOMM_MPI, this%l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + this%l%finaltimestep=NEWfinaltimestep +#endif + if (finaltimestepantesdecorregir/=this%l%finaltimestep) then + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) 'Original Final Time Step= ',finaltimestepantesdecorregir + if (this%l%layoutnumber==0) call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) 'Corrected Final Time Step= ',this%l%finaltimestep + if (this%l%layoutnumber==0) call print11(this%l%layoutnumber,dubuf) + endif + endif + !check that simulation can actually be done for the kind of media requested + DO i = 1, this%sgg%nummedia + IF (this%sgg%Med(i)%Is%ThinWire) THEN #ifndef CompileWithBerengerWires - if ((l%wiresflavor=='berenger')) then - CALL stoponerror (l%layoutnumber, l%size, 'Berenger Wires without support. Recompile!') - endif + if ((this%l%wiresflavor=='berenger')) then + CALL stoponerror (this%l%layoutnumber, this%l%size, 'Berenger Wires without support. Recompile!') + endif #endif #ifndef CompileWithSlantedWires - if ((l%wiresflavor=='slanted').or.(l%wiresflavor=='semistructured')) then - CALL stoponerror (l%layoutnumber, l%size, 'slanted Wires without support. Recompile!') - endif + if ((this%l%wiresflavor=='slanted').or.(this%l%wiresflavor=='semistructured')) then + CALL stoponerror (this%l%layoutnumber, this%l%size, 'slanted Wires without support. Recompile!') + endif #endif - CONTINUE - END IF - ! - IF ((sgg%Med(i)%Is%AnisMultiport) .OR. (sgg%Med(i)%Is%multiport).OR. (sgg%Med(i)%Is%SGBC)) THEN + CONTINUE + END IF + ! + IF ((this%sgg%Med(i)%Is%AnisMultiport) .OR. (this%sgg%Med(i)%Is%multiport).OR. (this%sgg%Med(i)%Is%SGBC)) THEN #ifndef CompileWithNIBC - if (l%mibc) CALL stoponerror (l%layoutnumber, l%size, 'l%mibc Multiports without support. Recompile!') + if (this%l%mibc) CALL stoponerror (this%l%layoutnumber, this%l%size, 'this%l%mibc Multiports without support. Recompile!') #endif - CONTINUE - END IF -!altair no conformal sgbc 201119 + CONTINUE + END IF + !altair no conformal sgbc 201119 #ifdef NoConformalSGBC - IF (sgg%Med(i)%Is%sgbc .and. l%input_conformal_flag) THEN - CALL stoponerror (l%layoutnumber, l%size, 'Conformal sgbc not allowed. ') - END IF + IF (this%sgg%Med(i)%Is%sgbc .and. this%l%input_conformal_flag) THEN + CALL stoponerror (this%l%layoutnumber, this%l%size, 'Conformal sgbc not allowed. ') + END IF #endif -! - END DO - - - IF (l%thereare_stoch.and.(.not.l%chosenyesornostochastic)) THEN - CALL stoponerror (l%layoutnumber, l%size, '!STOCH found in .nfde. Specify either -stoch or -nostoch') - END IF + ! + END DO + + + IF (this%l%thereare_stoch.and.(.not.this%l%chosenyesornostochastic)) THEN + CALL stoponerror (this%l%layoutnumber, this%l%size, '!STOCH found in .nfde. Specify either -stoch or -nostoch') + END IF #ifndef CompileWithSlantedWires - IF (l%hay_slanted_wires) THEN - CALL stoponerror (l%layoutnumber, l%size, 'slanted wires without slanted support. Recompile ()') - END IF + IF (this%l%hay_slanted_wires) THEN + CALL stoponerror (this%l%layoutnumber, this%l%size, 'slanted wires without slanted support. Recompile ()') + END IF #endif - IF (l%hay_slanted_wires .AND. ((trim(adjustl(l%wiresflavor))/='slanted').AND.(trim(adjustl(l%wiresflavor))/='semistructured'))) THEN - CALL stoponerror (l%layoutnumber, l%size, 'slanted wires require -l%wiresflavor Slanted/semistructured') - endif + IF (this%l%hay_slanted_wires .AND. ((trim(adjustl(this%l%wiresflavor))/='slanted').AND.(trim(adjustl(this%l%wiresflavor))/='semistructured'))) THEN + CALL stoponerror (this%l%layoutnumber, this%l%size, 'slanted wires require -this%l%wiresflavor Slanted/semistructured') + endif - - !Error abrezanjas y no l%resume conformal - ThereArethinslots=.FALSE. - do jmed=1,sgg%NumMedia - if (sgg%Med(jmed)%Is%ThinSlot) ThereArethinslots=.true. - end do - if (l%resume.and.l%run_with_abrezanjas.and.ThereArethinslots) then - CALL stoponerror (l%layoutnumber, l%size, 'l%resume -r currently unsupported by conformal solver',.true.); statuse=-1; !return - end if - ! -!!!SOME FINAL REPORTING - - if (l%layoutnumber==0) then - WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR - CALL print11 (l%layoutnumber, dubuf) - CALL print11 (l%layoutnumber, 'Solver launched with options:') - write(dubuf,*) l%mibc - CALL print11 (l%layoutnumber, '---> l%mibc solver for NIBC multilayer: '//trim(adjustl(dubuf))) - write(dubuf,*) l%ade - CALL print11 (l%layoutnumber, '---> l%ade solver for ADC multilayer: '//trim(adjustl(dubuf))) - Write(dubuf,*) l%sgbc - CALL print11 (l%layoutnumber, '---> sgbc solver for multilayer: '//trim(adjustl(dubuf))) - if (l%sgbc) then - write(dubuf,*) l%sgbcDispersive - CALL print11 (l%layoutnumber, '---> sgbc DISPERSIVE solver for multilayer: '//trim(adjustl(dubuf))) - write(dubuf,*) l%sgbccrank - CALL print11 (l%layoutnumber, '---> sgbc Crank-Nicolson solver for multilayer: '//trim(adjustl(dubuf))) - write(dubuf,*) l%sgbcdepth - CALL print11 (l%layoutnumber, '---> sgbc Depth: '//trim(adjustl(dubuf))) - write(dubuf,*) l%sgbcfreq - CALL print11 (l%layoutnumber, '---> sgbc Freq: '//trim(adjustl(dubuf))) - write(dubuf,*) l%sgbcresol - CALL print11 (l%layoutnumber, '---> sgbc Resol: '//trim(adjustl(dubuf))) - endif - write(dubuf,*) l%skindepthpre - CALL print11 (l%layoutnumber, '---> l%skindepthpre preprocessing for multilayer: '//trim(adjustl(dubuf))) - write(dubuf,*) l%flag_conf_sgg - CALL print11 (l%layoutnumber, '---> Conformal file external: '//trim(adjustl(dubuf))) - write(dubuf,*) l%input_conformal_flag - CALL print11 (l%layoutnumber, '---> Conformal solver: '//trim(adjustl(dubuf))) - write(dubuf,*) l%run_with_abrezanjas - CALL print11 (l%layoutnumber, '---> Conformal thin-gap solver: '//trim(adjustl(dubuf))) - write(dubuf,*) l%run_with_dmma - CALL print11 (l%layoutnumber, '---> DMMA thin-gap solver: '//trim(adjustl(dubuf))) - write(dubuf,'(a)') l%wiresflavor - CALL print11 (l%layoutnumber, '---> Wire model: '//trim(adjustl(dubuf))) - write(dubuf,'(a)') l%inductance_model - CALL print11 (l%layoutnumber, '---> Inductance model: '//trim(adjustl(dubuf))) - if (trim(adjustl(l%wiresflavor))=='berenger') then - write(dubuf,*) l%mindistwires - CALL print11 (l%layoutnumber, '---> Berenger minimum distance between wires: '//trim(adjustl(dubuf))) - write(dubuf,*) l%mtlnberenger - CALL print11 (l%layoutnumber, '---> Berenger -l%mtlnberenger MTLN switch: '//trim(adjustl(dubuf))) - endif - if (trim(adjustl(l%wiresflavor))=='holland') then - write(dubuf,*) l%stableradholland - CALL print11 (l%layoutnumber, '---> Holland -l%stableradholland automatic correction switch: '//trim(adjustl(dubuf))) - endif - write(dubuf,*) l%TAPARRABOS - CALL print11 (l%layoutnumber, '---> Thin-wire double-tails removed: '//trim(adjustl(dubuf))) - write(dubuf,*) l%fieldtotl - CALL print11 (l%layoutnumber, '---> Thin-wire -l%fieldtotl experimental switch: '//trim(adjustl(dubuf))) - WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR - CALL print11 (l%layoutnumber, dubuf) - endif - - IF (l%layoutnumber == 0) THEN - call erasesignalingfiles(l%simu_devia) - endif - - if (l%layoutnumber==0) then - - open(newunit=thefileno,FILE = trim(adjustl(l%nEntradaRoot))//'_tag_paraviewfilters.txt') - write(thefileno,'(a)') trim(adjustl('### FOR SLICE CURRENT VTK PROBES select the "current_t" or "current_f" ')) - write(thefileno,'(a)') trim(adjustl('### FOR MAP VTK PROBES select the "mediatype" layer ')) - write(thefileno,'(a)') trim(adjustl('### For Paraview versions over 5.10 just use the Threshold exisiting filter to select the interval')) - write(thefileno,'(a)') trim(adjustl('### ######################')) - write(thefileno,'(a)') trim(adjustl('### For Paraview versions under 5.10 Copy and paste the next as a programmable filter to select only one interval of tags')) - write(thefileno,'(a)') trim(adjustl('import vtk ')) - write(thefileno,'(a)') trim(adjustl('inp = self.GetInputDataObject(0, 0) ')) - write(thefileno,'(a)') trim(adjustl('outp = self.GetOutputDataObject(0) ')) - write(thefileno,'(a)') trim(adjustl('thresh = vtk.vtkThreshold() ')) - write(thefileno,'(a)') trim(adjustl('thresh.SetInputData(inp) ')) - write(thefileno,'(a)') trim(adjustl('thresh.SetInputArrayToProcess(0, 0, 0,vtk.vtkDataObject.FIELD_ASSOCIATION_CELLS, "tagnumber") ')) - write(thefileno,'(a)') trim(adjustl('thresh.ThresholdBetween(64,127) ')) - write(thefileno,'(a)') trim(adjustl('thresh.Update() ')) - write(thefileno,'(a)') trim(adjustl('outp.ShallowCopy(thresh.GetOutput()) ')) - write(thefileno,'(a)') trim(adjustl( '# Replace the thresh.ThresholdBetween numbers by tag intervals below to filter by tags ')) - write(thefileno,'(a)') '# ( -1e21 , -1e-3 ) '//trim(adjustl('Candidates for undesired free-space slots')) - write(thefileno,'(a,i9,a,i9,a)') '# ( 0 , 63 ) '//trim(adjustl('Nodal sources, etc.')) - do i=1,tagtype%numertags - write(thefileno,'(a,i9,a,i9,a)') '# (',i*64,' , ',i*64+63,') '//trim(adjustl(tagtype%tag(i))) !los shifteo 6 bits y les sumo 2**campo ! idea de los 3 bits de 151020 - end do - !! - write(thefileno,'(a)') trim(adjustl( '### ')) - write(thefileno,'(a)') trim(adjustl( '### ')) - write(thefileno,'(a)') trim(adjustl( '### FOR MAP VTK PROBES select the "mediatype" layer ')) - write(thefileno,'(a)') trim(adjustl( '### For Paraview versions over 5.10 just use the Threshold exisiting filter to select the interval')) - write(thefileno,'(a)') trim(adjustl( '### ######################')) - write(thefileno,'(a)') trim(adjustl( '### For Paraview versions under 5.10Copy and paste the next as a programmable filter to select only one types of media')) - write(thefileno,'(a)') trim(adjustl( 'import vtk ')) - write(thefileno,'(a)') trim(adjustl( 'inp = self.GetInputDataObject(0, 0) ')) - write(thefileno,'(a)') trim(adjustl( 'outp = self.GetOutputDataObject(0) ')) - write(thefileno,'(a)') trim(adjustl( 'thresh = vtk.vtkThreshold() ')) - write(thefileno,'(a)') trim(adjustl( 'thresh.SetInputData(inp) ')) - write(thefileno,'(a)') trim(adjustl( 'thresh.SetInputArrayToProcess(0, 0, 0,vtk.vtkDataObject.FIELD_ASSOCIATION_CELLS, "mediatype") ')) - write(thefileno,'(a)') trim(adjustl( 'thresh.ThresholdBetween(0.0,0.5) ')) - write(thefileno,'(a)') trim(adjustl( 'thresh.Update() ')) - write(thefileno,'(a)') trim(adjustl( 'outp.ShallowCopy(thresh.GetOutput()) ')) - write(thefileno,'(a)') trim(adjustl( '# Replace the thresh.ThresholdBetween numbers by media types below to filter by media types ')) - write(thefileno,'(a)') '# ( -100 , -100 ) '//trim(adjustl('Candidates for undesired free-space slots (Surface)')) - write(thefileno,'(a)') '# ( 0.0 , 0.0 ) '//trim(adjustl('PEC (Surface)')) - write(thefileno,'(a)') '# ( 0.5 , 0.5 ) '//trim(adjustl('PEC (Line)')) - write(thefileno,'(a)') '# ( 1.5 , 1.5 ) '//trim(adjustl('Dispersive electric or magnetic isotropic or anisotropic (Line)')) - write(thefileno,'(a)') '# ( 100 , 199 ) '//trim(adjustl('Dispersive electric/magnetic isotropic/anisotropic (+indexmedium) (Surface) ')) - write(thefileno,'(a)') '# ( 2.5 , 2.5 ) '//trim(adjustl('Dielectric isotropic or anisotropic (Line)')) - write(thefileno,'(a)') '# ( 200 , 299 ) '//trim(adjustl('Dielectric isotropic or anisotropic (+indexmedium) (Surface)')) - write(thefileno,'(a)') '# ( 3.5 , 3.5 ) '//trim(adjustl('sgbc/l%mibc Isotropic/anisotropic Multiport (Line)')) - write(thefileno,'(a)') '# ( 300 , 399 ) '//trim(adjustl('sgbc/l%mibc Isotropic/anisotropic Multiport (+indexmedium) (Surface)')) - write(thefileno,'(a)') '# ( 4.5 , 4.5 ) '//trim(adjustl('Thin slot (Line)')) - write(thefileno,'(a)') '# ( 5.0 , 5.0 ) '//trim(adjustl('Already_YEEadvanced_byconformal (Surface)')) - write(thefileno,'(a)') '# ( 5.5 , 5.5 ) '//trim(adjustl('Already_YEEadvanced_byconformal (Line)')) - write(thefileno,'(a)') '# ( 6.0 , 6.0 ) '//trim(adjustl('Split_and_useless (Surface)')) - write(thefileno,'(a)') '# ( 6.5 , 6.5 ) '//trim(adjustl('Split_and_useless (Line)')) - write(thefileno,'(a)') '# ( 7.0 , 7.0 ) '//trim(adjustl('Edge Not colliding thin wires (Line)')) - write(thefileno,'(a)') '# ( 8.0 , 8.0 ) '//trim(adjustl('Thin wire segments colliding with structure (Line)')) - write(thefileno,'(a)') '# ( 8.5 , 8.5 ) '//trim(adjustl('Soft/Hard Nodal CURRENT/FIELD ELECTRIC DENSITY SOURCE (Line)')) - write(thefileno,'(a)') '# ( 9.0 , 9.0 ) '//trim(adjustl('Soft/Hard Nodal CURRENT/FIELD MAGNETIC DENSITY SOURCE (Line)')) - write(thefileno,'(a)') '# ( 10 , 11 ) '//trim(adjustl('LeftEnd/RightEnd/Ending wire segment (Wire)')) - write(thefileno,'(a)') '# ( 20 , 20 ) '//trim(adjustl('Intermediate wire segment +number_holland_parallel or +number_berenger (Wire) ')) - write(thefileno,'(a)') '# ( 400 , 499 ) '//trim(adjustl('Thin slot (+indexmedium) (Surface)')) - write(thefileno,'(a)') '# ( -0.5 , -0.5 ) '//trim(adjustl('Other types of media (Line)')) - write(thefileno,'(a)') '# ( -1.0 , -1.0 ) '//trim(adjustl('Other types of media (Surface)')) - close(thefileno) - endif - - ! call each simulation !ojo que los layoutnumbers empiezan en 0 - IF (l%finaltimestep /= 0) THEN + + !Error abrezanjas y no this%l%resume conformal + ThereArethinslots=.FALSE. + do jmed=1,this%sgg%NumMedia + if (this%sgg%Med(jmed)%Is%ThinSlot) ThereArethinslots=.true. + end do + if (this%l%resume.and.this%l%run_with_abrezanjas.and.ThereArethinslots) then + CALL stoponerror (this%l%layoutnumber, this%l%size, 'this%l%resume -r currently unsupported by conformal solver',.true.); statuse=-1; !return + end if + ! + !!!SOME FINAL REPORTING + + if (this%l%layoutnumber==0) then + WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR + CALL print11 (this%l%layoutnumber, dubuf) + CALL print11 (this%l%layoutnumber, 'Solver launched with options:') + write(dubuf,*) this%l%mibc + CALL print11 (this%l%layoutnumber, '---> this%l%mibc solver for NIBC multilayer: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%ade + CALL print11 (this%l%layoutnumber, '---> this%l%ade solver for ADC multilayer: '//trim(adjustl(dubuf))) + Write(dubuf,*) this%l%sgbc + CALL print11 (this%l%layoutnumber, '---> sgbc solver for multilayer: '//trim(adjustl(dubuf))) + if (this%l%sgbc) then + write(dubuf,*) this%l%sgbcDispersive + CALL print11 (this%l%layoutnumber, '---> sgbc DISPERSIVE solver for multilayer: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%sgbccrank + CALL print11 (this%l%layoutnumber, '---> sgbc Crank-Nicolson solver for multilayer: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%sgbcdepth + CALL print11 (this%l%layoutnumber, '---> sgbc Depth: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%sgbcfreq + CALL print11 (this%l%layoutnumber, '---> sgbc Freq: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%sgbcresol + CALL print11 (this%l%layoutnumber, '---> sgbc Resol: '//trim(adjustl(dubuf))) + endif + write(dubuf,*) this%l%skindepthpre + CALL print11 (this%l%layoutnumber, '---> this%l%skindepthpre preprocessing for multilayer: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%flag_conf_sgg + CALL print11 (this%l%layoutnumber, '---> Conformal file external: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%input_conformal_flag + CALL print11 (this%l%layoutnumber, '---> Conformal solver: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%run_with_abrezanjas + CALL print11 (this%l%layoutnumber, '---> Conformal thin-gap solver: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%run_with_dmma + CALL print11 (this%l%layoutnumber, '---> DMMA thin-gap solver: '//trim(adjustl(dubuf))) + write(dubuf,'(a)') this%l%wiresflavor + CALL print11 (this%l%layoutnumber, '---> Wire model: '//trim(adjustl(dubuf))) + write(dubuf,'(a)') this%l%inductance_model + CALL print11 (this%l%layoutnumber, '---> Inductance model: '//trim(adjustl(dubuf))) + if (trim(adjustl(this%l%wiresflavor))=='berenger') then + write(dubuf,*) this%l%mindistwires + CALL print11 (this%l%layoutnumber, '---> Berenger minimum distance between wires: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%mtlnberenger + CALL print11 (this%l%layoutnumber, '---> Berenger -this%l%mtlnberenger MTLN switch: '//trim(adjustl(dubuf))) + endif + if (trim(adjustl(this%l%wiresflavor))=='holland') then + write(dubuf,*) this%l%stableradholland + CALL print11 (this%l%layoutnumber, '---> Holland -this%l%stableradholland automatic correction switch: '//trim(adjustl(dubuf))) + endif + write(dubuf,*) this%l%TAPARRABOS + CALL print11 (this%l%layoutnumber, '---> Thin-wire double-tails removed: '//trim(adjustl(dubuf))) + write(dubuf,*) this%l%fieldtotl + CALL print11 (this%l%layoutnumber, '---> Thin-wire -this%l%fieldtotl experimental switch: '//trim(adjustl(dubuf))) + WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR + CALL print11 (this%l%layoutnumber, dubuf) + endif + + IF (this%l%layoutnumber == 0) THEN + call erasesignalingfiles(this%l%simu_devia) + endif + + if (this%l%layoutnumber==0) then + + open(newunit=thefileno,FILE = trim(adjustl(this%l%nEntradaRoot))//'_tag_paraviewfilters.txt') + write(thefileno,'(a)') trim(adjustl('### FOR SLICE CURRENT VTK PROBES select the "current_t" or "current_f" ')) + write(thefileno,'(a)') trim(adjustl('### FOR MAP VTK PROBES select the "mediatype" layer ')) + write(thefileno,'(a)') trim(adjustl('### For Paraview versions over 5.10 just use the Threshold exisiting filter to select the interval')) + write(thefileno,'(a)') trim(adjustl('### ######################')) + write(thefileno,'(a)') trim(adjustl('### For Paraview versions under 5.10 Copy and paste the next as a programmable filter to select only one interval of tags')) + write(thefileno,'(a)') trim(adjustl('import vtk ')) + write(thefileno,'(a)') trim(adjustl('inp = self.GetInputDataObject(0, 0) ')) + write(thefileno,'(a)') trim(adjustl('outp = self.GetOutputDataObject(0) ')) + write(thefileno,'(a)') trim(adjustl('thresh = vtk.vtkThreshold() ')) + write(thefileno,'(a)') trim(adjustl('thresh.SetInputData(inp) ')) + write(thefileno,'(a)') trim(adjustl('thresh.SetInputArrayToProcess(0, 0, 0,vtk.vtkDataObject.FIELD_ASSOCIATION_CELLS, "tagnumber") ')) + write(thefileno,'(a)') trim(adjustl('thresh.ThresholdBetween(64,127) ')) + write(thefileno,'(a)') trim(adjustl('thresh.Update() ')) + write(thefileno,'(a)') trim(adjustl('outp.ShallowCopy(thresh.GetOutput()) ')) + write(thefileno,'(a)') trim(adjustl( '# Replace the thresh.ThresholdBetween numbers by tag intervals below to filter by tags ')) + write(thefileno,'(a)') '# ( -1e21 , -1e-3 ) '//trim(adjustl('Candidates for undesired free-space slots')) + write(thefileno,'(a,i9,a,i9,a)') '# ( 0 , 63 ) '//trim(adjustl('Nodal sources, etc.')) + do i=1,this%tagtype%numertags + write(thefileno,'(a,i9,a,i9,a)') '# (',i*64,' , ',i*64+63,') '//trim(adjustl(this%tagtype%tag(i))) !los shifteo 6 bits y les sumo 2**campo ! idea de los 3 bits de 151020 + end do + !! + write(thefileno,'(a)') trim(adjustl( '### ')) + write(thefileno,'(a)') trim(adjustl( '### ')) + write(thefileno,'(a)') trim(adjustl( '### FOR MAP VTK PROBES select the "mediatype" layer ')) + write(thefileno,'(a)') trim(adjustl( '### For Paraview versions over 5.10 just use the Threshold exisiting filter to select the interval')) + write(thefileno,'(a)') trim(adjustl( '### ######################')) + write(thefileno,'(a)') trim(adjustl( '### For Paraview versions under 5.10Copy and paste the next as a programmable filter to select only one types of media')) + write(thefileno,'(a)') trim(adjustl( 'import vtk ')) + write(thefileno,'(a)') trim(adjustl( 'inp = self.GetInputDataObject(0, 0) ')) + write(thefileno,'(a)') trim(adjustl( 'outp = self.GetOutputDataObject(0) ')) + write(thefileno,'(a)') trim(adjustl( 'thresh = vtk.vtkThreshold() ')) + write(thefileno,'(a)') trim(adjustl( 'thresh.SetInputData(inp) ')) + write(thefileno,'(a)') trim(adjustl( 'thresh.SetInputArrayToProcess(0, 0, 0,vtk.vtkDataObject.FIELD_ASSOCIATION_CELLS, "mediatype") ')) + write(thefileno,'(a)') trim(adjustl( 'thresh.ThresholdBetween(0.0,0.5) ')) + write(thefileno,'(a)') trim(adjustl( 'thresh.Update() ')) + write(thefileno,'(a)') trim(adjustl( 'outp.ShallowCopy(thresh.GetOutput()) ')) + write(thefileno,'(a)') trim(adjustl( '# Replace the thresh.ThresholdBetween numbers by media types below to filter by media types ')) + write(thefileno,'(a)') '# ( -100 , -100 ) '//trim(adjustl('Candidates for undesired free-space slots (Surface)')) + write(thefileno,'(a)') '# ( 0.0 , 0.0 ) '//trim(adjustl('PEC (Surface)')) + write(thefileno,'(a)') '# ( 0.5 , 0.5 ) '//trim(adjustl('PEC (Line)')) + write(thefileno,'(a)') '# ( 1.5 , 1.5 ) '//trim(adjustl('Dispersive electric or magnetic isotropic or anisotropic (Line)')) + write(thefileno,'(a)') '# ( 100 , 199 ) '//trim(adjustl('Dispersive electric/magnetic isotropic/anisotropic (+indexmedium) (Surface) ')) + write(thefileno,'(a)') '# ( 2.5 , 2.5 ) '//trim(adjustl('Dielectric isotropic or anisotropic (Line)')) + write(thefileno,'(a)') '# ( 200 , 299 ) '//trim(adjustl('Dielectric isotropic or anisotropic (+indexmedium) (Surface)')) + write(thefileno,'(a)') '# ( 3.5 , 3.5 ) '//trim(adjustl('sgbc/this%l%mibc Isotropic/anisotropic Multiport (Line)')) + write(thefileno,'(a)') '# ( 300 , 399 ) '//trim(adjustl('sgbc/this%l%mibc Isotropic/anisotropic Multiport (+indexmedium) (Surface)')) + write(thefileno,'(a)') '# ( 4.5 , 4.5 ) '//trim(adjustl('Thin slot (Line)')) + write(thefileno,'(a)') '# ( 5.0 , 5.0 ) '//trim(adjustl('Already_YEEadvanced_byconformal (Surface)')) + write(thefileno,'(a)') '# ( 5.5 , 5.5 ) '//trim(adjustl('Already_YEEadvanced_byconformal (Line)')) + write(thefileno,'(a)') '# ( 6.0 , 6.0 ) '//trim(adjustl('Split_and_useless (Surface)')) + write(thefileno,'(a)') '# ( 6.5 , 6.5 ) '//trim(adjustl('Split_and_useless (Line)')) + write(thefileno,'(a)') '# ( 7.0 , 7.0 ) '//trim(adjustl('Edge Not colliding thin wires (Line)')) + write(thefileno,'(a)') '# ( 8.0 , 8.0 ) '//trim(adjustl('Thin wire segments colliding with structure (Line)')) + write(thefileno,'(a)') '# ( 8.5 , 8.5 ) '//trim(adjustl('Soft/Hard Nodal CURRENT/FIELD ELECTRIC DENSITY SOURCE (Line)')) + write(thefileno,'(a)') '# ( 9.0 , 9.0 ) '//trim(adjustl('Soft/Hard Nodal CURRENT/FIELD MAGNETIC DENSITY SOURCE (Line)')) + write(thefileno,'(a)') '# ( 10 , 11 ) '//trim(adjustl('LeftEnd/RightEnd/Ending wire segment (Wire)')) + write(thefileno,'(a)') '# ( 20 , 20 ) '//trim(adjustl('Intermediate wire segment +number_holland_parallel or +number_berenger (Wire) ')) + write(thefileno,'(a)') '# ( 400 , 499 ) '//trim(adjustl('Thin slot (+indexmedium) (Surface)')) + write(thefileno,'(a)') '# ( -0.5 , -0.5 ) '//trim(adjustl('Other types of media (Line)')) + write(thefileno,'(a)') '# ( -1.0 , -1.0 ) '//trim(adjustl('Other types of media (Surface)')) + close(thefileno) + endif + +contains + subroutine NFDE2sgg + !!!!!!!!! + real (kind=rkind) :: dt,finaldt + logical fatalerror + ! parser now holds all the .nfde info + !first read the limits #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - finishedwithsuccess=.false. - - call solver%init(l) + CALL read_limits_nogeom (this%l%layoutnumber,this%l%size, this%sgg, this%fullsize, this%SINPML_fullsize, parser,this%l%MurAfterPML,this%l%mur_exist) + + dtantesdecorregir=this%sgg%dt + !!!!!corrige el delta de t si es necesario !sgg15 310715 bug distintos sgg%dt !!!!!!!!!! + + dxmin=minval(this%sgg%DX) + dymin=minval(this%sgg%DY) + dzmin=minval(this%sgg%DZ) + !!! + dtlay=(1.0_RKIND/(this%cluz*sqrt(((1.0_RKIND / dxmin)**2.0_RKIND )+((1.0_RKIND / dymin)**2.0_RKIND )+((1.0_RKIND / dzmin)**2.0_RKIND )))) + dt=dtlay +#ifdef CompileWithMPI + call MPIupdateMin(dtlay,dt) +#endif + + !!!write(dubuf,*) SEPARADOR//separador//separador + !!!call print11(this%l%layoutnumber,dubuf) + !!!write(dubuf,*) '--->dt,dxmin,dymin,dzmin,sgg%dt ',dt,dxmin,dymin,dzmin,sgg%dt + !!!call print11(this%l%layoutnumber,dubuf) + !!!write(dubuf,*) SEPARADOR//separador//separador + !!!call print11(this%l%layoutnumber,dubuf) + + if (this%l%forcecfl) then + this%sgg%dt=dt*this%l%cfl + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) 'Correcting sgg%dt with -this%l%cfl switch. New time step: ',this%sgg%dt + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%l%layoutnumber,dubuf) + else + if (this%sgg%dt > dt*heurCFL) then + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) 'Automatically correcting dt for stability reasons: ' + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) 'Original dt: ',this%sgg%dt + call print11(this%l%layoutnumber,dubuf) + this%sgg%dt=dt*heurCFL + write(dubuf,*) 'New dt: ',this%sgg%dt + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%l%layoutnumber,dubuf) + endif + endif + !!!!!!!!!!!!No es preciso re-sincronizar pero lo hago !!!!!!!!!!!!!!!!!!!!!!!!!! + finaldt=this%sgg%dt +#ifdef CompileWithMPI + call MPIupdateMin(real(this%sgg%dt,RKIND),finaldt) +#endif + !!!!!!!!!!!!!! + this%l%cfl=this%sgg%dt/dtlay + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) 'CFLN= ',this%l%cfl + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%l%layoutnumber,dubuf) - if ((l%finaltimestep >= 0).and.(.not.l%skindepthpre)) then + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) 'Deltat= ',this%sgg%dt + if (this%l%layoutnumber==0) call print11(this%l%layoutnumber,dubuf) +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#endif + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%l%layoutnumber,dubuf) + if (this%l%mur_exist.and.this%l%mur_first) then + this%l%mur_second=.false. + else + this%l%mur_second=.false. !arreglar cuando se arregle el bug de las mur second + this%l%mur_first=.true. !arreglar cuando se arregle el bug de las mur second + endif +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#endif + !LATER OVERRRIDEN BY MPI + !ALLOCATED ONE MORE TO KEEP PMC INFO FOR THE HX,HY,HZ FIELDS + this%sgg%Alloc(1:6)%XI = this%fullsize(1:6)%XI - 1 + this%sgg%Alloc(1:6)%XE = this%fullsize(1:6)%XE + 1 + this%sgg%Alloc(1:6)%YI = this%fullsize(1:6)%YI - 1 + this%sgg%Alloc(1:6)%YE = this%fullsize(1:6)%YE + 1 + !REDUCE THE SWEEP AREA BY 1 + this%sgg%Sweep(1:6)%XI = this%fullsize(1:6)%XI + this%sgg%Sweep(1:6)%XE = this%fullsize(1:6)%XE + this%sgg%Sweep(1:6)%YI = this%fullsize(1:6)%YI + this%sgg%Sweep(1:6)%YE = this%fullsize(1:6)%YE + ! + IF (this%l%size == 1) THEN + this%sgg%Alloc(1:6)%ZI = this%fullsize(1:6)%ZI - 1 + this%sgg%Alloc(1:6)%ZE = this%fullsize(1:6)%ZE + 1 + !REDUCE THE SWEEP AREA BY 1 + this%sgg%Sweep(1:6)%ZI = this%fullsize(1:6)%ZI + this%sgg%Sweep(1:6)%ZE = this%fullsize(1:6)%ZE + !!incluido aqui pq se precisa para clip 16/07/15 + DO field = iEx, iHz + this%sgg%SINPMLSweep(field)%XI = Max (this%SINPML_fullsize(field)%XI, this%sgg%Sweep(field)%XI) + this%sgg%SINPMLSweep(field)%XE = Min (this%SINPML_fullsize(field)%XE, this%sgg%Sweep(field)%XE) + this%sgg%SINPMLSweep(field)%YI = Max (this%SINPML_fullsize(field)%YI, this%sgg%Sweep(field)%YI) + this%sgg%SINPMLSweep(field)%YE = Min (this%SINPML_fullsize(field)%YE, this%sgg%Sweep(field)%YE) + this%sgg%SINPMLSweep(field)%ZI = Max (this%SINPML_fullsize(field)%ZI, this%sgg%Sweep(field)%ZI) + this%sgg%SINPMLSweep(field)%ZE = Min (this%SINPML_fullsize(field)%ZE, this%sgg%Sweep(field)%ZE) + END DO + !!fin 16/07/15 + WRITE (dubuf,*) 'INIT NFDE --------> GEOM' + CALL print11 (this%l%layoutnumber, dubuf) + CALL read_geomData (this%sgg,this%sggMtag,this%tag_numbers, this%sggMiNo,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz, this%l%fichin, this%l%layoutnumber, this%l%size, this%SINPML_fullsize, this%fullsize, parser, & + this%l%groundwires,this%l%attfactorc,this%l%mibc,this%l%sgbc,this%l%sgbcDispersive,this%l%MEDIOEXTRA,this%maxSourceValue,this%l%skindepthpre,this%l%createmapvtk,this%l%input_conformal_flag,this%l%CLIPREGION,this%l%boundwireradius,this%l%maxwireradius,this%l%updateshared,this%l%run_with_dmma, this%eps0, & + this%mu0,.false.,this%l%hay_slanted_wires,this%l%verbose,this%l%ignoresamplingerrors,this%tagtype,this%l%wiresflavor) #ifdef CompileWithMTLN - CALL solver%launch_simulation (sgg,sggMtag,tag_numbers, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,& - SINPML_fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & - time_desdelanzamiento, maxSourceValue, l%EpsMuTimeScale_input_parameters, mtln_parsed) -#else - CALL solver%launch_simulation (sgg,sggMtag,tag_numbers,sggMiNo, sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,& - SINPML_fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & - time_desdelanzamiento, maxSourceValue, l%EpsMuTimeScale_input_parameters) + if (trim(adjustl(this%l%extension))=='.json') then + this%mtln_parsed = parser%mtln + this%mtln_parsed%time_step = this%sgg%dt + end if + ! if (trim(adjustl(this%l%extension))=='.json') mtln_solver = mtlnCtor(parser%mtln) +#endif + WRITE (dubuf,*) '[OK] ENDED NFDE --------> GEOM' + CALL print11 (this%l%layoutnumber, dubuf) + !writing + slices = '!SLICES' + WRITE (buff, '(i7)') this%sgg%Sweep(iHz)%ZE - this%sgg%Sweep(iHz)%ZI + slices = trim (adjustl(slices)) // '_' // trim (adjustl(buff)) + IF (this%l%resume .AND. (slices /= this%l%slicesoriginales)) THEN + buff='Different resumed/original MPI slices: '//trim(adjustl(slices))//' '//& + & trim(adjustl(this%l%slicesoriginales)) + CALL stoponerror (this%l%layoutnumber, this%l%size, buff) + END IF + CALL print11 (this%l%layoutnumber, trim(adjustl(slices))) + !end writing + WRITE (buff, '(a,i7,a,i7)') '_________Spanning from z=', this%sgg%Sweep(iHz)%ZI, ' to z=', this%sgg%Sweep(iHz)%ZE + CALL print11 (this%l%layoutnumber, trim(adjustl(buff))) +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#ifdef CompileWithStochastic + if (this%l%stochastic) then + buff='this%l%stochastic uncompatible with MPI this%l%size smaller than 2' + CALL stoponerror (this%l%layoutnumber, this%l%size, buff) + endif #endif - deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,sggMtag) - else +#endif + ELSE !del this%l%size==1 +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#ifdef CompileWithStochastic + if (this%l%stochastic) then + call HalvesStochasticMPI(this%l%layoutnumber,this%l%size,this%l%simu_devia) + endif +#endif + + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + !!!ahora divide el espacio computacional + CALL MPIdivide (this%sgg, this%fullsize, this%SINPML_fullsize, this%l%layoutnumber, this%l%size, this%l%forcing, this%l%forced, this%l%slicesoriginales, this%l%resume,this%l%fatalerror) + ! + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + if (this%l%fatalerror) then + !intenta recuperarte + return + endif + + ! if the layout is pure PML then take at least a line of non PML to build the PML data insider read_geomDAta + ! Uses extra memory but later matrix sggm is deallocated in favor of smaller sggMIEX, etc + DO field = iEx, iHz + tempalloc(field)%ZE = this%sgg%Alloc(field)%ZE + tempalloc(field)%ZI = this%sgg%Alloc(field)%ZI + this%sgg%Alloc(field)%ZE = Max (this%sgg%Alloc(field)%ZE, this%SINPML_fullsize(field)%ZI+1) + this%sgg%Alloc(field)%ZI = Min (this%sgg%Alloc(field)%ZI, this%SINPML_fullsize(field)%ZE-1) + END DO + ! + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + !!incluido aqui pq se precisa para clip 16/07/15 + DO field = iEx, iHz + this%sgg%SINPMLSweep(field)%XI = Max (this%SINPML_fullsize(field)%XI, this%sgg%Sweep(field)%XI) + this%sgg%SINPMLSweep(field)%XE = Min (this%SINPML_fullsize(field)%XE, this%sgg%Sweep(field)%XE) + this%sgg%SINPMLSweep(field)%YI = Max (this%SINPML_fullsize(field)%YI, this%sgg%Sweep(field)%YI) + this%sgg%SINPMLSweep(field)%YE = Min (this%SINPML_fullsize(field)%YE, this%sgg%Sweep(field)%YE) + this%sgg%SINPMLSweep(field)%ZI = Max (this%SINPML_fullsize(field)%ZI, this%sgg%Sweep(field)%ZI) + this%sgg%SINPMLSweep(field)%ZE = Min (this%SINPML_fullsize(field)%ZE, this%sgg%Sweep(field)%ZE) + END DO + !!fin 16/07/15 + WRITE (dubuf,*) 'INIT NFDE --------> GEOM' + CALL print11 (this%l%layoutnumber, dubuf) + + CALL read_geomData (this%sgg,this%sggMtag,this%tag_numbers, this%sggMiNo,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz, this%l%fichin, this%l%layoutnumber, this%l%size, this%SINPML_fullsize, this%fullsize, parser, & + this%l%groundwires,this%l%attfactorc,this%l%mibc,this%l%sgbc,this%l%sgbcDispersive,this%l%MEDIOEXTRA,this%maxSourceValue,this%l%skindepthpre,this%l%createmapvtk,this%l%input_conformal_flag,this%l%CLIPREGION,this%l%boundwireradius,this%l%maxwireradius,this%l%updateshared,this%l%run_with_dmma, & + this%eps0,this%mu0,this%l%simu_devia,this%l%hay_slanted_wires,this%l%verbose,this%l%ignoresamplingerrors,this%tagtype,this%l%wiresflavor) + + +#ifdef CompileWithMPI + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#endif +#ifdef CompileWithMTLN + if (trim(adjustl(this%l%extension))=='.json') then + this%mtln_parsed = parser%mtln + this%mtln_parsed%time_step = this%sgg%dt + end if +#endif + WRITE (dubuf,*) '[OK] ENDED NFDE --------> GEOM' + CALL print11 (this%l%layoutnumber, dubuf) + !restore back the indexes + DO field = iEx, iHz + this%sgg%Alloc(field)%ZE = tempalloc(field)%ZE + this%sgg%Alloc(field)%ZI = tempalloc(field)%ZI + END DO +#endif + CONTINUE + END IF !del this%l%size==1 + ! #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) -#endif - CALL get_secnds (l%time_out2) - IF (l%layoutnumber == 0) THEN - call print_credits(l) - WRITE (dubuf,*) 'BEGUN '//trim (adjustl(l%nEntradaRoot)),' at ', time_comienzo%fecha(7:8), & - & '/', time_comienzo%fecha(5:6), '/', time_comienzo%fecha(1:4),' , ', & - & time_comienzo%hora(1:2), ':', time_comienzo%hora(3:4) - CALL print11 (l%layoutnumber, dubuf) - WRITE (dubuf,*) 'ENDED '//trim (adjustl(l%nEntradaRoot)),' at ', l%time_out2%fecha(7:8), & - & '/', l%time_out2%fecha(5:6), '/', l%time_out2%fecha(1:4),' , ', & - & l%time_out2%hora(1:2), ':', l%time_out2%hora(3:4) - CALL print11 (l%layoutnumber, dubuf) - WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR - CALL print11 (l%layoutnumber, dubuf) - CALL print11 (l%layoutnumber, dubuf) - ENDIF - !!!!!!! CALL CLOSEdxfFILE(l%layoutnumber,l%size) - CALL CLOSEWARNINGFILE(l%layoutnumber,l%size,dummylog,l%stochastic,l%simu_devia) !aqui ya no se tiene en cuenta el l%fatalerror + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#endif + !!!!!!!!!!!!!lo dejo aqui debajo tambien aunque ya se ha calculado antes para lo del clipping + DO field = iEx, iHz + this%sgg%SINPMLSweep(field)%XI = Max (this%SINPML_fullsize(field)%XI, this%sgg%Sweep(field)%XI) + this%sgg%SINPMLSweep(field)%XE = Min (this%SINPML_fullsize(field)%XE, this%sgg%Sweep(field)%XE) + this%sgg%SINPMLSweep(field)%YI = Max (this%SINPML_fullsize(field)%YI, this%sgg%Sweep(field)%YI) + this%sgg%SINPMLSweep(field)%YE = Min (this%SINPML_fullsize(field)%YE, this%sgg%Sweep(field)%YE) + this%sgg%SINPMLSweep(field)%ZI = Max (this%SINPML_fullsize(field)%ZI, this%sgg%Sweep(field)%ZI) + this%sgg%SINPMLSweep(field)%ZE = Min (this%SINPML_fullsize(field)%ZE, this%sgg%Sweep(field)%ZE) + END DO + return + end subroutine + + end subroutine semba_init + + + subroutine semba_launch(this) + class(semba_fdtd_t) :: this + type(solver_t) :: solver + character (LEN=BUFSIZE) :: dubuf + logical :: dummylog + + ! call each simulation !ojo que los layoutnumbers empiezan en 0 + IF (this%l%finaltimestep /= 0) THEN #ifdef CompileWithMPI !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#endif + this%finishedwithsuccess=.false. + + +#ifdef CompileWithMTLN + solver%mtln_parsed = this%mtln_parsed #endif + + if ((this%l%finaltimestep >= 0).and.(.not.this%l%skindepthpre)) then + CALL solver%launch_simulation (this%sgg,this%sggMtag,this%tag_numbers,this%sggMiNo, this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,& + this%SINPML_fullsize,this%fullsize,this%finishedwithsuccess,this%eps0,this%mu0,this%tagtype,& + this%l, this%maxSourceValue, this%time_desdelanzamiento) + + deallocate (this%sggMiEx, this%sggMiEy, this%sggMiEz,this%sggMiHx, this%sggMiHy, this%sggMiHz,this%sggMiNo,this%sggMtag) + else +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) +#endif + CALL get_secnds (this%l%time_out2) + IF (this%l%layoutnumber == 0) THEN + call print_credits(this%l) + WRITE (dubuf,*) 'BEGUN '//trim (adjustl(this%l%nEntradaRoot)),' at ', this%time_comienzo%fecha(7:8), & + & '/', this%time_comienzo%fecha(5:6), '/', this%time_comienzo%fecha(1:4),' , ', & + & this%time_comienzo%hora(1:2), ':', this%time_comienzo%hora(3:4) + CALL print11 (this%l%layoutnumber, dubuf) + WRITE (dubuf,*) 'ENDED '//trim (adjustl(this%l%nEntradaRoot)),' at ', this%l%time_out2%fecha(7:8), & + & '/', this%l%time_out2%fecha(5:6), '/', this%l%time_out2%fecha(1:4),' , ', & + & this%l%time_out2%hora(1:2), ':', this%l%time_out2%hora(3:4) + CALL print11 (this%l%layoutnumber, dubuf) + WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR + CALL print11 (this%l%layoutnumber, dubuf) + CALL print11 (this%l%layoutnumber, dubuf) + ENDIF + !!!!!!! CALL CLOSEdxfFILE(this%l%layoutnumber,this%l%size) + CALL CLOSEWARNINGFILE(this%l%layoutnumber,this%l%size,dummylog,this%l%stochastic,this%l%simu_devia) !aqui ya no se tiene en cuenta el this%l%fatalerror #ifdef CompileWithMPI - CALL MPI_FINALIZE (l%ierr) + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - stop - endif - END IF - ! #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_FINALIZE (this%l%ierr) +#endif + stop + endif + END IF + ! +#ifdef CompileWithMPI + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - ! - IF (l%layoutnumber == 0) THEN - if (l%run) then - OPEN (38, file='running') - WRITE (38, '(a)') '!END' - CLOSE (38,status='delete') - endif - WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR - CALL print11 (l%layoutnumber, dubuf) - WRITE (dubuf,*) 'DONE : ', trim (adjustl(l%nEntradaRoot)), ' UNTIL n=', l%finaltimestep - CALL print11 (l%layoutnumber, dubuf) - WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR - CALL print11 (l%layoutnumber, dubuf) - call erasesignalingfiles(l%simu_devia) - END IF + end subroutine semba_launch + + subroutine semba_end(this) + class(semba_fdtd_t) :: this + character (LEN=BUFSIZE) :: dubuf + logical :: existe + character (LEN=BUFSIZE) :: filenombre= ' ' + + IF (this%l%layoutnumber == 0) THEN + if (this%l%run) then + OPEN (38, file='running') + WRITE (38, '(a)') '!END' + CLOSE (38,status='delete') + endif + WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR + CALL print11 (this%l%layoutnumber, dubuf) + WRITE (dubuf,*) 'DONE : ', trim (adjustl(this%l%nEntradaRoot)), ' UNTIL n=', this%l%finaltimestep + CALL print11 (this%l%layoutnumber, dubuf) + WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR + CALL print11 (this%l%layoutnumber, dubuf) + call erasesignalingfiles(this%l%simu_devia) + + END IF #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - ! - IF (l%deleteintermediates) THEN - WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR - CALL print11 (l%layoutnumber, dubuf) - WRITE (dubuf,*) 'Attempting to delete all intermediate data files' - CALL print11 (l%layoutnumber, dubuf) - WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR - CALL print11 (l%layoutnumber, dubuf) - INQUIRE (file=trim(adjustl(l%nEntradaRoot))//'_Outputrequests_'//trim(adjustl(whoamishort))//'.txt', EXIST=existe) - IF (existe) THEN - OPEN (19, file=trim(adjustl(l%nEntradaRoot))//'_Outputrequests_'//trim(adjustl(whoamishort))//'.txt') - buscafile: DO - READ (19, '(a)', end=76) filenombre - IF (trim(adjustl(filenombre)) == '!END') THEN - EXIT buscafile - ELSE - OPEN (34, file=trim(adjustl(filenombre))) - WRITE (34,*) '!END' - CLOSE (34, STATUS='delete') + ! + IF (this%l%deleteintermediates) THEN + WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR + CALL print11 (this%l%layoutnumber, dubuf) + WRITE (dubuf,*) 'Attempting to delete all intermediate data files' + CALL print11 (this%l%layoutnumber, dubuf) + WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR + CALL print11 (this%l%layoutnumber, dubuf) + INQUIRE (file=trim(adjustl(this%l%nEntradaRoot))//'_Outputrequests_'//trim(adjustl(this%whoamishort))//'.txt', EXIST=existe) + IF (existe) THEN + OPEN (19, file=trim(adjustl(this%l%nEntradaRoot))//'_Outputrequests_'//trim(adjustl(this%whoamishort))//'.txt') + buscafile: DO + READ (19, '(a)', end=76) filenombre + IF (trim(adjustl(filenombre)) == '!END') THEN + EXIT buscafile + ELSE + OPEN (34, file=trim(adjustl(filenombre))) + WRITE (34,*) '!END' + CLOSE (34, STATUS='delete') + END IF + END DO buscafile + 76 CONTINUE + CLOSE (19, STATUS='delete') + IF (this%l%layoutnumber == 0) THEN + OPEN (33, file=trim(adjustl(this%l%nEntradaRoot))//'_Outputlists.dat') + WRITE (33,*) '!END' + CLOSE (33, STATUS='delete') END IF - END DO buscafile -76 CONTINUE - CLOSE (19, STATUS='delete') - IF (l%layoutnumber == 0) THEN - OPEN (33, file=trim(adjustl(l%nEntradaRoot))//'_Outputlists.dat') - WRITE (33,*) '!END' - CLOSE (33, STATUS='delete') END IF END IF - END IF - ! + ! - !************************************************************************************************** - !***[conformal] ******************************************************************* - !************************************************************************************************** - !delete conformal memory reff: ##Conf_end## + !************************************************************************************************** + !***[conformal] ******************************************************************* + !************************************************************************************************** + !delete conformal memory reff: ##Conf_end## #ifdef CompileWithConformal - if(l%input_conformal_flag)then - call conf_sMesh%delete - call conf_timeSteps%delete; - call delete_conf_tools(); - end if + if(this%l%input_conformal_flag)then + call conf_sMesh%delete + call conf_timeSteps%delete; + call delete_conf_tools(); + end if #endif - !************************************************************************************************** - !************************************************************************************************** - !************************************************************************************************** + !************************************************************************************************** + !************************************************************************************************** + !************************************************************************************************** #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) -#endif - CALL get_secnds (l%time_out2) - IF (l%layoutnumber == 0) THEN - call print_credits(l) - WRITE (dubuf,*) 'BEGUN '//trim (adjustl(l%nEntradaRoot)),' at ', time_comienzo%fecha(7:8), & - & '/', time_comienzo%fecha(5:6), '/', time_comienzo%fecha(1:4),' , ', & - & time_comienzo%hora(1:2), ':', time_comienzo%hora(3:4) - CALL print11 (l%layoutnumber, dubuf) - WRITE (dubuf,*) 'ENDED '//trim (adjustl(l%nEntradaRoot)),' at ', l%time_out2%fecha(7:8), & - & '/', l%time_out2%fecha(5:6), '/', l%time_out2%fecha(1:4),' , ', & - & l%time_out2%hora(1:2), ':', l%time_out2%hora(3:4) - CALL print11 (l%layoutnumber, dubuf) - WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR - CALL print11 (l%layoutnumber, dubuf) - CALL print11 (l%layoutnumber, dubuf) - ENDIF - INQUIRE (file='relaunch', EXIST=l%relaunching) + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) +#endif + CALL get_secnds (this%l%time_out2) + IF (this%l%layoutnumber == 0) THEN + call print_credits(this%l) + WRITE (dubuf,*) 'BEGUN '//trim (adjustl(this%l%nEntradaRoot)),' at ', this%time_comienzo%fecha(7:8), & + & '/', this%time_comienzo%fecha(5:6), '/', this%time_comienzo%fecha(1:4),' , ', & + & this%time_comienzo%hora(1:2), ':', this%time_comienzo%hora(3:4) + CALL print11 (this%l%layoutnumber, dubuf) + WRITE (dubuf,*) 'ENDED '//trim (adjustl(this%l%nEntradaRoot)),' at ', this%l%time_out2%fecha(7:8), & + & '/', this%l%time_out2%fecha(5:6), '/', this%l%time_out2%fecha(1:4),' , ', & + & this%l%time_out2%hora(1:2), ':', this%l%time_out2%hora(3:4) + CALL print11 (this%l%layoutnumber, dubuf) + WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR + CALL print11 (this%l%layoutnumber, dubuf) + CALL print11 (this%l%layoutnumber, dubuf) + ENDIF + INQUIRE (file='relaunch', EXIST=this%l%relaunching) #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - ! Error reading check + ! Error reading check #ifdef keeppause - if (l%fatalerror) then - fatalerror_aux=.true. + if (this%l%fatalerror) then + fatalerror_aux=.true. #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - call MPI_AllReduce(fatalerror_aux, l%fatalerror, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + call MPI_AllReduce(fatalerror_aux, this%l%fatalerror, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, this%l%ierr) #else - l%fatalerror = fatalerror_aux + this%l%fatalerror = fatalerror_aux #endif - if (l%fatalerror) l%relaunching=.true. -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - endif -#endif - - IF (l%relaunching.and.(.not.finishedwithsuccess)) THEN - IF (l%layoutnumber == 0) THEN - CALL print11 (l%layoutnumber, SEPARADOR//SEPARADOR) - CALL print11 (l%layoutnumber, 'Not finishing solicited either manually or by an error condition. Edit of create launch file and remove pause file ') - CALL print11 (l%layoutnumber, SEPARADOR//SEPARADOR) - OPEN (9, file='pause', FORM='formatted') - write (9, '(a)') ' ' - CLOSE (9) - OPEN (9, file='relaunch', FORM='formatted') - write (9, '(a)') ' ' - CLOSE (9,status='delete') - endif - !!!!! + if (this%l%fatalerror) this%l%relaunching=.true. #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - IF (l%layoutnumber == 0) THEN - CALL CloseReportingFiles - endif - GO TO 652 - END IF -!si ha acabado con exito sal borrando signal files - IF (finishedwithsuccess) THEN - IF (l%layoutnumber == 0) THEN - OPEN (9, file='pause', FORM='formatted') - write (9, '(a)') ' ' - CLOSE (9,status='delete') - OPEN (9, file='relaunch', FORM='formatted') - write (9, '(a)') ' ' - CLOSE (9,status='delete') - OPEN (9, file='running', FORM='formatted') - write (9, '(a)') ' ' - CLOSE (9,status='delete') - endif endif +#endif + IF (this%l%relaunching.and.(.not.this%finishedwithsuccess)) THEN + IF (this%l%layoutnumber == 0) THEN + CALL print11 (this%l%layoutnumber, SEPARADOR//SEPARADOR) + CALL print11 (this%l%layoutnumber, 'Not finishing solicited either manually or by an error condition. Edit of create launch file and remove pause file ') + CALL print11 (this%l%layoutnumber, SEPARADOR//SEPARADOR) + OPEN (9, file='pause', FORM='formatted') + write (9, '(a)') ' ' + CLOSE (9) + OPEN (9, file='relaunch', FORM='formatted') + write (9, '(a)') ' ' + CLOSE (9,status='delete') + endif + !!!!! #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - - IF (l%layoutnumber == 0) THEN - CALL CloseReportingFiles - endif - !************************************************************************************************** + IF (this%l%layoutnumber == 0) THEN + CALL CloseReportingFiles + endif + ! GO TO 652 + END IF + !si ha acabado con exito sal borrando signal files + IF (this%finishedwithsuccess) THEN + IF (this%l%layoutnumber == 0) THEN + OPEN (9, file='pause', FORM='formatted') + write (9, '(a)') ' ' + CLOSE (9,status='delete') + OPEN (9, file='relaunch', FORM='formatted') + write (9, '(a)') ' ' + CLOSE (9,status='delete') + OPEN (9, file='running', FORM='formatted') + write (9, '(a)') ' ' + CLOSE (9,status='delete') + endif + endif #ifdef CompileWithMPI - CALL MPI_FINALIZE (l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - STOP - ! - -contains -!END PROGRAM SEMBA_FDTD_launcher -!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!! + IF (this%l%layoutnumber == 0) THEN + CALL CloseReportingFiles + endif + !************************************************************************************************** -#ifdef CompilePrivateVersion -subroutine cargaNFDE(local_nfde,local_parser) - CHARACTER (LEN=BUFSIZE) :: local_nfde - TYPE (Parseador), POINTER :: local_parser - INTEGER (KIND=8) :: numero,i8,troncho,longitud - integer (kind=4) :: mpi_t_linea_t,longitud4 - IF (l%existeNFDE) THEN - WRITE (dubuf,*) 'INIT Reading file '//trim (adjustl(whoami))//' ', trim (adjustl(local_nfde)) - CALL print11 (l%layoutnumber, dubuf) -!!!!!!!!!!!!!!!!!!!!!!! #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - if (l%layoutnumber==0) then - NFDE_FILE => cargar_NFDE_FILE (local_nfde) - !!!ya se allocatea dentro - else - ALLOCATE (NFDE_FILE) - endif - ! - write(dubuf,*) '[OK]'; call print11(l%layoutnumber,dubuf) - !---> - WRITE (dubuf,*) 'INIT Sharing file through MPI'; CALL print11 (l%layoutnumber, dubuf) - ! - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - ! - numero=NFDE_FILE%numero - call MPI_BCAST(numero, 1_4, MPI_INTEGER8, 0_4, SUBCOMM_MPI, l%ierr) - if (l%layoutnumber/=0) then - NFDE_FILE%targ = 1 - NFDE_FILE%numero=numero - ALLOCATE (NFDE_FILE%lineas(NFDE_FILE%numero)) - endif - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - !CREAMOS EL DERIVED TYPE y lo enviamos !para evitar el error de Marconi asociado a PSM2_MQ_RECVREQS_MAX 100617 - - CALL build_derived_t_linea(mpi_t_linea_t) - - !problema del limite de mandar mas de 2^29 bytes con MPI!!! Los soluciono partiendo en maxmpibytes (2^27) (algo menos por prudencia)! 040716 - troncho=ceiling(maxmpibytes*1.0_8/(BUFSIZE*1.0_8+8.0_8),8) - !!! print *,'numero,troncho ',numero,troncho - do i8=1,numero,troncho - longitud=min(troncho,numero-i8+1) - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - if ((longitud>huge(1_4)).or.(longitud>maxmpibytes)) then - print *,'Stop. Buggy error: MPI longitud greater that greatest integer*4' - stop - else - longitud4=int(longitud,4) - endif - call MPI_BCAST(NFDE_FILE%lineas(i8),longitud4,mpi_t_linea_t,0_4,SUBCOMM_MPI,l%ierr) - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - !!! if (l%layoutnumber==1) print *,'l%layoutnumber-->',l%layoutnumber, i8,i8+longitud-1 - !!! if (l%layoutnumber==1) print *,NFDE_FILE%lineas(i8)%len,' ',trim(adjustl(NFDE_FILE%lineas(i8)%dato)) - !!! if (l%layoutnumber==1) print *,NFDE_FILE%lineas(i8+longitud-1)%len,' ',trim(adjustl(NFDE_FILE%lineas(i8+longitud-1)%dato)) - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - ! do i=1,numero - ! call MPI_BCAST(NFDE_FILE%lineas(i)%len, 1_4, MPI_INTEGER4, 0_4, SUBCOMM_MPI, l%ierr) - ! call MPI_BCAST(NFDE_FILE%lineas(i)%dato, BUFSIZE, MPI_CHARACTER, 0_4, SUBCOMM_MPI, l%ierr) - ! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) !para evitar el error de Marconi asociado a PSM2_MQ_RECVREQS_MAX 100617 - ! end do - end do - !solo para debugeo - !!!open(6729,file='comprob_'//trim(adjustl(dubuf))//'.nfde',form='formatted') - !!!write(6729,'(2i12)') NFDE_FILE%numero,NFDE_FILE%targ - !!!do i=1,numero - !!! write(6729,'(i6,a)') NFDE_FILE%lineas(i)%len,trim(adjustl(NFDE_FILE%lineas(i)%dato)) - !!!end do - !!!close (6729) - !!!!!! -#else - NFDE_FILE => cargar_NFDE_FILE (local_nfde) -#endif - write(dubuf,*) '[OK]'; call print11(l%layoutnumber,dubuf) - !---> - END IF - NFDE_FILE%mpidir=l%mpidir -!!!!!!!!!!!!!!!!!!! - WRITE (dubuf,*) 'INIT interpreting geometrical data from ', trim (adjustl(local_nfde)) - CALL print11 (l%layoutnumber, dubuf) -!!!!!!!!!! - if(newrotate) then - verdadero_mpidir=NFDE_FILE%mpidir - NFDE_FILE%mpidir=3 !no lo rota el parseador antiguo - endif - local_parser => newparser (NFDE_FILE) -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - if(newrotate) then - NFDE_FILE%mpidir=verdadero_mpidir !restorealo - call nfde_rotate (local_parser,NFDE_FILE%mpidir) !lo rota el parseador nuevo -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - endif - l%thereare_stoch=NFDE_FILE%thereare_stoch - l%mpidir=NFDE_FILE%mpidir !bug 100419 -!!!!!!!!!!! - ! write(dubuf,*) '[OK]'; call print11(l%layoutnumber,dubuf) - write(dubuf,*) '[OK] '//trim(adjustl(whoami))//' newparser (NFDE_FILE)'; call print11(l%layoutnumber,dubuf) -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_FINALIZE (this%l%ierr) #endif - return + ! STOP + ! -end subroutine cargaNFDE -#endif + end subroutine semba_end + + subroutine initEntrada(input) + type(entrada_t), intent(inout) :: input +#ifdef CompileWithConformal + input%conformal_file_input_name=char(0); +#endif + input%geomfile = ' '; + input%prefix = ' ';input%fichin = ' '; input%chain2 = ' '; input%opcionestotales = ' ' + input%nEntradaRoot = ' '; input%fileFDE = ' '; input%fileH5 = ' ' + input%prefixopci = ' '; input%prefixopci1 = ' ';input%opcionespararesumeo = ' '; input%opcionesoriginales = ' ' + input%slicesoriginales = ' '; ; input%chdummy = ' ' + input%flushsecondsFields=0.; input%flushsecondsData=0.; input%time_end=0. + input%existeNFDE=.false.; input%existeconf=.false.; input%existecmsh=.false.; input%existeh5=.false. + input%creditosyaprinteados=.false. + call input%EpsMuTimeScale_input_parameters%init0() + + end subroutine #ifdef CompileWithSMBJSON subroutine cargaFDTDJSON(filename, parsed) @@ -1076,244 +1219,93 @@ subroutine cargaFDTDJSON(filename, parsed) end subroutine cargaFDTDJSON #endif -!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -subroutine NFDE2sgg -!!!!!!!!! - real (kind=rkind) :: dt,finaldt - logical fatalerror - ! parser now holds all the .nfde info - !first read the limits -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - CALL read_limits_nogeom (l%layoutnumber,l%size, sgg, fullsize, SINPML_fullsize, parser,l%MurAfterPML,l%mur_exist) - - dtantesdecorregir=sgg%dt - !!!!!corrige el delta de t si es necesario !sgg15 310715 bug distintos sgg%dt !!!!!!!!!! - - dxmin=minval(sgg%DX) - dymin=minval(sgg%DY) - dzmin=minval(sgg%DZ) - !!! - dtlay=(1.0_RKIND/(cluz*sqrt(((1.0_RKIND / dxmin)**2.0_RKIND )+((1.0_RKIND / dymin)**2.0_RKIND )+((1.0_RKIND / dzmin)**2.0_RKIND )))) - dt=dtlay -#ifdef CompileWithMPI - call MPIupdateMin(dtlay,dt) -#endif - - !!!write(dubuf,*) SEPARADOR//separador//separador - !!!call print11(l%layoutnumber,dubuf) - !!!write(dubuf,*) '--->dt,dxmin,dymin,dzmin,sgg%dt ',dt,dxmin,dymin,dzmin,sgg%dt - !!!call print11(l%layoutnumber,dubuf) - !!!write(dubuf,*) SEPARADOR//separador//separador - !!!call print11(l%layoutnumber,dubuf) - - if (l%forcecfl) then - sgg%dt=dt*l%cfl - write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) - write(dubuf,*) 'Correcting sgg%dt with -l%cfl switch. New time step: ',sgg%dt - call print11(l%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) - else - if (sgg%dt > dt*heurCFL) then - write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) - write(dubuf,*) 'Automatically correcting dt for stability reasons: ' - call print11(l%layoutnumber,dubuf) - write(dubuf,*) 'Original dt: ',sgg%dt - call print11(l%layoutnumber,dubuf) - sgg%dt=dt*heurCFL - write(dubuf,*) 'New dt: ',sgg%dt - call print11(l%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) - endif - endif - !!!!!!!!!!!!No es preciso re-sincronizar pero lo hago !!!!!!!!!!!!!!!!!!!!!!!!!! - finaldt=sgg%dt -#ifdef CompileWithMPI - call MPIupdateMin(real(sgg%dt,RKIND),finaldt) -#endif - !!!!!!!!!!!!!! - l%cfl=sgg%dt/dtlay - write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) - write(dubuf,*) 'CFLN= ',l%cfl - call print11(l%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) - - write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) - write(dubuf,*) 'Deltat= ',sgg%dt - if (l%layoutnumber==0) call print11(l%layoutnumber,dubuf) -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) - if (l%mur_exist.and.l%mur_first) then - l%mur_second=.false. - else - l%mur_second=.false. !arreglar cuando se arregle el bug de las mur second - l%mur_first=.true. !arreglar cuando se arregle el bug de las mur second - endif -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - !LATER OVERRRIDEN BY MPI - !ALLOCATED ONE MORE TO KEEP PMC INFO FOR THE HX,HY,HZ FIELDS - sgg%Alloc(1:6)%XI = fullsize(1:6)%XI - 1 - sgg%Alloc(1:6)%XE = fullsize(1:6)%XE + 1 - sgg%Alloc(1:6)%YI = fullsize(1:6)%YI - 1 - sgg%Alloc(1:6)%YE = fullsize(1:6)%YE + 1 - !REDUCE THE SWEEP AREA BY 1 - sgg%Sweep(1:6)%XI = fullsize(1:6)%XI - sgg%Sweep(1:6)%XE = fullsize(1:6)%XE - sgg%Sweep(1:6)%YI = fullsize(1:6)%YI - sgg%Sweep(1:6)%YE = fullsize(1:6)%YE - ! - IF (l%size == 1) THEN - sgg%Alloc(1:6)%ZI = fullsize(1:6)%ZI - 1 - sgg%Alloc(1:6)%ZE = fullsize(1:6)%ZE + 1 - !REDUCE THE SWEEP AREA BY 1 - sgg%Sweep(1:6)%ZI = fullsize(1:6)%ZI - sgg%Sweep(1:6)%ZE = fullsize(1:6)%ZE - !!incluido aqui pq se precisa para clip 16/07/15 - DO field = iEx, iHz - sgg%SINPMLSweep(field)%XI = Max (SINPML_fullsize(field)%XI, sgg%Sweep(field)%XI) - sgg%SINPMLSweep(field)%XE = Min (SINPML_fullsize(field)%XE, sgg%Sweep(field)%XE) - sgg%SINPMLSweep(field)%YI = Max (SINPML_fullsize(field)%YI, sgg%Sweep(field)%YI) - sgg%SINPMLSweep(field)%YE = Min (SINPML_fullsize(field)%YE, sgg%Sweep(field)%YE) - sgg%SINPMLSweep(field)%ZI = Max (SINPML_fullsize(field)%ZI, sgg%Sweep(field)%ZI) - sgg%SINPMLSweep(field)%ZE = Min (SINPML_fullsize(field)%ZE, sgg%Sweep(field)%ZE) - END DO - !!fin 16/07/15 - WRITE (dubuf,*) 'INIT NFDE --------> GEOM' - CALL print11 (l%layoutnumber, dubuf) - CALL read_geomData (sgg,sggMtag,tag_numbers, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, l%fichin, l%layoutnumber, l%size, SINPML_fullsize, fullsize, parser, & - l%groundwires,l%attfactorc,l%mibc,l%sgbc,l%sgbcDispersive,l%MEDIOEXTRA,maxSourceValue,l%skindepthpre,l%createmapvtk,l%input_conformal_flag,l%CLIPREGION,l%boundwireradius,l%maxwireradius,l%updateshared,l%run_with_dmma, & - eps0,mu0,.false.,l%hay_slanted_wires,l%verbose,l%ignoresamplingerrors,tagtype,l%wiresflavor) -#ifdef CompileWithMTLN - if (trim(adjustl(l%extension))=='.json') then - mtln_parsed = parser%mtln - mtln_parsed%time_step = sgg%dt - end if - ! if (trim(adjustl(l%extension))=='.json') mtln_solver = mtlnCtor(parser%mtln) -#endif - WRITE (dubuf,*) '[OK] ENDED NFDE --------> GEOM' - CALL print11 (l%layoutnumber, dubuf) - !writing - slices = '!SLICES' - WRITE (buff, '(i7)') sgg%Sweep(iHz)%ZE - sgg%Sweep(iHz)%ZI - slices = trim (adjustl(slices)) // '_' // trim (adjustl(buff)) - IF (l%resume .AND. (slices /= l%slicesoriginales)) THEN - buff='Different resumed/original MPI slices: '//trim(adjustl(slices))//' '//& - & trim(adjustl(l%slicesoriginales)) - CALL stoponerror (l%layoutnumber, l%size, buff) - END IF - CALL print11 (l%layoutnumber, trim(adjustl(slices))) - !end writing - WRITE (buff, '(a,i7,a,i7)') '_________Spanning from z=', sgg%Sweep(iHz)%ZI, ' to z=', sgg%Sweep(iHz)%ZE - CALL print11 (l%layoutnumber, trim(adjustl(buff))) -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#ifdef CompileWithStochastic - if (l%stochastic) then - buff='l%stochastic uncompatible with MPI l%size smaller than 2' - CALL stoponerror (l%layoutnumber, l%size, buff) - endif -#endif -#endif - ELSE !del l%size==1 +#ifdef CompilePrivateVersion + subroutine cargaNFDE(local_nfde,local_parser) + CHARACTER (LEN=BUFSIZE) :: local_nfde + TYPE (Parseador), POINTER :: local_parser + INTEGER (KIND=8) :: numero,i8,troncho,longitud + integer (kind=4) :: mpi_t_linea_t,longitud4 + IF (this%l%existeNFDE) THEN + WRITE (dubuf,*) 'INIT Reading file '//trim (adjustl(this%whoami))//' ', trim (adjustl(local_nfde)) + CALL print11 (this%l%layoutnumber, dubuf) + !!!!!!!!!!!!!!!!!!!!!!! #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#ifdef CompileWithStochastic - if (l%stochastic) then - call HalvesStochasticMPI(l%layoutnumber,l%size,l%simu_devia) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + if (this%l%layoutnumber==0) then + NFDE_FILE => cargar_NFDE_FILE (local_nfde) + !!!ya se allocatea dentro + else + ALLOCATE (NFDE_FILE) endif -#endif - - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -!!!ahora divide el espacio computacional - CALL MPIdivide (sgg, fullsize, SINPML_fullsize, l%layoutnumber, l%size, l%forcing, l%forced, l%slicesoriginales, l%resume,l%fatalerror) ! - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - if (l%fatalerror) then -!intenta recuperarte - return + write(dubuf,*) '[OK]'; call print11(this%l%layoutnumber,dubuf) + !---> + WRITE (dubuf,*) 'INIT Sharing file through MPI'; CALL print11 (this%l%layoutnumber, dubuf) + ! + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + ! + numero=NFDE_FILE%numero + call MPI_BCAST(numero, 1_4, MPI_INTEGER8, 0_4, SUBCOMM_MPI, this%l%ierr) + if (this%l%layoutnumber/=0) then + NFDE_FILE%targ = 1 + NFDE_FILE%numero=numero + ALLOCATE (NFDE_FILE%lineas(NFDE_FILE%numero)) endif - - ! if the layout is pure PML then take at least a line of non PML to build the PML data insider read_geomDAta - ! Uses extra memory but later matrix sggm is deallocated in favor of smaller sggMIEX, etc - DO field = iEx, iHz - tempalloc(field)%ZE = sgg%Alloc(field)%ZE - tempalloc(field)%ZI = sgg%Alloc(field)%ZI - sgg%Alloc(field)%ZE = Max (sgg%Alloc(field)%ZE, SINPML_fullsize(field)%ZI+1) - sgg%Alloc(field)%ZI = Min (sgg%Alloc(field)%ZI, SINPML_fullsize(field)%ZE-1) - END DO - ! - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - !!incluido aqui pq se precisa para clip 16/07/15 - DO field = iEx, iHz - sgg%SINPMLSweep(field)%XI = Max (SINPML_fullsize(field)%XI, sgg%Sweep(field)%XI) - sgg%SINPMLSweep(field)%XE = Min (SINPML_fullsize(field)%XE, sgg%Sweep(field)%XE) - sgg%SINPMLSweep(field)%YI = Max (SINPML_fullsize(field)%YI, sgg%Sweep(field)%YI) - sgg%SINPMLSweep(field)%YE = Min (SINPML_fullsize(field)%YE, sgg%Sweep(field)%YE) - sgg%SINPMLSweep(field)%ZI = Max (SINPML_fullsize(field)%ZI, sgg%Sweep(field)%ZI) - sgg%SINPMLSweep(field)%ZE = Min (SINPML_fullsize(field)%ZE, sgg%Sweep(field)%ZE) - END DO - !!fin 16/07/15 - WRITE (dubuf,*) 'INIT NFDE --------> GEOM' - CALL print11 (l%layoutnumber, dubuf) - - CALL read_geomData (sgg,sggMtag,tag_numbers, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, l%fichin, l%layoutnumber, l%size, SINPML_fullsize, fullsize, parser, & - l%groundwires,l%attfactorc,l%mibc,l%sgbc,l%sgbcDispersive,l%MEDIOEXTRA,maxSourceValue,l%skindepthpre,l%createmapvtk,l%input_conformal_flag,l%CLIPREGION,l%boundwireradius,l%maxwireradius,l%updateshared,l%run_with_dmma, & - eps0,mu0,l%simu_devia,l%hay_slanted_wires,l%verbose,l%ignoresamplingerrors,tagtype,l%wiresflavor) - - -#ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + !CREAMOS EL DERIVED TYPE y lo enviamos !para evitar el error de Marconi asociado a PSM2_MQ_RECVREQS_MAX 100617 + + CALL build_derived_t_linea(mpi_t_linea_t) + + !problema del limite de mandar mas de 2^29 bytes con MPI!!! Los soluciono partiendo en maxmpibytes (2^27) (algo menos por prudencia)! 040716 + troncho=ceiling(maxmpibytes*1.0_8/(BUFSIZE*1.0_8+8.0_8),8) + do i8=1,numero,troncho + longitud=min(troncho,numero-i8+1) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + if ((longitud>huge(1_4)).or.(longitud>maxmpibytes)) then + print *,'Stop. Buggy error: MPI longitud greater that greatest integer*4' + stop + else + longitud4=int(longitud,4) + endif + call MPI_BCAST(NFDE_FILE%lineas(i8),longitud4,mpi_t_linea_t,0_4,SUBCOMM_MPI,this%l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + end do +#else + NFDE_FILE => cargar_NFDE_FILE (local_nfde) +#endif + write(dubuf,*) '[OK]'; call print11(this%l%layoutnumber,dubuf) + !---> + END IF + NFDE_FILE%mpidir=this%l%mpidir + WRITE (dubuf,*) 'INIT interpreting geometrical data from ', trim (adjustl(local_nfde)) + CALL print11 (this%l%layoutnumber, dubuf) + if(newrotate) then + verdadero_mpidir=NFDE_FILE%mpidir + NFDE_FILE%mpidir=3 + endif + local_parser => newparser (NFDE_FILE) +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif -#ifdef CompileWithMTLN - if (trim(adjustl(l%extension))=='.json') then - mtln_parsed = parser%mtln - mtln_parsed%time_step = sgg%dt - end if + if(newrotate) then + NFDE_FILE%mpidir=verdadero_mpidir + call nfde_rotate (local_parser,NFDE_FILE%mpidir) +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - WRITE (dubuf,*) '[OK] ENDED NFDE --------> GEOM' - CALL print11 (l%layoutnumber, dubuf) - !restore back the indexes - DO field = iEx, iHz - sgg%Alloc(field)%ZE = tempalloc(field)%ZE - sgg%Alloc(field)%ZI = tempalloc(field)%ZI - END DO + endif + this%l%thereare_stoch=NFDE_FILE%thereare_stoch + this%l%mpidir=NFDE_FILE%mpidir !bug 100419 + write(dubuf,*) '[OK] '//trim(adjustl(this%whoami))//' newparser (NFDE_FILE)'; call print11(this%l%layoutnumber,dubuf) +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - CONTINUE - END IF !del l%size==1 - ! -#ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - !!!!!!!!!!!!!lo dejo aqui debajo tambien aunque ya se ha calculado antes para lo del clipping - DO field = iEx, iHz - sgg%SINPMLSweep(field)%XI = Max (SINPML_fullsize(field)%XI, sgg%Sweep(field)%XI) - sgg%SINPMLSweep(field)%XE = Min (SINPML_fullsize(field)%XE, sgg%Sweep(field)%XE) - sgg%SINPMLSweep(field)%YI = Max (SINPML_fullsize(field)%YI, sgg%Sweep(field)%YI) - sgg%SINPMLSweep(field)%YE = Min (SINPML_fullsize(field)%YE, sgg%Sweep(field)%YE) - sgg%SINPMLSweep(field)%ZI = Max (SINPML_fullsize(field)%ZI, sgg%Sweep(field)%ZI) - sgg%SINPMLSweep(field)%ZE = Min (SINPML_fullsize(field)%ZE, sgg%Sweep(field)%ZE) - END DO return - end subroutine - ! - - END PROGRAM SEMBA_FDTD_launcher + end subroutine cargaNFDE +#endif + + +end module SEMBA_FDTD_mod ! diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 2ef2c333..7552a229 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -91,26 +91,56 @@ module Solver_mod type, public :: solver_t type(sim_control_t) :: control type(Logic_control) :: thereAre + type(perform_t) :: perform, d_perform + + real(kind=rkind), pointer, dimension (:,:,:) :: Ex,Ey,Ez,Hx,Hy,Hz + real(kind=rkind), pointer, dimension (:) :: Idxe, Idye, Idze, Idxh, Idyh, Idzh, dxe, dye, dze, dxh, dyh, dzh + real(kind=rkind), pointer, dimension ( : ) :: g1,g2,gM1,gM2 + + integer (KIND=INTEGERSIZEOFMEDIAMATRICES), dimension(:,:,:), allocatable :: sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz + integer (KIND=IKINDMTAG), dimension(:,:,:), allocatable :: sggMtag + + real (kind=RKIND_tiempo) :: lastexecutedtime + real (kind=RKIND) :: maxSourceValue + + integer (kind=4) :: initialtimestep, lastexecutedtimestep, ini_save, n_info, n + + type(bounds_t) :: bounds + + logical :: parar, everflushed = .false., still_planewave_time + +#ifdef CompileWithMTLN + type (mtln_t) :: mtln_parsed +#endif + contains procedure :: init => solver_init + procedure :: run => solver_run + procedure :: end => solver_end + procedure :: init_control => solver_init_control + procedure, private :: init_fields + procedure, private :: init_distances procedure :: launch_simulation + procedure :: set_field_value + procedure :: get_field_value + procedure :: step #ifdef CompileWithMTLN procedure :: launch_mtln_simulation #endif end type -! private - -! public launch_simulation -! #ifdef CompileWithMTLN -! public launch_mtln_simulation -! #endif - contains - subroutine solver_init(this, input) + subroutine solver_init_control(this, input, maxSourceValue, time_desdelanzamiento) class(solver_t) :: this - type(entrada_t) :: input + type(entrada_t), intent(in) :: input + real (kind=RKIND), intent(in) :: maxSourceValue + REAL (kind=8), intent(in) :: time_desdelanzamiento + + + this%control%maxSourceValue = maxSourceValue + this%control%time_desdelanzamiento = time_desdelanzamiento + this%control%simu_devia = input%simu_devia this%control%resume = input%resume this%control%saveall = input%saveall @@ -139,7 +169,6 @@ subroutine solver_init(this, input) this%control%NF2FFDecim = input%NF2FFDecim this%control%sgbccrank = input%sgbccrank this%control%fieldtotl = input%fieldtotl - ! this%control%finishedwithsuccess = this%control%permitscaling = input%permitscaling this%control%mtlnberenger = input%mtlnberenger this%control%niapapostprocess = input%niapapostprocess @@ -153,11 +182,9 @@ subroutine solver_init(this, input) this%control%wirecrank = input%wirecrank this%control%fatalerror = input%fatalerror - ! time_desdelanzamiento = input%time_desdelanzamiento this%control%cfl = input%cfl this%control%attfactorc = input%attfactorc this%control%attfactorw = input%attfactorw -! maxSourceValue = input%maxSourceValue this%control%alphamaxpar = input%alphamaxpar this%control%alphaOrden = input%alphaOrden this%control%kappamaxpar = input%kappamaxpar @@ -187,6 +214,10 @@ subroutine solver_init(this, input) this%control%facesNF2FF = input%facesNF2FF !this%control%EpsMuTimeScale_input_parameters = input%EpsMuTimeScale_input_parameters +#ifdef CompileWithConformal + this%control%input_conformal_flag = input%input_conformal_flag +#endif + call this%thereAre%reset() end subroutine @@ -205,46 +236,133 @@ subroutine launch_mtln_simulation(this, mtln_parsed, nEntradaRoot, layoutnumber) end subroutine #endif -#ifdef CompileWithMTLN - subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & - SINPML_Fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & - time_desdelanzamiento, maxSourceValue, EpsMuTimeScale_input_parameters, mtln_parsed) -#else - subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & - SINPML_Fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & - time_desdelanzamiento, maxSourceValue, EpsMuTimeScale_input_parameters) -#endif - !!! + subroutine init_fields(this, sgg) class(solver_t) :: this -#ifdef CompileWithMTLN - type (mtln_t) :: mtln_parsed -#endif + type (sggfdtdinfo), intent(in) :: sgg + allocate ( & + this%Ex(sgg%Alloc(iEx)%XI : sgg%Alloc(iEx)%XE,sgg%Alloc(iEx)%YI : sgg%Alloc(iEx)%YE,sgg%Alloc(iEx)%ZI : sgg%Alloc(iEx)%ZE),& + this%Ey(sgg%Alloc(iEy)%XI : sgg%Alloc(iEy)%XE,sgg%Alloc(iEy)%YI : sgg%Alloc(iEy)%YE,sgg%Alloc(iEy)%ZI : sgg%Alloc(iEy)%ZE),& + this%Ez(sgg%Alloc(iEz)%XI : sgg%Alloc(iEz)%XE,sgg%Alloc(iEz)%YI : sgg%Alloc(iEz)%YE,sgg%Alloc(iEz)%ZI : sgg%Alloc(iEz)%ZE),& + this%Hx(sgg%Alloc(iHx)%XI : sgg%Alloc(iHx)%XE,sgg%Alloc(iHx)%YI : sgg%Alloc(iHx)%YE,sgg%Alloc(iHx)%ZI : sgg%Alloc(iHx)%ZE),& + this%Hy(sgg%Alloc(iHy)%XI : sgg%Alloc(iHy)%XE,sgg%Alloc(iHy)%YI : sgg%Alloc(iHy)%YE,sgg%Alloc(iHy)%ZI : sgg%Alloc(iHy)%ZE),& + this%Hz(sgg%Alloc(iHz)%XI : sgg%Alloc(iHz)%XE,sgg%Alloc(iHz)%YI : sgg%Alloc(iHz)%YE,sgg%Alloc(iHz)%ZI : sgg%Alloc(iHz)%ZE)) + this%Ex = 0.0_RKIND; this%Ey = 0.0_RKIND; this%Ez = 0.0_RKIND; this%Hx = 0.0_RKIND; this%Hy = 0.0_RKIND; this%Hz = 0.0_RKIND + end subroutine + subroutine init_distances(this,sgg) + class(solver_t) :: this + type (sggfdtdinfo), intent(in) :: sgg + integer :: i + allocate ( & + this%dxe (sgg%ALLOC(iHx)%XI : sgg%ALLOC(iHx)%XE), & + this%dye (sgg%ALLOC(iHy)%YI : sgg%ALLOC(iHy)%YE), & + this%dze (sgg%ALLOC(iHz)%ZI : sgg%ALLOC(iHz)%ZE), & + this%Idxe(sgg%ALLOC(iHx)%XI : sgg%ALLOC(iHx)%XE), & + this%Idye(sgg%ALLOC(iHy)%YI : sgg%ALLOC(iHy)%YE), & + this%Idze(sgg%ALLOC(iHz)%ZI : sgg%ALLOC(iHz)%ZE), & + this%dxh (sgg%ALLOC(iEx)%XI : sgg%ALLOC(iEx)%XE), & + this%dyh (sgg%ALLOC(iEy)%YI : sgg%ALLOC(iEy)%YE), & + this%dzh (sgg%ALLOC(iEz)%ZI : sgg%ALLOC(iEz)%ZE), & + this%Idxh(sgg%ALLOC(iEx)%XI : sgg%ALLOC(iEx)%XE), & + this%Idyh(sgg%ALLOC(iEy)%YI : sgg%ALLOC(iEy)%YE), & + this%Idzh(sgg%ALLOC(iEz)%ZI : sgg%ALLOC(iEz)%ZE)) + this%dxe=-1.0e10_RKIND + this%dye=-1.0e10_RKIND + this%dze=-1.0e10_RKIND + this%dxh=-1.0e10_RKIND + this%dyh=-1.0e10_RKIND + this%dzh=-1.0e10_RKIND + + do i=sgg%ALLOC(iHx)%XI,sgg%ALLOC(iHx)%XE + this%dxe(i)=sgg%DX(i) + end do + do i=sgg%ALLOC(iHy)%YI,sgg%ALLOC(iHy)%YE + this%dye(i)=sgg%DY(i) + end do + do i=sgg%ALLOC(iHz)%ZI,sgg%ALLOC(iHz)%ZE + this%dze(i)=sgg%DZ(i) + end do + do i=sgg%ALLOC(iEx)%XI,sgg%ALLOC(iEx)%XE + this%dxh(i)=(sgg%DX(i)+sgg%DX(i-1))/2.0_RKIND + end do + do i=sgg%ALLOC(iEy)%YI,sgg%ALLOC(iEy)%YE + this%dyh(i)=(sgg%DY(i)+sgg%DY(i-1))/2.0_RKIND + end do + do i=sgg%ALLOC(iEz)%ZI,sgg%ALLOC(iEz)%ZE + this%dzh(i)=(sgg%DZ(i)+sgg%DZ(i-1))/2.0_RKIND + end do - logical :: dummylog - type (tagtype_t) :: tagtype + this%Idxe=1.0_RKIND/this%dxe + this%Idye=1.0_RKIND/this%dye + this%Idze=1.0_RKIND/this%dze + this%Idxh=1.0_RKIND/this%dxh + this%Idyh=1.0_RKIND/this%dyh + this%Idzh=1.0_RKIND/this%dzh + end subroutine - !!for tuning - !real (kind=rkind) :: time_elec=0.0_RKIND,time_magnet=0.0_RKIND - !type (tiempo_t) :: time_MagnetInit,time_ElecInit,time_MagnetFin,time_ElecFin - !!for tuning + subroutine set_field_value(this, field_idx, i_range,j_range,k_range, field_value) + class(solver_t) :: this + integer (kind=4), intent(in) :: field_idx + integer (kind=4), dimension(2), intent(in) :: i_range, j_range, k_range + real (kind=rkind), intent(in) :: field_value + + real(kind=rkind), pointer, dimension (:,:,:) :: field + integer(kind=4) :: i, j, k + select case(field_idx) + case(iEx) + field => this%Ex + case(iEy) + field => this%Ey + case(iEz) + field => this%Ez + case(iHx) + field => this%Hx + case(iHy) + field => this%Hy + case(iHz) + field => this%Hz + end select + do i = i_range(1), i_range(2) + do j = j_range(1), j_range(2) + do k = k_range(1), k_range(2) + field(i,j,k) = field_value + end do + end do + end do + end subroutine - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !! SIMULATION VARIABLES - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real (kind=rkind) :: maxSourceValue - REAL (kind=8) :: time_desdelanzamiento - type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters + function get_field_value(this, field_idx, fi,fj,fk) result(res) + class(solver_t) :: this + integer (kind=4), intent(in) :: field_idx + integer (kind=4), intent(in) :: fi, fj, fk + real (kind=rkind) :: res + + real(kind=rkind), pointer, dimension (:,:,:) :: field + select case(field_idx) + case(iEx) + field => this%Ex + case(iEy) + field => this%Ey + case(iEz) + field => this%Ez + case(iHx) + field => this%Hx + case(iHy) + field => this%Hy + case(iHz) + field => this%Hz + end select + res = field(fi,fj,fk) + end function - REAL (KIND=RKIND), intent(inout) :: eps0,mu0 - real (kind=RKIND_tiempo) :: tiempoinicial,lastexecutedtime,ultimodt + subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & + SINPML_Fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & + input, maxSourceValue, time_desdelanzamiento) + class(solver_t) :: this type (SGGFDTDINFO), intent(INOUT) :: sgg - REAL (KIND=RKIND) :: dtcritico,newdtcritico - REAL (KIND=RKIND) , pointer, dimension ( : , : , : ) :: Ex,Ey,Ez,Hx,Hy,Hz - !!!! integer (KIND=IKINDMTAG) :: & sggMtag(sgg%alloc(iHx)%XI : sgg%alloc(iHx)%XE,sgg%alloc(iHy)%YI : sgg%alloc(iHy)%YE,sgg%alloc(iHz)%ZI : sgg%alloc(iHz)%ZE) - type(taglist_t) :: tag_numbers + type(taglist_t), intent(in) :: tag_numbers integer (KIND=INTEGERSIZEOFMEDIAMATRICES) :: & sggMiNo(sgg%alloc(iHx)%XI : sgg%alloc(iHx)%XE,sgg%alloc(iHy)%YI : sgg%alloc(iHy)%YE,sgg%alloc(iHz)%ZI : sgg%alloc(iHz)%ZE), & sggMiEx(sgg%alloc(iEx)%XI : sgg%alloc(iEx)%XE,sgg%alloc(iEx)%YI : sgg%alloc(iEx)%YE,sgg%alloc(iEx)%ZI : sgg%alloc(iEx)%ZE), & @@ -253,53 +371,72 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi sggMiHx(sgg%alloc(iHx)%XI : sgg%alloc(iHx)%XE,sgg%alloc(iHx)%YI : sgg%alloc(iHx)%YE,sgg%alloc(iHx)%ZI : sgg%alloc(iHx)%ZE), & sggMiHy(sgg%alloc(iHy)%XI : sgg%alloc(iHy)%XE,sgg%alloc(iHy)%YI : sgg%alloc(iHy)%YE,sgg%alloc(iHy)%ZI : sgg%alloc(iHy)%ZE), & sggMiHz(sgg%alloc(iHz)%XI : sgg%alloc(iHz)%XE,sgg%alloc(iHz)%YI : sgg%alloc(iHz)%YE,sgg%alloc(iHz)%ZI : sgg%alloc(iHz)%ZE) - REAL (KIND=RKIND) , pointer, dimension ( : ) :: Idxe,Idye,Idze,Idxh,Idyh,Idzh,dxe,dye,dze,dxh,dyh,dzh - !!!REAL (KIND=RKIND) , pointer, dimension ( : ) :: dxe_orig,dye_orig,dze_orig !deprecado 28/04/2014 - REAL (KIND=RKIND) , pointer, dimension ( : ) :: g1,g2,gM1,gM2 - !for lossy paddings - REAL (KIND=RKIND) :: Mur,epr,fmax,deltaespmax,Sigma,Epsilon,Mu,Sigmam,skin_depth,averagefactor,width,sigmatemp,eprtemp,murtemp,rdummy - REAL (KIND=RKIND_tiempo) :: at,rdummydt - logical :: hayattmedia = .false.,attinformado = .false., somethingdone,newsomethingdone,call_timing,l_auxoutput,l_auxinput - character(len=BUFSIZE) :: buff - integer (kind=4) :: group_conformalprobes_dummy - ! - !!!!!!!PML params!!!!!!!!!!!!!!!!!!!!!!!!!!!! - + type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize logical :: finishedwithsuccess - !!!!!!! - !Input - type (bounds_t) :: b + REAL (KIND=RKIND), intent(inout) :: eps0,mu0 + type (tagtype_t) :: tagtype + type(entrada_t), intent(in) :: input + real (kind=RKIND), intent(in) :: maxSourceValue + REAL (kind=8), intent(in) :: time_desdelanzamiento + + call this%init_control(input,maxSourceValue, time_desdelanzamiento) + call this%init(sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, SINPML_fullsize, fullsize, tag_numbers) + call this%run(sgg, eps0, mu0, SINPML_fullsize, fullsize, tag_numbers, tagtype) + call this%end(sgg, eps0, mu0, tagtype, finishedwithsuccess) - type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize - ! - character (LEN=BUFSIZE) :: chari,layoutcharID,dubuf - integer (kind=4) :: ini_save,mindum - !Generic - type (Logic_control) :: thereare - integer (kind=4) :: ierr,ndummy - type (perform_t) :: perform, d_perform - Logical :: parar,flushFF, & - everflushed,still_planewave_time,planewave_switched_off,thereareplanewave,l_aux + end subroutine launch_simulation + + subroutine solver_init(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, sinPML_fullsize, fullsize, tag_numbers) + class(solver_t) :: this + type(sggfdtdinfo), intent(inout) :: sgg + real(kind=rkind), intent(inout) :: eps0,mu0 + + integer (KIND=INTEGERSIZEOFMEDIAMATRICES), intent(inout) :: & + sggMiNo(sgg%alloc(iHx)%XI : sgg%alloc(iHx)%XE,sgg%alloc(iHy)%YI : sgg%alloc(iHy)%YE,sgg%alloc(iHz)%ZI : sgg%alloc(iHz)%ZE), & + sggMiEx(sgg%alloc(iEx)%XI : sgg%alloc(iEx)%XE,sgg%alloc(iEx)%YI : sgg%alloc(iEx)%YE,sgg%alloc(iEx)%ZI : sgg%alloc(iEx)%ZE), & + sggMiEy(sgg%alloc(iEy)%XI : sgg%alloc(iEy)%XE,sgg%alloc(iEy)%YI : sgg%alloc(iEy)%YE,sgg%alloc(iEy)%ZI : sgg%alloc(iEy)%ZE), & + sggMiEz(sgg%alloc(iEz)%XI : sgg%alloc(iEz)%XE,sgg%alloc(iEz)%YI : sgg%alloc(iEz)%YE,sgg%alloc(iEz)%ZI : sgg%alloc(iEz)%ZE), & + sggMiHx(sgg%alloc(iHx)%XI : sgg%alloc(iHx)%XE,sgg%alloc(iHx)%YI : sgg%alloc(iHx)%YE,sgg%alloc(iHx)%ZI : sgg%alloc(iHx)%ZE), & + sggMiHy(sgg%alloc(iHy)%XI : sgg%alloc(iHy)%XE,sgg%alloc(iHy)%YI : sgg%alloc(iHy)%YE,sgg%alloc(iHy)%ZI : sgg%alloc(iHy)%ZE), & + sggMiHz(sgg%alloc(iHz)%XI : sgg%alloc(iHz)%XE,sgg%alloc(iHz)%YI : sgg%alloc(iHz)%YE,sgg%alloc(iHz)%ZI : sgg%alloc(iHz)%ZE) + integer (KIND=IKINDMTAG), intent(inout) :: & + sggMtag(sgg%alloc(iHx)%XI : sgg%alloc(iHx)%XE,sgg%alloc(iHy)%YI : sgg%alloc(iHy)%YE,sgg%alloc(iHz)%ZI : sgg%alloc(iHz)%ZE) + + type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize, fullsize + type(taglist_t) :: tag_numbers + + integer(kind=4) :: i, j, k, field + character (len=bufsize) :: whoami, chari, layoutcharID + + real(kind=rkind), pointer, dimension (:,:,:) :: Ex, Ey, Ez, Hx, Hy, Hz + real(kind=rkind), pointer, dimension (:) :: Idxe, Idye, Idze, Idxh, Idyh, Idzh, dxe, dye, dze, dxh, dyh, dzh + real(kind=rkind), pointer, dimension (:) :: g1,g2,gM1,gM2 + + real(kind=RKIND_tiempo) :: ultimodt + + character (len=bufsize) :: dubuf + logical :: attinformado = .false. + +! #ifdef compileWithMPI + integer(kind=4) :: dummyMin,dummyMax, ierr + real(kind=rkind) :: rdummy +! #endif + + this%sggMiNo = sggMiNo + this%sggMiEx = sggMiEx + this%sggMiEy = sggMiEy + this%sggMiEz = sggMiEz + this%sggMiHx = sggMiHx + this%sggMiHy = sggMiHy + this%sggMiHz = sggMiHz + this%sggMtag = sggMtag - integer (kind=4) :: i,J,K,r,n,initialtimestep,lastexecutedtimestep,n_info,FIELD,dummyMin,dummyMax - ! - character (LEN=BUFSIZE) :: whoami - ! - TYPE (tiempo_t) :: time_out2 - real (kind=RKIND) :: pscale_alpha - integer :: rank - !******************************************************************************* - !******************************************************************************* - !******************************************************************************* - - planewave_switched_off=.false. this%control%fatalerror=.false. - parar=.false. - call perform%reset() - call d_perform%reset() - flushFF=.false. - everflushed=.false. + + this%parar=.false. + call this%perform%reset() + call this%d_perform%reset() call this%thereAre%reset() this%thereAre%MagneticMedia = sgg%thereareMagneticMedia this%thereAre%PMLMagneticMedia = sgg%therearePMLMagneticMedia @@ -313,103 +450,31 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi if (sgg%Alloc(field)%YI /= J) call stoponerror(this%control%layoutnumber,this%control%size,'OFFSETS IN INITIAL COORD NOT ALLOWED') if (sgg%Alloc(field)%ZI /= K) call stoponerror(this%control%layoutnumber,this%control%size,'OFFSETS IN INITIAL COORD NOT ALLOWED') END DO - !!!!!!!!!!!!!!!!!!!!!!!!END PRECHECKING write(whoami,'(a,i5,a,i5,a)') '(',this%control%layoutnumber+1,'/',this%control%size,') ' - !file names write(chari,*) this%control%layoutnumber+1 - ! - - !!!!!!!write the material data in the Warnings file if ((this%control%layoutnumber == 0).and.this%control%verbose) call reportmedia(sgg) - ! layoutcharID = trim(adjustl(this%control%nentradaroot))//'_'//trim(adjustl(chari)) + call findbounds(sgg,this%bounds) - ! - call findbounds(sgg,b) - - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! Space steps matrices creation (an extra cell is padded to deal with PMC imaging with no index errors - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !I need the whole increments to properly find the same time step in each layout - - allocate (dxe (sgg%ALLOC(iHx)%XI : sgg%ALLOC(iHx)%XE), & - dye (sgg%ALLOC(iHy)%YI : sgg%ALLOC(iHy)%YE), & - dze (sgg%ALLOC(iHz)%ZI : sgg%ALLOC(iHz)%ZE), & - Idxe(sgg%ALLOC(iHx)%XI : sgg%ALLOC(iHx)%XE), & - Idye(sgg%ALLOC(iHy)%YI : sgg%ALLOC(iHy)%YE), & - Idze(sgg%ALLOC(iHz)%ZI : sgg%ALLOC(iHz)%ZE), & - dxh (sgg%ALLOC(iEx)%XI : sgg%ALLOC(iEx)%XE), & - dyh (sgg%ALLOC(iEy)%YI : sgg%ALLOC(iEy)%YE), & - dzh (sgg%ALLOC(iEz)%ZI : sgg%ALLOC(iEz)%ZE), & - Idxh(sgg%ALLOC(iEx)%XI : sgg%ALLOC(iEx)%XE), & - Idyh(sgg%ALLOC(iEy)%YI : sgg%ALLOC(iEy)%YE), & - Idzh(sgg%ALLOC(iEz)%ZI : sgg%ALLOC(iEz)%ZE)) - ! - dxe=-1.0e10_RKIND; dye=-1.0e10_RKIND; dze=-1.0e10_RKIND; dxh=-1.0e10_RKIND; dyh=-1.0e10_RKIND; dzh=-1.0e10_RKIND ; !default values (ABSURD TO PREVEN ERRORS) - - - !original - do i=sgg%ALLOC(iHx)%XI,sgg%ALLOC(iHx)%XE - dxe(i)=sgg%DX(i) - end do - - do J=sgg%ALLOC(iHy)%YI,sgg%ALLOC(iHy)%YE - dye(J)=sgg%DY(J) - end do - - do K=sgg%ALLOC(iHz)%ZI,sgg%ALLOC(iHz)%ZE - dze(K)=sgg%DZ(K) - end do - - do i=sgg%ALLOC(iEx)%XI,sgg%ALLOC(iEx)%XE - dxh(i)=(sgg%DX(i)+sgg%DX(i-1))/2.0_RKIND - end do - do J=sgg%ALLOC(iEy)%YI,sgg%ALLOC(iEy)%YE - dyh(J)=(sgg%DY(J)+sgg%DY(J-1))/2.0_RKIND - end do - do K=sgg%ALLOC(iEz)%ZI,sgg%ALLOC(iEz)%ZE - dzh(K)=(sgg%DZ(K)+sgg%DZ(K-1))/2.0_RKIND - end do - - !!!lo he deprecado 28/04/2014 por incoherencia global con los deltas usados por todos lados - !!!!mittra libro used in the stepping - !!!dxe_orig=-1.0e10_RKIND; dye_orig=-1.0e10_RKIND; dze_orig=-1.0e10_RKIND; - !!!do i=sgg%ALLOC(iHx)%XI,sgg%ALLOC(iHx)%XE - !!! dxe_mittra(i)=1.0_RKIND / 8.0_RKIND * (6.0_RKIND * sgg%DX(i)+sgg%DX(i-1)+sgg%DX(i+1)) - !!!end do - !!! - !!!do J=sgg%ALLOC(iHy)%YI,sgg%ALLOC(iHy)%YE - !!! dyee_mittra(J)=1.0_RKIND / 8.0_RKIND * (6.0_RKIND * sgg%DY(J)+sgg%DY(J-1)+sgg%DY(J+1)) - !!!end do - !!! - !!!do K=sgg%ALLOC(iHz)%ZI,sgg%ALLOC(iHz)%ZE - !!! dze_mittra(K)=1.0_RKIND / 8.0_RKIND * (6.0_RKIND * sgg%DZ(K)+sgg%DZ(K-1)+sgg%DZ(K+1)) - !!!end do - !!!Idxe_mittra=1.0_RKIND/dxe_mittra ; Idye=1.0_RKIND/dye_mittra; Idze=1.0_RKIND/dze_mittra; - !fin mitrra solo usado en time-stepping -!!!ojo que cpml toca los idxe, etc. para stretchaarlos con kappa (es 1 por lo general). Pero cuidado 251018 - Idxe=1.0_RKIND/dxe ; Idye=1.0_RKIND/dye; Idze=1.0_RKIND/dze; Idxh=1.0_RKIND/dxh; Idyh=1.0_RKIND/dyh; Idzh=1.0_RKIND/dzh; - - + call this%init_distances(sgg) + Idxe => this%Idxe; Idye => this%Idye; Idze => this%Idze; Idxh => this%Idxh; Idyh => this%Idyh; Idzh => this%Idzh; dxe => this%dxe; dye => this%dye; dze => this%dze; dxh => this%dxh; dyh => this%dyh; dzh => this%dzh !!!lo cambio aqui permit scaling a 211118 por problemas con resuming: debe leer el eps0, mu0, antes de hacer numeros - - allocate (G1(0 : sgg%NumMedia),G2(0 : sgg%NumMedia),GM1(0 : sgg%NumMedia),GM2(0 : sgg%NumMedia)) + + allocate (this%G1(0 : sgg%NumMedia),this%G2(0 : sgg%NumMedia),this%GM1(0 : sgg%NumMedia),this%GM2(0 : sgg%NumMedia)) + g1 => this%g1 + g2 => this%g2 + gm1 => this%gm1 + gm2 => this%gm2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! Field matrices creation (an extra cell is padded at each limit and direction to deal with PMC imaging with no index errors) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !ojo las dimesniones deben ser giuales a las utlizadas en reallocate para las matrices sggmiEx, etc - ALLOCATE ( & - Ex(sgg%Alloc(iEx)%XI : sgg%Alloc(iEx)%XE,sgg%Alloc(iEx)%YI : sgg%Alloc(iEx)%YE,sgg%Alloc(iEx)%ZI : sgg%Alloc(iEx)%ZE),& - Ey(sgg%Alloc(iEy)%XI : sgg%Alloc(iEy)%XE,sgg%Alloc(iEy)%YI : sgg%Alloc(iEy)%YE,sgg%Alloc(iEy)%ZI : sgg%Alloc(iEy)%ZE),& - Ez(sgg%Alloc(iEz)%XI : sgg%Alloc(iEz)%XE,sgg%Alloc(iEz)%YI : sgg%Alloc(iEz)%YE,sgg%Alloc(iEz)%ZI : sgg%Alloc(iEz)%ZE),& - Hx(sgg%Alloc(iHx)%XI : sgg%Alloc(iHx)%XE,sgg%Alloc(iHx)%YI : sgg%Alloc(iHx)%YE,sgg%Alloc(iHx)%ZI : sgg%Alloc(iHx)%ZE),& - Hy(sgg%Alloc(iHy)%XI : sgg%Alloc(iHy)%XE,sgg%Alloc(iHy)%YI : sgg%Alloc(iHy)%YE,sgg%Alloc(iHy)%ZI : sgg%Alloc(iHy)%ZE),& - Hz(sgg%Alloc(iHz)%XI : sgg%Alloc(iHz)%XE,sgg%Alloc(iHz)%YI : sgg%Alloc(iHz)%YE,sgg%Alloc(iHz)%ZI : sgg%Alloc(iHz)%ZE)) - !!! + + call this%init_fields(sgg) + Ex => this%Ex; Ey => this%Ey; Ez => this%Ez; Hx => this%Hx; Hy => this%Hy; Hz => this%Hz + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! Init the local variables and observation stuff needed by each module, taking into account resume status !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -417,22 +482,18 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi dt0=sgg%dt !guardalo aqui para entrada pscale correcta si resume if (.not.this%control%resume) then Ex=0.0_RKIND; Ey=0.0_RKIND; Ez=0.0_RKIND; Hx=0.0_RKIND; Hy=0.0_RKIND; Hz=0.0_RKIND - !!!! - !!!!!!!!!!!!!!!!?!?!?!?!?!?!? Ex=1.0_RKIND; Ey=2.0_RKIND; Ez=3.0_RKIND; Hx=4.0_RKIND; Hy=5.0_RKIND; Hz=6.0_RKIND - initialtimestep=0 !vamos a empezar en 0 para escribir el tiempo 0 !sgg sept'16 !? - tiempoinicial = 0.0_RKIND_tiempo - lastexecutedtimestep=0 - lastexecutedtime=0.0_RKIND_tiempo + this%initialtimestep=0 + this%lastexecutedtimestep=0 + this%lastexecutedtime=0.0_RKIND_tiempo else write(dubuf,*) 'Init processing resuming data' call print11(this%control%layoutnumber,dubuf) - !In case of resuming, the fields are read from disk if (this%control%resume_fromold) then open (14,file=trim(adjustl(this%control%nresumeable2))//'.old',form='unformatted') else open (14,file=trim(adjustl(this%control%nresumeable2)),form='unformatted') endif - call ReadFields(sgg%alloc,lastexecutedtimestep,lastexecutedtime,ultimodt,eps0,mu0,Ex,Ey,Ez,Hx,Hy,Hz) + call ReadFields(sgg%alloc,this%lastexecutedtimestep,this%lastexecutedtime,ultimodt,eps0,mu0,Ex,Ey,Ez,Hx,Hy,Hz) sgg%dt=ultimodt !para permit scaling !!!!!!!!!!!!No es preciso re-sincronizar pero lo hago !!!!!!!!!!!!!!!!!!!!!!!!!! #ifdef CompileWithMPI @@ -444,15 +505,17 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi call MPIupdateMin(mu0,rdummy) #endif #ifdef CompileWithMPI - call MPI_AllReduce( lastexecutedtimestep, dummyMin, 1_4, MPI_INTEGER, MPI_MIN, SUBCOMM_MPI, ierr) - call MPI_AllReduce( lastexecutedtimestep, dummyMax, 1_4, MPI_INTEGER, MPI_MAX, SUBCOMM_MPI, ierr) - if ((dummyMax /= lastexecutedtimestep).or.(dummyMin /= lastexecutedtimestep)) then + call MPI_AllReduce( this%lastexecutedtimestep, dummyMin, 1_4, MPI_INTEGER, MPI_MIN, SUBCOMM_MPI, ierr) + call MPI_AllReduce( this%lastexecutedtimestep, dummyMax, 1_4, MPI_INTEGER, MPI_MAX, SUBCOMM_MPI, ierr) + if ((dummyMax /= this%lastexecutedtimestep).or.(dummyMin /= this%lastexecutedtimestep)) then #ifdef CompileWithOldSaving if (this%control%resume_fromold) then close (14) - write(DUbuf,*) 'Incoherence between MPI saved steps for resuming.', dummyMin,dummyMax,lastexecutedtimesteP + write(dubuf,*) 'Incoherence between MPI saved steps for resuming.', dummyMin,dummyMax,this%lastexecutedtimesteP call stoponerror (this%control%layoutnumber,this%control%size,BUFF,.true.) !para que retorne call Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh,this%thereare,this%control%wiresflavor ) + ! this%Ex et al as arguments? + ! call Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh,this%thereare,this%control%wiresflavor ) return else write(dubuf,*) 'Incoherence between MPI saved steps for resuming. Retrying with -old....' @@ -460,122 +523,50 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi this%control%resume_fromold=.true. close (14) open (14,file=trim(adjustl(this%control%nresumeable2))//'.old',form='unformatted') - call ReadFields(sgg%alloc,lastexecutedtimestep,lastexecutedtime,ultimodt,eps0,mu0,Ex,Ey,Ez,Hx,Hy,Hz) + call ReadFields(sgg%alloc,this%lastexecutedtimestep,this%lastexecutedtime,ultimodt,eps0,mu0,Ex,Ey,Ez,Hx,Hy,Hz) sgg%dt=ultimodt !para permit scaling - call MPI_AllReduce( lastexecutedtimestep, dummyMin, 1_4, MPI_INTEGER, MPI_MIN, SUBCOMM_MPI, ierr) - call MPI_AllReduce( lastexecutedtimestep, dummyMax, 1_4, MPI_INTEGER, MPI_MAX, SUBCOMM_MPI, ierr) - if ((dummyMax /= lastexecutedtimestep).or.(dummyMin /= lastexecutedtimestep)) then - write(DUbuf,*) 'NO success. fields.old MPI are also incoherent for resuming.', dummyMin,dummyMax,lastexecutedtimestep + call MPI_AllReduce( this%lastexecutedtimestep, dummyMin, 1_4, MPI_INTEGER, MPI_MIN, SUBCOMM_MPI, ierr) + call MPI_AllReduce( this%lastexecutedtimestep, dummyMax, 1_4, MPI_INTEGER, MPI_MAX, SUBCOMM_MPI, ierr) + if ((dummyMax /= this%lastexecutedtimestep).or.(dummyMin /= this%lastexecutedtimestep)) then + write(DUbuf,*) 'NO success. fields.old MPI are also incoherent for resuming.', dummyMin,dummyMax,this%lastexecutedtimestep call stoponerror (this%control%layoutnumber,this%control%size,DUBUF,.true.) !para que retorne call Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh,this%thereare,this%control%wiresflavor ) return else - write(dubuf,*) 'SUCCESS: Restarting from .fields.old instead. From n=',lastexecutedtimestep + write(dubuf,*) 'SUCCESS: Restarting from .fields.old instead. From n=',this%lastexecutedtimestep call print11(this%control%layoutnumber,dubuf) endif endif #else close (14) - write(dubuf,*) 'Incoherence between MPI saved steps for resuming.',dummyMin,dummyMax,lastexecutedtimestep + write(dubuf,*) 'Incoherence between MPI saved steps for resuming.',dummyMin,dummyMax,this%lastexecutedtimestep call stoponerror (this%control%layoutnumber,this%control%size,dubuf,.true.) !para que retorne call Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh,this%thereare,this%control%wiresflavor ) return #endif endif #endif - initialtimestep=lastexecutedtimestep+1 - tiempoinicial = lastexecutedtime - write(dubuf,*) '[OK] processing resuming data. Last executed time step ',lastexecutedtimestep + this%initialtimestep=this%lastexecutedtimestep+1 + write(dubuf,*) '[OK] processing resuming data. Last executed time step ',this%lastexecutedtimestep call print11(this%control%layoutnumber,dubuf) endif - if (initialtimestep>this%control%finaltimestep) then + + if (this%initialtimestep>this%control%finaltimestep) then call stoponerror (this%control%layoutnumber,this%control%size,'Initial time step greater than final one',.true.) !para que retorne call Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh,this%thereare,this%control%wiresflavor ) return endif !!!incializa el vector de tiempos para permit scaling 191118 - call crea_timevector(sgg,lastexecutedtimestep,this%control%finaltimestep,lastexecutedtime) + call crea_timevector(sgg,this%lastexecutedtimestep,this%control%finaltimestep,this%lastexecutedtime) !!!!!!!!!!!!!!!!!!!!! -!fin lo cambio aqui - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! Updating Ca, Cbfficients calculation - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!correct possible paddings of Composites - !debe ir aqui pq los gm1 y gm2 se obtienen aqui - - if (abs(this%control%attfactorc-1.0_RKIND) > 1.0e-12_RKIND) then - hayattmedia=.false. - attinformado=.false. - do i=1,sgg%nummedia - if (sgg%Med(i)%Is%MultiportPadding) then - sgg%Med(i)%SigmaM =(-2.0_RKIND * (-1.0_RKIND + this%control%attfactorc)*mu0)/((1 + this%control%attfactorc)*sgg%dt) - hayattmedia=.true. - endif - deltaespmax=max(max(maxval(sgg%dx),maxval(sgg%dy)),maxval(sgg%dz)) - if (hayattmedia.and. .not. attinformado) then - !!!!info on stabilization - epr =1.0_RKIND - mur =1.0_RKIND - !! - write(buff,'(a,2e10.2e3)') ' Composites stabilization att. factor=',this%control%attfactorc,sgg%Med(i)%SigmaM - - call WarnErrReport(buff) - !! - fmax=1.0_RKIND / (10.0_RKIND * sgg%dt) - skin_depth=1.0_RKIND / (Sqrt(2.0_RKIND)*fmax*Pi*(epr*Eps0**2*(4*mur*mu0**2.0_RKIND + sgg%Med(i)%Sigmam**2/(fmax**2*Pi**2.0_RKIND )))**0.25_RKIND * & - Sin(atan2(2*Pi*epr*Eps0*mur*mu0, - (epr*eps0*sgg%Med(i)%Sigmam)/fmax)/2.0_RKIND)) - write(buff,'(a,e9.2e2,a,e10.2e3)') ' At 10 samp/per f=',fmax,',Max Att(dB)=', & - -(0.0001295712360834271997*AIMAG(fmax*Sqrt((epr*((0,-2.825225e7) + & - 8.8757061047382236e6*mur + this%control%attfactorc*((0,2.825225e7) + 8.8757061047382236e6*mur)))/ & - (1.124121310242e12 + 1.124121310242e12*this%control%attfactorc))*min(deltaespmax,skin_depth))) - if (this%control%layoutnumber == 0) call WarnErrReport(buff) - if (fmax > 3e9) then - fmax=3e9 - write(buff,'(a,e9.2e2,a,e10.2e3)') ' At f=',fmax,',Max Att(dB)=', & - -(0.0001295712360834271997*AIMAG(fmax*Sqrt((epr*((0,-2.825225e7) + & - 8.8757061047382236e6*mur + this%control%attfactorc*((0,2.825225e7) + 8.8757061047382236e6*mur)))/ & - (1.124121310242e12 + 1.124121310242e12*this%control%attfactorc))*min(deltaespmax,skin_depth))) - if (this%control%layoutnumber == 0) call WarnErrReport(buff) - endif - attinformado=.true. - endif - end do - endif - - - !thin wires ! - if (abs(this%control%attfactorw-1.0_RKIND) > 1.0e-12_RKIND) then - attinformado=.false. - do i=1,sgg%nummedia - if (sgg%Med(i)%Is%ThinWire) then - sgg%Med(i)%Sigma =(-2.0_RKIND * (-1.0_RKIND + this%control%attfactorw)*eps0)/((1 + this%control%attfactorw)*sgg%dt) - if (.not.attinformado) then - write(buff,'(a,2e10.2e3)') ' WIREs stabilization att. factors=',this%control%attfactorw,sgg%Med(i)%Sigma - if (this%control%layoutnumber == 0) call WarnErrReport(buff) - attinformado=.true. - endif - endif - end do - endif - - +! !fin lo cambio aqui -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!usa el modulo p_rescale para encontrar el g1, g2 etc con los parametros resumeados correctos + call updateSigmaM(attinformado) + call updateThinWiresSigma(attinformado) call calc_G1G2Gm1Gm2(sgg,G1,G2,Gm1,Gm2,eps0,mu0) -!!!Ojo este era el orden: findconstants y despues la correccion siguiente del attfactorw - - if (abs(this%control%attfactorw-1.0_RKIND) > 1.0e-12_RKIND) then - do i=1,sgg%nummedia - !thin wires - if (sgg%Med(i)%Is%ThinWire) then - sgg%Med(i)%Sigma = 0.0_RKIND !revert!!! !necesario para no lo tome como un lossy luego en wires !solo se toca el g1,g2 - endif - end do - endif + call revertThinWiresSigma() ! #ifdef CompileWithMPI @@ -583,33 +574,7 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi #endif write(dubuf,*) 'Init Reporting...'; call print11(this%control%layoutnumber,dubuf) call InitReporting(sgg,this%control) - if ((this%control%layoutnumber == 0).and.this%control%verbose) then - write(buff,'(a,3e9.2e2)') 'CPML alpha, alphaorder, kappa factors= ', this%control%alphamaxpar,this%control%alphaOrden,this%control%kappamaxpar - call WarnErrReport(buff) - if (this%control%medioextra%exists) then - write(buff,'(a,i5,e9.2e2)') 'CPML correction size,factor to scale sigmamax = ', & - this%control%medioextra%size,this%control%medioextra%sigma - call WarnErrReport(buff) - endif - write(buff,*) 'saveall=',this%control%saveall,', flushsecondsFields=',this%control%flushsecondsFields,', flushsecondsData=',this%control%flushsecondsData,', maxCPUtime=',this%control%maxCPUtime,', singlefilewrite=',this%control%singlefilewrite - call WarnErrReport(buff) - write(buff,*) 'TAPARRABOS=',this%control%TAPARRABOS,', wiresflavor=',trim(adjustl(this%control%wiresflavor)),', mindistwires=',this%control%mindistwires,', wirecrank=',this%control%wirecrank , 'makeholes=',this%control%makeholes - call WarnErrReport(buff) - write(buff,*) 'use_mtln_wires=', this%control%use_mtln_wires - write(buff,*) 'connectendings=',this%control%connectendings,', isolategroupgroups=',this%control%isolategroupgroups - call WarnErrReport(buff) - write(buff,*) 'wirethickness ', this%control%wirethickness, 'stableradholland=',this%control%stableradholland,'mtlnberenger=',this%control%mtlnberenger,' inductance_model=',trim(adjustl(this%control%inductance_model)), & - ', inductance_order=',this%control%inductance_order,', groundwires=',this%control%groundwires,' ,fieldtotl=',this%control%fieldtotl,' noSlantedcrecepelo =',this%control%noSlantedcrecepelo - call WarnErrReport(buff) - write(buff,*) 'sgbc=',this%control%sgbc,', mibc=',this%control%mibc,', attfactorc=',this%control%attfactorc,', attfactorw=',this%control%attfactorw - call WarnErrReport(buff) - write(buff,*) 'NOcompomur=',this%control%NOcompomur,', ADE=',this%control%ADE,', conformalskin=',this%control%conformalskin,', sgbcFreq=',this%control%sgbcFreq,', sgbcresol=',this%control%sgbcresol,', sgbccrank=',this%control%sgbccrank,', sgbcDepth=',this%control%sgbcdepth - call WarnErrReport(buff) - write(buff,*) 'mur_second=',this%control%mur_second,', murafterpml=',this%control%murafterpml,', facesNF2FF%tr=',this%control%facesNF2FF%tr,', facesNF2FF%fr=',this%control%facesNF2FF%fr,', facesNF2FF%iz=',this%control%facesNF2FF%iz - call WarnErrReport(buff) - write(buff,*) 'facesNF2FF%de=',this%control%facesNF2FF%de,', facesNF2FF%ab=',this%control%facesNF2FF%ab,', facesNF2FF%ar=',this%control%facesNF2FF%ar,', NF2FFDecim=',this%control%NF2FFDecim - call WarnErrReport(buff) - endif + call reportSimulationOptions() #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) @@ -619,2276 +584,2189 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - write(dubuf,*) 'Init Other Borders...'; call print11(this%control%layoutnumber,dubuf) - call InitOtherBorders (sgg,this%thereAre) - l_auxinput=this%thereAre%PECBorders.or.this%thereAre%PMCBorders.or.this%thereAre%PeriodicBorders - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 PEC, PMC or periodic Borders'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no PEC, PMC or periodic Borders found'; call print11(this%control%layoutnumber,dubuf) - endif - -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init CPML Borders...'; call print11(this%control%layoutnumber,dubuf) - call InitCPMLBorders (sgg,SINPML_Fullsize,this%thereAre%PMLBorders,this%control, & - dxe,dye,dze,dxh,dyh,dzh,Idxe,Idye,Idze,Idxh,Idyh,Idzh,eps0,mu0) - l_auxinput=this%thereAre%PMLBorders - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 CPML Borders'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no CPML Borders found'; call print11(this%control%layoutnumber,dubuf) - endif + call initializeBorders() + call initializeLumped() + call initializeWires() + call initializeAnisotropic() + call initializeSGBC() + call initializeMultiports() + call initializeConformalElements() + + call initializeEDispersives() + call initializeMDispersives() + call initializePlanewave() + call initializeNodalSources() + call fillMtag(sgg, this%sggMiEx, this%sggMiEy, this%sggMiEz, this%sggMiHx, this%sggMiHy, this%sggMiHz,this%sggMtag, this%bounds, tag_numbers) + call initializeObservation() + + !!!!voy a jugar con fuego !!!210815 sincronizo las matrices de medios porque a veces se precisan. Reutilizo rutinas viejas mias NO CRAY. Solo se usan aqui + !MPI initialization #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init PML Bodies...'; call print11(this%control%layoutnumber,dubuf) - call InitPMLbodies(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,Ex,Ey,Ez,Hx,Hy,Hz,IDxe,IDye,IDze,IDxh,IDyh,IDzh,g2,Gm2,this%thereAre%PMLbodies,this%control,eps0,mu0) - l_auxinput=this%thereAre%PMLbodies - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 PML Bodies'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no PML Bodies found'; call print11(this%control%layoutnumber,dubuf) - endif -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) + call initializeMPI() #endif - write(dubuf,*) 'Init Mur Borders...'; call print11(this%control%layoutnumber,dubuf) - call InitMURBorders (sgg,this%thereAre%MURBorders,this%control%resume,Idxh,Idyh,Idzh,eps0,mu0) - l_auxinput= this%thereAre%MURBorders - l_auxoutput=l_auxinput + #ifdef CompileWithMPI 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 Mur Borders'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Mur Borders found'; call print11(this%control%layoutnumber,dubuf) - endif - !Initborders must be called in first place . Double check that Idxe,h are not needed by other initialization modules - !llamalo antes de sgbc y composites, porque overrideo nodos sgbc conectados a hilos + if (this%control%resume) close (14) + ! + this%n=this%initialtimestep + this%ini_save = this%initialtimestep + this%n_info = 5 + this%initialtimestep - !init lumped debe ir antes de wires porque toca la conductividad del material !mmmm ojoooo 120123 - write(dubuf,*) 'Init Lumped Elements...'; call print11(this%control%layoutnumber,dubuf) - CALL InitLumped(sgg,sggMiEx,sggMiEy,sggMiEz,Ex,Ey,Ez,Hx,Hy,Hz,IDxe,IDye,IDze,IDxh,IDyh,IDzh,this%control,this%thereAre%Lumpeds,eps0,mu0) - l_auxinput=this%thereAre%Lumpeds - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 lumped elements'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no lumped Structured elements found'; call print11(this%control%layoutnumber,dubuf) - endif - - ! one more MM for right adjancencies - dtcritico=sgg%dt - if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & - (trim(adjustl(this%control%wiresflavor))=='transition')) then -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Holland Wires...'; call print11(this%control%layoutnumber,dubuf) - call InitWires (sgg,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & - this%thereAre%Wires, Ex,Ey,Ez,Hx,Hy,Hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh, & - g2,SINPML_fullsize, fullsize,dtcritico,eps0,mu0,this%control) - l_auxinput=this%thereAre%Wires - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 Holland/transition wires'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Holland/transition wires found'; call print11(this%control%layoutnumber,dubuf) - endif - endif + write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) + call InitTiming(sgg, this%control, this%control%time_desdelanzamiento, this%initialtimestep, this%control%maxSourceValue) -#ifdef CompileWithBerengerWires - if (trim(adjustl(this%control%wiresflavor))=='berenger') then -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Multi-Wires...'; call print11(this%control%layoutnumber,dubuf) - call InitWires_Berenger(sgg,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,this%control%layoutnumber,this%control%size,this%thereAre%Wires,this%control%resume,this%control%makeholes, & - this%control%isolategroupgroups,this%control%mtlnberenger,this%control%mindistwires, & - this%control%groundwires,this%control%taparrabos,Ex,Ey,Ez, & - Idxe,Idye,Idze,Idxh,Idyh,Idzh,this%control%inductance_model,g2,SINPML_fullsize,fullsize,dtcritico,eps0,mu0,this%control%verbose) - l_auxinput= this%thereAre%Wires - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 Multi-wires'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Multi-wires found'; call print11(this%control%layoutnumber,dubuf) - endif - endif -#endif -#ifdef CompileWithSlantedWires - if((trim(adjustl(this%control%wiresflavor))=='slanted').or.(trim(adjustl(this%control%wiresflavor))=='semistructured')) then + CALL CLOSEWARNINGFILE(this%control%layoutnumber,this%control%size,this%control%fatalerror,.false.,this%control%simu_devia) !aqui ya esta dividido el stochastic y hay dos this%control%layoutnumber=0 -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Slanted Wires...'; call print11(this%control%layoutnumber,dubuf) - if ((trim(adjustl(this%control%wiresflavor))=='semistructured')) then - write(dubuf,*) '...',this%control%precision; call print11(this%control%layoutnumber,dubuf) - call estructura_slanted(sgg,this%control%precision) - else -!!!does not work -!!!! precision=0 -!!!! call estructura_slanted(sgg,precision) - continue - endif - call InitWires_Slanted(sgg, this%control%layoutnumber,this%control%size, Ex, Ey, Ez, & - Idxe, Idye, Idze, Idxh, Idyh, Idzh, & - sggMiNo, & - sggMiEx, sggMiEy, sggMiEz, & - sggMiHx, sggMiHy, sggMiHz, & - this%thereAre%Wires, this%control%resume, & - this%control%mindistwires, this%control%groundwires,this%control%noSlantedcrecepelo , & - this%control%inductance_model, this%control%inductance_order, & - g2, SINPML_fullsize, dtcritico,eps0,mu0,this%control%verbose) - l_auxinput=this%thereAre%Wires - l_auxoutput=l_auxinput -!check for MUR1 nodes sgg 230124 - call init_murABC_slanted(sgg,SINPML_Fullsize,eps0,mu0) -!!!!!! -#ifdef CompileWithMPI - 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 Slanted wires'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Slanted wires found'; call print11(this%control%layoutnumber,dubuf) - endif - endif -#endif - !!!sincroniza el dtcritico -#ifdef CompileWithMPI - call MPI_AllReduce( dtcritico, newdtcritico, 1_4, REALSIZE, MPI_MIN, SUBCOMM_MPI, ierr) - dtcritico=newdtcritico -#endif - if (sgg%dt <= dtcritico) then - write(buff,'(a,e10.2e3)') 'WIR_INFO: deltat for stability OK: ',dtcritico - if ((this%control%layoutnumber==0).and.this%control%verbose) call WarnErrReport(buff) - else - if (.not.(this%control%resume.and.this%control%permitscaling)) then !no abortasr solo advertir si permittivity scaling - write(buff,'(a,e10.2e3)') 'WIR_ERROR: Possibly UNSTABLE dt, decrease wire radius, number of parallel WIREs, use -stableradholland or make dt < ',dtcritico - if (this%control%layoutnumber==0) call WarnErrReport(buff,.true.) - else - write(buff,'(a,e10.2e3)') 'WIR_WARNING: Resume and Pscaling with wires. Possibly UNSTABLE dt, decrease wire radius, number of parallel WIREs: dt is over ',dtcritico - if (this%control%layoutnumber==0) call WarnErrReport(buff,.false.) - endif + if (this%control%fatalerror) then + dubuf='FATAL ERRORS. Revise *Warnings.txt file. ABORTING...' + call stoponerror(this%control%layoutnumber,this%control%size,dubuf,.true.) !para que retorne + call Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh,this%thereare,this%control%wiresflavor ) + return endif - !!! -!! - if (this%control%use_mtln_wires) then -#ifdef CompileWithMTLN #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init MTLN Wires...'; call print11(this%control%layoutnumber,dubuf) - call InitWires_mtln(sgg,Ex,Ey,Ez,Idxh,Idyh,Idzh,eps0, mu0, mtln_parsed,this%thereAre%MTLNbundles) -#else - write(buff,'(a)') 'WIR_ERROR: Executable was not compiled with MTLN modules.' + call flushMPIdata() #endif - endif - - !Anisotropic +!!!no se si el orden wires - sgbcs del sync importa 150519 #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Anisotropic...'; call print11(this%control%layoutnumber,dubuf) - call InitAnisotropic(sgg,sggmiex,sggmiey,sggmiez,sggMiHx ,sggMiHy ,sggMiHz,this%thereAre%Anisotropic,this%thereAre%ThinSlot,eps0,mu0) - l_auxinput=this%thereAre%Anisotropic.or.this%thereAre%ThinSlot - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - call MPI_COMM_RANK(SUBCOMM_MPI, rank, ierr) - 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(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Structured anisotropic elements found'; call print11(this%control%layoutnumber,dubuf) - endif - - IF (this%control%sgbc) then -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Multi sgbc...'; call print11(this%control%layoutnumber,dubuf) - call Initsgbcs(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,Ex,Ey,Ez,Hx,Hy,Hz,IDxe,IDye,IDze,IDxh,IDyh,IDzh,this%control%layoutnumber,this%control%size, & - G1,G2,GM1,GM2,this%thereAre%sgbcs,this%control%resume,this%control%sgbccrank,this%control%sgbcFreq,this%control%sgbcresol,this%control%sgbcdepth,this%control%sgbcDispersive,eps0,mu0,this%control%simu_devia,this%control%stochastic) - l_auxinput= this%thereAre%sgbcs - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 sgbc elements'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Structured sgbc elements found'; call print11(this%control%layoutnumber,dubuf) - endif - endif - -!!!! -#ifdef CompileWithNIBC - IF (this%control%mibc) then -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Multiports...'; call print11(this%control%layoutnumber,dubuf) - call InitMultiports (sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx ,sggMiHy ,sggMiHz,this%control%layoutnumber,this%control%size,this%thereAre%Multiports,this%control%resume, & - Idxe,Idye,Idze,this%control%NOcompomur,this%control%AD,%this%control%cfl,eps0,mu0) - l_auxinput= this%thereAre%Multiports - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 multiport elements'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Structured multiport elements found'; call print11(this%control%layoutnumber,dubuf) - endif - endif -#endif - - ![conformal] ##ref## - !poner aqui mi inicializador de campos... - !todo aquello que dependa sgg%dt - !************************************************************************************************** - !***[conformal] ******************************************************************* - !************************************************************************************************** - !--->[conformal](initiaizate memory EM fields)----------------------------------------------------- - !ref: ##conf_timestepping_memory_ini## -#ifdef CompileWithConformal - if(input_conformal_flag)then -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Conformal Elements ...'; call print11(this%control%layoutnumber,dubuf) -!WIP -!DEBUG - call initialize_memory_FDTD_conf_fields (sgg,sggMiEx, & - & sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,Ex,Ey,Ez,Hx,Hy,Hz,& - & this%control%layoutnumber,this%control%size, this%control%verbose); - l_auxinput=input_conformal_flag - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) - call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) -#endif - ! refactor JUN2015 - - !!!!!!!sgg 051214 !rellena correctamente los campos magneticos. Necesario para construir los surfaces a partir del wireframe - ! call fillMagnetic(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz, b) - !!!!!!!ojo solo es valido para PEC!!!! cambiar luego !!?!?!?!?!? - if (l_auxoutput ) then - write (dubuf,*) '----> there are conformal elements'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no conformal elements found'; call print11(this%control%layoutnumber,dubuf) - end if - endif -#endif - -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init EDispersives...'; call print11(this%control%layoutnumber,dubuf) - call InitEDispersives(sgg,sggMiEx,sggMiEy,sggMiEz,this%thereAre%EDispersives,this%control%resume,g1,g2,ex,ey,ez) - l_auxinput=this%thereAre%EDispersives - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 Electric dispersive elements'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Structured Electric dispersive elements found'; call print11(this%control%layoutnumber,dubuf) - endif -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init MDispersives...'; call print11(this%control%layoutnumber,dubuf) - call InitMDispersives(sgg,sggMiHx,sggMiHy,sggMiHz,this%thereAre%MDispersives,this%control%resume,gm1,gm2,hx,hy,hz) - l_auxinput=this%thereAre%MDispersives - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 Magnetic dispersive elements'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Structured Magnetic dispersive elements found'; call print11(this%control%layoutnumber,dubuf) - endif - -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Multi Plane-Waves...'; call print11(this%control%layoutnumber,dubuf) - call InitPlaneWave (sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,this%control%layoutnumber,this%control%size,SINPML_fullsize,this%thereAre%PlaneWaveBoxes,this%control%resume,eps0,mu0) - - l_auxinput=this%thereAre%PlaneWaveBoxes - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 Plane Wave'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Plane waves are found'; call print11(this%control%layoutnumber,dubuf) - endif - -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Nodal Sources...'; call print11(this%control%layoutnumber,dubuf) - if (.not.this%control%hopf) then - call InitNodalSources(sgg,this%control%layoutnumber,sgg%NumNodalSources,sgg%NodalSource,sgg%Sweep,this%thereAre%NodalE,this%thereAre%NodalH) - else - call InitHopf(sgg,sgg%NumNodalSources,sgg%NodalSource,sgg%Sweep,this%control%ficherohopf) !lo manejara antonio con las entradas que precise - this%thereAre%NodalE=.false. !no habra mas nodales excepto la de Hopf - this%thereAre%NodalH=.false. - endif - - l_auxinput=this%thereAre%NodalH.or.this%thereAre%NodalE - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 Nodal sources'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no Structured Nodal sources are found'; call print11(this%control%layoutnumber,dubuf) - endif - - !!!!!!!sgg 121020 !rellena la matriz Mtag con los slots de una celda - call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) - !!!!!!!fin - -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init Observation...'; call print11(this%control%layoutnumber,dubuf) - call InitObservation (sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag,tag_numbers, & - this%thereAre%Observation,this%thereAre%wires,this%thereAre%FarFields,this%control%resume,initialtimestep,this%control%finaltimestep,lastexecutedtime, & - this%control%nentradaroot,this%control%layoutnumber,this%control%size,this%control%saveall,this%control%singlefilewrite,this%control%wiresflavor,& - SINPML_FULLSIZE,this%control%facesNF2FF,this%control%NF2FFDecim,eps0,mu0,this%control%simu_devia,this%control%mpidir,this%control%niapapostprocess,b) - l_auxinput=this%thereAre%Observation.or.this%thereAre%FarFields - l_auxoutput=l_auxinput -#ifdef CompileWithMPI - 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 observation requests'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no observation requests are found'; call print11(this%control%layoutnumber,dubuf) - endif - !observation must be the last one to initialize - -!!!!voy a jugar con fuego !!!210815 sincronizo las matrices de medios porque a veces se precisan. Reutilizo rutinas viejas mias NO CRAY. Solo se usan aqui -#ifdef CompileWithMPI - !MPI initialization - if (this%control%size>1) then -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) 'Init MPI MediaMatrix flush...'; call print11(this%control%layoutnumber,dubuf) - call InitMPI(sgg%sweep,sgg%alloc) - call MPI_Barrier(SUBCOMM_MPI,ierr) - !write(dubuf,*) trim(adjustl(whoami))//' [OK]'; call print11(this%control%layoutnumber,dubuf,.true.) - !write(dubuf,*) trim(adjustl(whoami))//' Init MPI Extra flushings...'; call print11(this%control%layoutnumber,dubuf,.true.) - call InitExtraFlushMPI(this%control%layoutnumber,sgg%sweep,sgg%alloc,sgg%med,sgg%nummedia,sggmiEz,sggMiHz) - call MPI_Barrier(SUBCOMM_MPI,ierr) - !write(dubuf,*) trim(adjustl(whoami))//' [OK]'; call print11(this%control%layoutnumber,dubuf,.true.) - !write(dubuf,*) trim(adjustl(whoami))//' First MPI H flushing...'; call print11(this%control%layoutnumber,dubuf,.true.) - call FlushMPI_H(sgg%alloc,this%control%layoutnumber,this%control%size, sggmiHx,sggmiHy,sggmiHz) - call MPI_Barrier(SUBCOMM_MPI,ierr) - !write(dubuf,*) trim(adjustl(whoami))//' [OK]'; call print11(this%control%layoutnumber,dubuf,.true.) - !write(dubuf,*) trim(adjustl(whoami))//' First MPI E flushing...'; call print11(this%control%layoutnumber,dubuf,.true.) - call FlushMPI_E(sgg%alloc,this%control%layoutnumber,this%control%size, sggmiEx,sggmiEy,sggmiEz) - call MPI_Barrier(SUBCOMM_MPI,ierr) -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) - endif -#endif -!!!!!!!!!!!!!!!se supone que la inicializacion de Cray machacara luego a esta que solo uso para flushear medios (lo preciso en sgbcs de momento, pero es bueno tener esta info) -!!!!!!!!!!!!!!!!!!!!!fin juego con fuego 210815 - -#ifdef CompileWithMPI - !MPI initialization - if (this%control%size>1) then - write(dubuf,*) 'Init MPI Cray...'; call print11(this%control%layoutnumber,dubuf) - call InitMPI_Cray(this%control%layoutnumber,this%control%size,sgg%sweep,sgg%alloc, & - sgg%Border%IsDownPeriodic,sgg%Border%IsUpPeriodic, & - Ex,Ey,Ez,Hx,Hy,Hz) - call MPI_Barrier(SUBCOMM_MPI,ierr) - write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) - - !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(this%control%wiresflavor))=='holland') .or. & - (trim(adjustl(this%control%wiresflavor))=='transition') .or. & - this%control%use_mtln_wires) then - write(dubuf,*) 'Init MPI Holland Wires...'; call print11(this%control%layoutnumber,dubuf) - call newInitWiresMPI(this%control%layoutnumber,this%thereAre%wires,this%control%size,this%control%resume,sgg%sweep) - call MPI_Barrier(SUBCOMM_MPI,ierr) - write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) - endif - -#ifdef CompileWithBerengerWires - if (trim(adjustl(this%control%wiresflavor))=='berenger') then - write(dubuf,*) 'Init MPI Multi-Wires...'; call print11(this%control%layoutnumber,dubuf) - call InitWiresMPI_Berenger(this%control%layoutnumber,this%thereAre%wires,this%control%size,this%control%resume,sgg%sweep) - call MPI_Barrier(SUBCOMM_MPI,ierr) - write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) - endif -#endif - !llamalo siempre para forzar los flush extra en caso de materiales anisotropos o multiport - write(dubuf,*) 'Init Extra Flush MPI...'; call print11(this%control%layoutnumber,dubuf) - call InitExtraFlushMPI_Cray(this%control%layoutnumber,sgg%sweep,sgg%alloc,sgg%Med,sgg%NumMedia,sggMiez,sggMiHz, & - Ex,Ey,Ez,Hx,Hy,Hz,this%thereAre%MURBorders) - call MPI_Barrier(SUBCOMM_MPI,ierr) - write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) +#ifdef CompileWithStochastic + if (this%control%stochastic) then + call syncstoch_mpi_sgbcs(this%control%simu_devia,this%control%layoutnumber,this%control%size) + call syncstoch_mpi_lumped(this%control%simu_devia,this%control%layoutnumber,this%control%size) endif -#endif - +#endif +#endif - !must be called now in case the MPI has changed the connectivity info - if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & - (trim(adjustl(this%control%wiresflavor))=='transition')) then - call ReportWireJunctions(this%control%layoutnumber,this%control%size,this%thereAre%wires,sgg%Sweep(iHz)%ZI, sgg%Sweep(iHz)%ZE,this%control%groundwires,this%control%strictOLD,this%control%verbose) - endif + call printSimulationStart() + +contains -#ifdef CompileWithBerengerWires - if (trim(adjustl(this%control%wiresflavor))=='berenger') then - call ReportWireJunctionsBerenger(this%control%layoutnumber,this%control%size,this%thereAre%wires,sgg%Sweep(iHz)%ZI, sgg%Sweep(iHz)%ZE,this%control%groundwires,this%control%strictOLD,this%control%verbose) - !dama no tenia el equivalente 050416 - endif -#endif -#ifdef CompileWithSlantedWires - if ((trim(adjustl(this%control%wiresflavor))=='slanted').or.(trim(adjustl(this%control%wiresflavor))=='semistructured')) then - continue - endif -#endif + subroutine findbounds(sgg,b) + ! + type (SGGFDTDINFO), intent(IN) :: sgg + type (bounds_t), intent(out) :: b + ! - -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif + !No tocar. Dejar como estan alocateados + b%dxe%XI=sgg%alloc(iHx)%XI + b%dxe%XE=sgg%alloc(iHx)%XE + b%dye%YI=sgg%alloc(iHy)%YI + b%dye%YE=sgg%alloc(iHy)%YE + b%dze%ZI=sgg%alloc(iHz)%ZI + b%dze%ZE=sgg%alloc(iHz)%ZE + ! + b%dxh%XI=sgg%alloc(iEx)%XI + b%dxh%XE=sgg%alloc(iEx)%XE + b%dyh%YI=sgg%alloc(iEy)%YI + b%dyh%YE=sgg%alloc(iEy)%YE + b%dzh%ZI=sgg%alloc(iEz)%ZI + b%dzh%ZE=sgg%alloc(iEz)%ZE - if (this%control%resume) close (14) - ! - n=initialtimestep - ini_save = initialtimestep - n_info = 5 + initialtimestep - ! -! if (verbose) call ReportExistence(sgg,this%control%layoutnumber,size, thereare,mur_second,MurAfterPML) + ! + !No tocar. Dejar como estan alocateados + b%Ex%XI=sgg%Alloc(iEx)%XI + b%Ex%XE=sgg%Alloc(iEx)%XE + b%Ey%XI=sgg%Alloc(iEy)%XI + b%Ey%XE=sgg%Alloc(iEy)%XE + b%Ez%XI=sgg%Alloc(iEz)%XI + b%Ez%XE=sgg%Alloc(iEz)%XE + ! + b%Hx%XI=sgg%Alloc(iHx)%XI + b%Hx%XE=sgg%Alloc(iHx)%XE + b%Hy%XI=sgg%Alloc(iHy)%XI + b%Hy%XE=sgg%Alloc(iHy)%XE + b%Hz%XI=sgg%Alloc(iHz)%XI + b%Hz%XE=sgg%Alloc(iHz)%XE + ! + b%Ex%YI=sgg%Alloc(iEx)%YI + b%Ex%YE=sgg%Alloc(iEx)%YE + b%Ey%YI=sgg%Alloc(iEy)%YI + b%Ey%YE=sgg%Alloc(iEy)%YE + b%Ez%YI=sgg%Alloc(iEz)%YI + b%Ez%YE=sgg%Alloc(iEz)%YE + ! + b%Hx%YI=sgg%Alloc(iHx)%YI + b%Hx%YE=sgg%Alloc(iHx)%YE + b%Hy%YI=sgg%Alloc(iHy)%YI + b%Hy%YE=sgg%Alloc(iHy)%YE + b%Hz%YI=sgg%Alloc(iHz)%YI + b%Hz%YE=sgg%Alloc(iHz)%YE + ! + b%Ex%ZI=sgg%Alloc(iEx)%ZI + b%Ex%ZE=sgg%Alloc(iEx)%ZE + b%Ey%ZI=sgg%Alloc(iEy)%ZI + b%Ey%ZE=sgg%Alloc(iEy)%ZE + b%Ez%ZI=sgg%Alloc(iEz)%ZI + b%Ez%ZE=sgg%Alloc(iEz)%ZE + ! + b%Hx%ZI=sgg%Alloc(iHx)%ZI + b%Hx%ZE=sgg%Alloc(iHx)%ZE + b%Hy%ZI=sgg%Alloc(iHy)%ZI + b%Hy%ZE=sgg%Alloc(iHy)%ZE + b%Hz%ZI=sgg%Alloc(iHz)%ZI + b%Hz%ZE=sgg%Alloc(iHz)%ZE + ! + ! + ! + !matrix indexes. Nothing to change. Asi estan alocateados + b%sggMiEx%XI=sgg%Alloc(iEx)%XI + b%sggMiEx%XE=sgg%Alloc(iEx)%XE + b%sggMiEy%XI=sgg%Alloc(iEy)%XI + b%sggMiEy%XE=sgg%Alloc(iEy)%XE + b%sggMiEz%XI=sgg%Alloc(iEz)%XI + b%sggMiEz%XE=sgg%Alloc(iEz)%XE + ! + b%sggMiHx%XI=sgg%Alloc(iHx)%XI + b%sggMiHx%XE=sgg%Alloc(iHx)%XE + b%sggMiHy%XI=sgg%Alloc(iHy)%XI + b%sggMiHy%XE=sgg%Alloc(iHy)%XE + b%sggMiHz%XI=sgg%Alloc(iHz)%XI + b%sggMiHz%XE=sgg%Alloc(iHz)%XE + ! + b%sggMiEx%YI=sgg%Alloc(iEx)%YI + b%sggMiEx%YE=sgg%Alloc(iEx)%YE + b%sggMiEy%YI=sgg%Alloc(iEy)%YI + b%sggMiEy%YE=sgg%Alloc(iEy)%YE + b%sggMiEz%YI=sgg%Alloc(iEz)%YI + b%sggMiEz%YE=sgg%Alloc(iEz)%YE + ! + b%sggMiHx%YI=sgg%Alloc(iHx)%YI + b%sggMiHx%YE=sgg%Alloc(iHx)%YE + b%sggMiHy%YI=sgg%Alloc(iHy)%YI + b%sggMiHy%YE=sgg%Alloc(iHy)%YE + b%sggMiHz%YI=sgg%Alloc(iHz)%YI + b%sggMiHz%YE=sgg%Alloc(iHz)%YE + ! + b%sggMiEx%ZI=sgg%Alloc(iEx)%ZI + b%sggMiEx%ZE=sgg%Alloc(iEx)%ZE + b%sggMiEy%ZI=sgg%Alloc(iEy)%ZI + b%sggMiEy%ZE=sgg%Alloc(iEy)%ZE + b%sggMiEz%ZI=sgg%Alloc(iEz)%ZI + b%sggMiEz%ZE=sgg%Alloc(iEz)%ZE + ! + b%sggMiHx%ZI=sgg%Alloc(iHx)%ZI + b%sggMiHx%ZE=sgg%Alloc(iHx)%ZE + b%sggMiHy%ZI=sgg%Alloc(iHy)%ZI + b%sggMiHy%ZE=sgg%Alloc(iHy)%ZE + b%sggMiHz%ZI=sgg%Alloc(iHz)%ZI + b%sggMiHz%ZE=sgg%Alloc(iHz)%ZE + ! + ! + ! + b%sweepEx%XI=sgg%Sweep(iEx)%XI + b%sweepEx%XE=sgg%Sweep(iEx)%XE + b%sweepEy%XI=sgg%Sweep(iEy)%XI + b%sweepEy%XE=sgg%Sweep(iEy)%XE + b%sweepEz%XI=sgg%Sweep(iEz)%XI + b%sweepEz%XE=sgg%Sweep(iEz)%XE + ! + b%sweepHx%XI=sgg%Sweep(iHx)%XI + b%sweepHx%XE=sgg%Sweep(iHx)%XE + b%sweepHy%XI=sgg%Sweep(iHy)%XI + b%sweepHy%XE=sgg%Sweep(iHy)%XE + b%sweepHz%XI=sgg%Sweep(iHz)%XI + b%sweepHz%XE=sgg%Sweep(iHz)%XE + ! + ! + b%sweepEx%YI=sgg%Sweep(iEx)%YI + b%sweepEx%YE=sgg%Sweep(iEx)%YE + b%sweepEy%YI=sgg%Sweep(iEy)%YI + b%sweepEy%YE=sgg%Sweep(iEy)%YE + b%sweepEz%YI=sgg%Sweep(iEz)%YI + b%sweepEz%YE=sgg%Sweep(iEz)%YE + ! + b%sweepHx%YI=sgg%Sweep(iHx)%YI + b%sweepHx%YE=sgg%Sweep(iHx)%YE + b%sweepHy%YI=sgg%Sweep(iHy)%YI + b%sweepHy%YE=sgg%Sweep(iHy)%YE + b%sweepHz%YI=sgg%Sweep(iHz)%YI + b%sweepHz%YE=sgg%Sweep(iHz)%YE + ! + b%sweepEx%ZI=sgg%Sweep(iEx)%ZI + b%sweepEx%ZE=sgg%Sweep(iEx)%ZE + b%sweepEy%ZI=sgg%Sweep(iEy)%ZI + b%sweepEy%ZE=sgg%Sweep(iEy)%ZE + b%sweepEz%ZI=sgg%Sweep(iEz)%ZI + b%sweepEz%ZE=sgg%Sweep(iEz)%ZE + ! + b%sweepHx%ZI=sgg%Sweep(iHx)%ZI + b%sweepHx%ZE=sgg%Sweep(iHx)%ZE + b%sweepHy%ZI=sgg%Sweep(iHy)%ZI + b%sweepHy%ZE=sgg%Sweep(iHy)%ZE + b%sweepHz%ZI=sgg%Sweep(iHz)%ZI + b%sweepHz%ZE=sgg%Sweep(iHz)%ZE + ! + b%sweepSINPMLEx%XI=sgg%SINPMLSweep(iEx)%XI + b%sweepSINPMLEy%XI=sgg%SINPMLSweep(iEy)%XI + b%sweepSINPMLEz%XI=sgg%SINPMLSweep(iEz)%XI + b%sweepSINPMLHx%XI=sgg%SINPMLSweep(iHx)%XI + b%sweepSINPMLHy%XI=sgg%SINPMLSweep(iHy)%XI + b%sweepSINPMLHz%XI=sgg%SINPMLSweep(iHz)%XI + ! + b%sweepSINPMLEx%XE=sgg%SINPMLSweep(iEx)%XE + b%sweepSINPMLEy%XE=sgg%SINPMLSweep(iEy)%XE + b%sweepSINPMLEz%XE=sgg%SINPMLSweep(iEz)%XE + b%sweepSINPMLHx%XE=sgg%SINPMLSweep(iHx)%XE + b%sweepSINPMLHy%XE=sgg%SINPMLSweep(iHy)%XE + b%sweepSINPMLHz%XE=sgg%SINPMLSweep(iHz)%XE + ! + b%sweepSINPMLEx%YI=sgg%SINPMLSweep(iEx)%YI + b%sweepSINPMLEy%YI=sgg%SINPMLSweep(iEy)%YI + b%sweepSINPMLEz%YI=sgg%SINPMLSweep(iEz)%YI + b%sweepSINPMLHx%YI=sgg%SINPMLSweep(iHx)%YI + b%sweepSINPMLHy%YI=sgg%SINPMLSweep(iHy)%YI + b%sweepSINPMLHz%YI=sgg%SINPMLSweep(iHz)%YI + ! + b%sweepSINPMLEx%YE=sgg%SINPMLSweep(iEx)%YE + b%sweepSINPMLEy%YE=sgg%SINPMLSweep(iEy)%YE + b%sweepSINPMLEz%YE=sgg%SINPMLSweep(iEz)%YE + b%sweepSINPMLHx%YE=sgg%SINPMLSweep(iHx)%YE + b%sweepSINPMLHy%YE=sgg%SINPMLSweep(iHy)%YE + b%sweepSINPMLHz%YE=sgg%SINPMLSweep(iHz)%YE + ! + b%sweepSINPMLEx%ZI=sgg%SINPMLSweep(iEx)%ZI + b%sweepSINPMLEy%ZI=sgg%SINPMLSweep(iEy)%ZI + b%sweepSINPMLEz%ZI=sgg%SINPMLSweep(iEz)%ZI + b%sweepSINPMLHx%ZI=sgg%SINPMLSweep(iHx)%ZI + b%sweepSINPMLHy%ZI=sgg%SINPMLSweep(iHy)%ZI + b%sweepSINPMLHz%ZI=sgg%SINPMLSweep(iHz)%ZI + ! + b%sweepSINPMLEx%ZE=sgg%SINPMLSweep(iEx)%ZE + b%sweepSINPMLEy%ZE=sgg%SINPMLSweep(iEy)%ZE + b%sweepSINPMLEz%ZE=sgg%SINPMLSweep(iEz)%ZE + b%sweepSINPMLHx%ZE=sgg%SINPMLSweep(iHx)%ZE + b%sweepSINPMLHy%ZE=sgg%SINPMLSweep(iHy)%ZE + b%sweepSINPMLHz%ZE=sgg%SINPMLSweep(iHz)%ZE - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! For Timing - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) - call InitTiming(sgg, this%control, time_desdelanzamiento, Initialtimestep,maxSourceValue) + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !find lenghts + !this is automatic. Nothing to change + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + b%Ex%NX=b%Ex%XE-b%Ex%XI+1 + b%Ex%NY=b%Ex%YE-b%Ex%YI+1 + b%Ex%NZ=b%Ex%ZE-b%Ex%ZI+1 - !!!if (createmap) then - !!! call writemmdxf(this%control%layoutnumber,sgg,sggMiHx,sggMiHy,sggMiHz) - !!!endif - !!!CALL CLOSEdxfFILE(this%control%layoutnumber,size) - !!!!NO MORE WARNINGS SHOULD BE PRODUCED + b%Ey%NX=b%Ey%XE-b%Ey%XI+1 + b%Ey%NY=b%Ey%YE-b%Ey%YI+1 + b%Ey%NZ=b%Ey%ZE-b%Ey%ZI+1 - CALL CLOSEWARNINGFILE(this%control%layoutnumber,this%control%size,this%control%fatalerror,.false.,this%control%simu_devia) !aqui ya esta dividido el stochastic y hay dos this%control%layoutnumber=0 + b%Ez%NX=b%Ez%XE-b%Ez%XI+1 + b%Ez%NY=b%Ez%YE-b%Ez%YI+1 + b%Ez%NZ=b%Ez%ZE-b%Ez%ZI+1 + ! + b%Hx%NX=b%Hx%XE-b%Hx%XI+1 + b%Hx%NY=b%Hx%YE-b%Hx%YI+1 + b%Hx%NZ=b%Hx%ZE-b%Hx%ZI+1 + ! + b%Hy%NX=b%Hy%XE-b%Hy%XI+1 + b%Hy%NY=b%Hy%YE-b%Hy%YI+1 + b%Hy%NZ=b%Hy%ZE-b%Hy%ZI+1 + ! + b%Hz%NX=b%Hz%XE-b%Hz%XI+1 + b%Hz%NY=b%Hz%YE-b%Hz%YI+1 + b%Hz%NZ=b%Hz%ZE-b%Hz%ZI+1 + ! + ! + b%sweepEx%NX=b%sweepEx%XE-b%sweepEx%XI+1 + b%sweepEx%NY=b%sweepEx%YE-b%sweepEx%YI+1 + b%sweepEx%NZ=b%sweepEx%ZE-b%sweepEx%ZI+1 + ! + b%sweepEy%NX=b%sweepEy%XE-b%sweepEy%XI+1 + b%sweepEy%NY=b%sweepEy%YE-b%sweepEy%YI+1 + b%sweepEy%NZ=b%sweepEy%ZE-b%sweepEy%ZI+1 + ! + b%sweepEz%NX=b%sweepEz%XE-b%sweepEz%XI+1 + b%sweepEz%NY=b%sweepEz%YE-b%sweepEz%YI+1 + b%sweepEz%NZ=b%sweepEz%ZE-b%sweepEz%ZI+1 + ! + b%sweepHx%NX=b%sweepHx%XE-b%sweepHx%XI+1 + b%sweepHx%NY=b%sweepHx%YE-b%sweepHx%YI+1 + b%sweepHx%NZ=b%sweepHx%ZE-b%sweepHx%ZI+1 + ! + b%sweepHy%NX=b%sweepHy%XE-b%sweepHy%XI+1 + b%sweepHy%NY=b%sweepHy%YE-b%sweepHy%YI+1 + b%sweepHy%NZ=b%sweepHy%ZE-b%sweepHy%ZI+1 + ! + b%sweepHz%NX=b%sweepHz%XE-b%sweepHz%XI+1 + b%sweepHz%NY=b%sweepHz%YE-b%sweepHz%YI+1 + b%sweepHz%NZ=b%sweepHz%ZE-b%sweepHz%ZI+1 + ! + ! + b%sggMiEx%NX=b%sggMiEx%XE-b%sggMiEx%XI+1 + b%sggMiEx%NY=b%sggMiEx%YE-b%sggMiEx%YI+1 + b%sggMiEx%NZ=b%sggMiEx%ZE-b%sggMiEx%ZI+1 + b%sggMiEy%NX=b%sggMiEy%XE-b%sggMiEy%XI+1 + b%sggMiEy%NY=b%sggMiEy%YE-b%sggMiEy%YI+1 + b%sggMiEy%NZ=b%sggMiEy%ZE-b%sggMiEy%ZI+1 + b%sggMiEz%NX=b%sggMiEz%XE-b%sggMiEz%XI+1 + b%sggMiEz%NY=b%sggMiEz%YE-b%sggMiEz%YI+1 + b%sggMiEz%NZ=b%sggMiEz%ZE-b%sggMiEz%ZI+1 + ! + b%sggMiHx%NX=b%sggMiHx%XE-b%sggMiHx%XI+1 + b%sggMiHx%NY=b%sggMiHx%YE-b%sggMiHx%YI+1 + b%sggMiHx%NZ=b%sggMiHx%ZE-b%sggMiHx%ZI+1 + b%sggMiHy%NX=b%sggMiHy%XE-b%sggMiHy%XI+1 + b%sggMiHy%NY=b%sggMiHy%YE-b%sggMiHy%YI+1 + b%sggMiHy%NZ=b%sggMiHy%ZE-b%sggMiHy%ZI+1 + b%sggMiHz%NX=b%sggMiHz%XE-b%sggMiHz%XI+1 + b%sggMiHz%NY=b%sggMiHz%YE-b%sggMiHz%YI+1 + b%sggMiHz%NZ=b%sggMiHz%ZE-b%sggMiHz%ZI+1 + ! + ! + !estas longitudes son relativas al layout !ojo + b%dxe%NX=b%dxe%XE-b%dxe%XI+1 + b%dye%NY=b%dye%YE-b%dye%YI+1 + b%dze%NZ=b%dze%ZE-b%dze%ZI+1 + ! + b%dxh%NX=b%dxh%XE-b%dxh%XI+1 + b%dyh%NY=b%dyh%YE-b%dyh%YI+1 + b%dzh%NZ=b%dzh%ZE-b%dzh%ZI+1 - if (this%control%fatalerror) then - dubuf='FATAL ERRORS. Revise *Warnings.txt file. ABORTING...' - call stoponerror(this%control%layoutnumber,this%control%size,dubuf,.true.) !para que retorne - call Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh,this%thereare,this%control%wiresflavor ) - return - endif + end subroutine -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) - !!Flush all the MPI data (needed a initial flush for correct resuming) - if (this%control%size>1) then - call MPI_Barrier(SUBCOMM_MPI,ierr) - call FlushMPI_H_Cray - endif - if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & - (trim(adjustl(this%control%wiresflavor))=='transition')) then - if ((this%control%size>1).and.(this%thereAre%wires)) then - call newFlushWiresMPI(this%control%layoutnumber,this%control%size) + subroutine updateSigmaM(att) + logical, intent(inout) :: att + real(kind=rkind) :: deltaespmax, fmax, skin_depth + logical :: hayattmedia = .false. + REAL (kind = rkind) :: mur,epr + character(len=BUFSIZE) :: buff + integer :: i + if (abs(this%control%attfactorc-1.0_RKIND) > 1.0e-12_RKIND) then + att=.false. + do i=1,sgg%nummedia + if (sgg%Med(i)%Is%MultiportPadding) then + sgg%Med(i)%SigmaM =(-2.0_RKIND * (-1.0_RKIND + this%control%attfactorc)*mu0)/((1 + this%control%attfactorc)*sgg%dt) + hayattmedia=.true. + endif + deltaespmax=max(max(maxval(sgg%dx),maxval(sgg%dy)),maxval(sgg%dz)) + if (hayattmedia.and. .not. att) then + !!!!info on stabilization + epr =1.0_RKIND + mur =1.0_RKIND + !! + write(buff,'(a,2e10.2e3)') ' Composites stabilization att. factor=',this%control%attfactorc,sgg%Med(i)%SigmaM + + call WarnErrReport(buff) + !! + fmax=1.0_RKIND / (10.0_RKIND * sgg%dt) + skin_depth=1.0_RKIND / (Sqrt(2.0_RKIND)*fmax*Pi*(epr*Eps0**2*(4*mur*mu0**2.0_RKIND + sgg%Med(i)%Sigmam**2/(fmax**2*Pi**2.0_RKIND )))**0.25_RKIND * & + Sin(atan2(2*Pi*epr*Eps0*mur*mu0, - (epr*eps0*sgg%Med(i)%Sigmam)/fmax)/2.0_RKIND)) + write(buff,'(a,e9.2e2,a,e10.2e3)') ' At 10 samp/per f=',fmax,',Max Att(dB)=', & + -(0.0001295712360834271997*AIMAG(fmax*Sqrt((epr*((0,-2.825225e7) + & + 8.8757061047382236e6*mur + this%control%attfactorc*((0,2.825225e7) + 8.8757061047382236e6*mur)))/ & + (1.124121310242e12 + 1.124121310242e12*this%control%attfactorc))*min(deltaespmax,skin_depth))) + if (this%control%layoutnumber == 0) call WarnErrReport(buff) + if (fmax > 3e9) then + fmax=3e9 + write(buff,'(a,e9.2e2,a,e10.2e3)') ' At f=',fmax,',Max Att(dB)=', & + -(0.0001295712360834271997*AIMAG(fmax*Sqrt((epr*((0,-2.825225e7) + & + 8.8757061047382236e6*mur + this%control%attfactorc*((0,2.825225e7) + 8.8757061047382236e6*mur)))/ & + (1.124121310242e12 + 1.124121310242e12*this%control%attfactorc))*min(deltaespmax,skin_depth))) + if (this%control%layoutnumber == 0) call WarnErrReport(buff) + endif + att=.true. + endif + end do endif -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) + end subroutine updateSigmaM + + subroutine updateThinWiresSigma(att) + logical, intent(inout) :: att + character(len=BUFSIZE) :: buff + integer :: i + if (abs(this%control%attfactorw-1.0_RKIND) > 1.0e-12_RKIND) then + att=.false. + do i=1,sgg%nummedia + if (sgg%Med(i)%Is%ThinWire) then + sgg%Med(i)%Sigma =(-2.0_RKIND * (-1.0_RKIND + this%control%attfactorw)*eps0)/((1 + this%control%attfactorw)*sgg%dt) + if (.not.att) then + write(buff,'(a,2e10.2e3)') ' WIREs stabilization att. factors=',this%control%attfactorw,sgg%Med(i)%Sigma + if (this%control%layoutnumber == 0) call WarnErrReport(buff) + att=.true. + endif + endif + end do endif -#endif - endif + end subroutine updateThinWiresSigma + + subroutine revertThinWiresSigma() + integer :: i + if (abs(this%control%attfactorw-1.0_RKIND) > 1.0e-12_RKIND) then + do i=1,sgg%nummedia + if (sgg%Med(i)%Is%ThinWire) then + sgg%Med(i)%Sigma = 0.0_RKIND !revert!!! !necesario para no lo tome como un lossy luego en wires !solo se toca el g1,g2 + endif + end do + endif + end subroutine -#ifdef CompileWithBerengerWires - if (trim(adjustl(this%control%wiresflavor))=='berenger') then - if ((this%control%size>1).and.(this%thereAre%wires)) call FlushWiresMPI_Berenger(this%control%layoutnumber,this%control%size) - endif + subroutine reportSimulationOptions() + character(len=BUFSIZE) :: buff + if ((this%control%layoutnumber == 0).and.this%control%verbose) then + write(buff,'(a,3e9.2e2)') 'CPML alpha, alphaorder, kappa factors= ', this%control%alphamaxpar,this%control%alphaOrden,this%control%kappamaxpar + call WarnErrReport(buff) + if (this%control%medioextra%exists) then + write(buff,'(a,i5,e9.2e2)') 'CPML correction size,factor to scale sigmamax = ', & + this%control%medioextra%size,this%control%medioextra%sigma + call WarnErrReport(buff) + endif + write(buff,*) 'saveall=',this%control%saveall,', flushsecondsFields=',this%control%flushsecondsFields,', flushsecondsData=',this%control%flushsecondsData,', maxCPUtime=',this%control%maxCPUtime,', singlefilewrite=',this%control%singlefilewrite + call WarnErrReport(buff) + write(buff,*) 'TAPARRABOS=',this%control%TAPARRABOS,', wiresflavor=',trim(adjustl(this%control%wiresflavor)),', mindistwires=',this%control%mindistwires,', wirecrank=',this%control%wirecrank , 'makeholes=',this%control%makeholes + call WarnErrReport(buff) + write(buff,*) 'use_mtln_wires=', this%control%use_mtln_wires + write(buff,*) 'connectendings=',this%control%connectendings,', isolategroupgroups=',this%control%isolategroupgroups + call WarnErrReport(buff) + write(buff,*) 'wirethickness ', this%control%wirethickness, 'stableradholland=',this%control%stableradholland,'mtlnberenger=',this%control%mtlnberenger,' inductance_model=',trim(adjustl(this%control%inductance_model)), & + ', inductance_order=',this%control%inductance_order,', groundwires=',this%control%groundwires,' ,fieldtotl=',this%control%fieldtotl,' noSlantedcrecepelo =',this%control%noSlantedcrecepelo + call WarnErrReport(buff) + write(buff,*) 'sgbc=',this%control%sgbc,', mibc=',this%control%mibc,', attfactorc=',this%control%attfactorc,', attfactorw=',this%control%attfactorw + call WarnErrReport(buff) + write(buff,*) 'NOcompomur=',this%control%NOcompomur,', ADE=',this%control%ADE,', conformalskin=',this%control%conformalskin,', sgbcFreq=',this%control%sgbcFreq,', sgbcresol=',this%control%sgbcresol,', sgbccrank=',this%control%sgbccrank,', sgbcDepth=',this%control%sgbcdepth + call WarnErrReport(buff) + write(buff,*) 'mur_second=',this%control%mur_second,', murafterpml=',this%control%murafterpml,', facesNF2FF%tr=',this%control%facesNF2FF%tr,', facesNF2FF%fr=',this%control%facesNF2FF%fr,', facesNF2FF%iz=',this%control%facesNF2FF%iz + call WarnErrReport(buff) + write(buff,*) 'facesNF2FF%de=',this%control%facesNF2FF%de,', facesNF2FF%ab=',this%control%facesNF2FF%ab,', facesNF2FF%ar=',this%control%facesNF2FF%ar,', NF2FFDecim=',this%control%NF2FFDecim + call WarnErrReport(buff) + endif + end subroutine + + subroutine initializeBorders() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer (kind=4) :: ierr #endif + write(dubuf,*) 'Init Other Borders...'; call print11(this%control%layoutnumber,dubuf) + call InitOtherBorders (sgg,this%thereAre) + l_auxinput=this%thereAre%PECBorders.or.this%thereAre%PMCBorders.or.this%thereAre%PeriodicBorders + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif -!!!no se si el orden wires - sgbcs del sync importa 150519 + if ( l_auxoutput) then + write (dubuf,*) '----> there are PEC, PMC or periodic Borders'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no PEC, PMC or periodic Borders found'; call print11(this%control%layoutnumber,dubuf) + endif + #ifdef CompileWithMPI -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_sgbcs(this%control%simu_devia,this%control%layoutnumber,this%control%size) - endif -#endif -#endif + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + write(dubuf,*) 'Init CPML Borders...'; call print11(this%control%layoutnumber,dubuf) + call InitCPMLBorders (sgg,SINPML_Fullsize,this%thereAre%PMLBorders,this%control, & + dxe,dye,dze,dxh,dyh,dzh,Idxe,Idye,Idze,Idxh,Idyh,Idzh,eps0,mu0) + l_auxinput=this%thereAre%PMLBorders + l_auxoutput=l_auxinput #ifdef CompileWithMPI -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_lumped(this%control%simu_devia,this%control%layoutnumber,this%control%size) - endif -#endif -#endif - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - IF (this%control%resume) then - write(dubuf,*)'END PREPROCESSING. RESUMING simulation from n=',n - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*)'END PREPROCESSING. STARTING simulation.' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) + 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 CPML Borders'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no CPML Borders found'; call print11(this%control%layoutnumber,dubuf) + endif + #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - CALL get_secnds (time_out2) - write(dubuf,*) 'Start Date/time ', time_out2%fecha( 7: 8),'/',& - &time_out2%fecha( 5: 6),' ',time_out2%hora( 1: 2), ':',& - &time_out2%hora( 3: 4),':',time_out2%hora( 5: 6) - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - endif - still_planewave_time=.true. !inicializacion de la variable - !!!aqui no. bug resume pscale 131020 ! dt0=sgg%dt !entrada pscale - pscale_alpha=1.0 !se le entra con 1.0 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! TIME STEPPING - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - -#ifdef CompileWithProfiling - call nvtxStartRange("Antes del bucle N") + write(dubuf,*) 'Init PML Bodies...'; call print11(this%control%layoutnumber,dubuf) + call InitPMLbodies(sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,Ex,Ey,Ez,Hx,Hy,Hz,IDxe,IDye,IDze,IDxh,IDyh,IDzh,g2,Gm2,this%thereAre%PMLbodies,this%control,eps0,mu0) + l_auxinput=this%thereAre%PMLbodies + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif -!240424 sgg creo el comunicador mpi de las sondas conformal aqui. debe irse con el nuevo conformal -#ifdef CompileWithConformal + if ( l_auxoutput) then + write (dubuf,*) '----> there are PML Bodies'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no PML Bodies found'; call print11(this%control%layoutnumber,dubuf) + endif #ifdef CompileWithMPI - !!!!sgg250424 niapa para que funcionen sondas conformal mpi -!todos deben crear el subcomunicador mpi una sola vez - if (input_conformal_flag) then - SUBCOMM_MPI_conformal_probes=1 - MPI_conformal_probes_root=this%control%layoutnumber - else - SUBCOMM_MPI_conformal_probes=0 - MPI_conformal_probes_root=-1 - endif - call MPIinitSubcomm(this%control%layoutnumber,this%control%size,SUBCOMM_MPI_conformal_probes,& - MPI_conformal_probes_root,group_conformalprobes_dummy) - ! print *,'-----creating--->',this%control%layoutnumber,SIZE,SUBCOMM_MPI_conformal_probes,MPI_conformal_probes_root - call MPI_BARRIER(SUBCOMM_MPI, ierr) - !!!no lo hago pero al salir deberia luego destruir el grupo call MPI_Group_free(output(ii)%item(i)%MPIgroupindex,ierr) -#endif + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - - ciclo_temporal : DO while (N <= this%control%finaltimestep) - - !Flush the plane-wave logical switching off variable (saves CPU!) - call flushPlanewaveOff(planewave_switched_off, still_planewave_time, thereareplanewave) - !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 (this%thereAre%Anisotropic) call AdvanceAnisotropicE(sgg%alloc,ex,ey,ez,hx,hy,hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh) - call advanceE() -#ifdef CompileWithConformal - call advanceConformalE() -#endif - call advanceWires() - call advancePMLE() - - !!for tuning - !call get_secnds( time_ElecFin) - !time_elec=time_elec+time_ElecFin%segundos-time_ElecInit%segundos - !if(n == n_info) then - ! print *,whoami,n,'Time elec ',time_Elec - ! time_elec=0 - !endif - ! - -#ifdef CompileWithNIBC - !MultiportS E-field advancing - IF (this%thereAre%Multiports.and.(this%control%mibc)) call AdvanceMultiportE(sgg%alloc,Ex, Ey, Ez) + write(dubuf,*) 'Init Mur Borders...'; call print11(this%control%layoutnumber,dubuf) + call InitMURBorders (sgg,this%thereAre%MURBorders,this%control%resume,Idxh,Idyh,Idzh,eps0,mu0) + l_auxinput= this%thereAre%MURBorders + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif - - !MultiportS H-field advancing - IF (this%thereAre%sgbcs.and.(this%control%sgbc)) then - call AdvancesgbcE(real(sgg%dt,RKIND),this%control%sgbcDispersive,this%control%simu_devia,this%control%stochastic) + if (l_auxoutput) then + write (dubuf,*) '----> there are Mur Borders'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Mur Borders found'; call print11(this%control%layoutnumber,dubuf) endif -!!! - if (this%thereAre%Lumpeds) call AdvanceLumpedE(sgg,n,this%control%simu_devia,this%control%stochastic) -!!! - !EDispersives (only updated here. No need to update in the H-field part) - IF (this%thereAre%Edispersives) call AdvanceEDispersiveE(sgg) - !PMC are only called in the H-field part (image theory method) + end subroutine initializeBorders + subroutine initializeLumped() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#endif - !Plane Waves E-field advancing - If (this%thereAre%PlaneWaveBoxes.and.still_planewave_time) then - if (.not.this%control%simu_devia) then - call AdvancePlaneWaveE(sgg,n, b ,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,still_planewave_time) - endif - endif - - - !Nodal sources E-field advancing - If (this%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,this%control%simu_devia) - ! endif + !init lumped debe ir antes de wires porque toca la conductividad del material !mmmm ojoooo 120123 + write(dubuf,*) 'Init Lumped Elements...'; call print11(this%control%layoutnumber,dubuf) + CALL InitLumped(sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,Ex,Ey,Ez,Hx,Hy,Hz,IDxe,IDye,IDze,IDxh,IDyh,IDzh,this%control,this%thereAre%Lumpeds,eps0,mu0) + l_auxinput=this%thereAre%Lumpeds + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + 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 lumped elements'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no lumped Structured elements found'; call print11(this%control%layoutnumber,dubuf) endif - - - - !!!!!!!!!!!!!!!!!! - !!!!!!!!!!end e field updating - !!!!!!!!!!!!!!!!!! + end subroutine initializeLumped + subroutine initializeWires() + real (kind=rkind) :: dtcritico, newdtcritico + character(len=BUFSIZE) :: dubuf, buff + logical :: l_auxinput, l_auxoutput #ifdef CompileWithMPI - - !call it always (only needed now by anisotropic, but may be needed in a future for other modules) - - if (this%control%size>1) then - call MPI_Barrier(SUBCOMM_MPI,ierr) - call FlushMPI_E_Cray - endif + integer(kind=4) :: ierr #endif - - ! - !Magnetic Fields Maxwell AND CPML Zone - - !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 (this%thereAre%Anisotropic) call AdvanceAnisotropicH(sgg%alloc,ex,ey,ez,hx,hy,hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh) - - !************************************************************************************************** - !***[conformal] ******************************************************************* - !************************************************************************************************** -!vuelta la burra al trigo a 140220. En consenso, llevado a despues de call Advance_Ex, etc, para poder corregir lo already_YEEadvanced_byconformal=dont_yeeadvance -!!!!!!!!me lo he llevado antes de hilos 171216. confirmar que no hay problemas ni con MPI ni con PML ni con nada !?!?!? -!!! !NOTE: ene-2019 lo vuelvo a poner aqui -!!!#ifdef CompileWithConformal -!!! if(input_conformal_flag)then -!!! call conformal_advance_E() -!!! endif -!!!#endif - !************************************************************************************************** - !************************************************************************************************** - !************************************************************************************************** - - - !!for tuning - !call get_secnds( time_MagnetInit) - !! - -! if (sgg%thereareMagneticMedia) then - -#ifdef CompileWithProfiling - call nvtxStartRange("Antes del bucle HX") -#endif - call Advance_Hx (Hx, Ey, Ez, Idye, Idze, sggMiHx, b,gm1,gm2) -#ifdef CompileWithProfiling - call nvtxEndRange - call nvtxStartRange("Antes del bucle HY") -#endif - call Advance_Hy (Hy, Ez, Ex, Idze, Idxe, sggMiHy, b,gm1,gm2) -#ifdef CompileWithProfiling - call nvtxEndRange - call nvtxStartRange("Antes del bucle HZ") + dtcritico=sgg%dt + if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & + (trim(adjustl(this%control%wiresflavor))=='transition')) then +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - call Advance_Hz (Hz, Ex, Ey, Idxe, Idye, sggMiHz, b,gm1,gm2) -#ifdef CompileWithProfiling - call nvtxEndRange + write(dubuf,*) 'Init Holland Wires...'; call print11(this%control%layoutnumber,dubuf) + call InitWires (sgg,this%sggMiNo,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz, & + this%thereAre%Wires, Ex,Ey,Ez,Hx,Hy,Hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh, & + g2,SINPML_fullsize, fullsize,dtcritico,eps0,mu0,this%control) + l_auxinput=this%thereAre%Wires + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif - - -!!! no se ganada nada de tiempo Call Advance_HxHyHz(Hx,Hy,Hz,Ex,Ey,Ez,IdxE,IdyE,IdzE,sggMiHx,sggMiHy,sggMiHz,b,gm1,gm2) - - ! call updateJ(sgg,Idxh,Idyh,Idzh,eps0,mu0, still_planewave_time) - - If (this%thereAre%PMLbodies) then !waveport absorbers - call AdvancePMLbodyH - endif - ! - !PML H-field advancing (IT IS IMPORTANT TO FIRST CALL THE PML ADVANCING ROUTINES, SINCE THE DISPERSIVE - !ROUTINES INJECT THE POLARIZATION CURRENTS EVERYWHERE (PML INCLUDED) - !SO THAT DISPERSIVE MATERIALS CAN ALSO BE TRUNCATED BY CPML) - - If (this%thereAre%PMLBorders) then - !!!if (sgg%therearePMLMagneticMedia) then - call AdvanceMagneticCPML ( sgg%NumMedia, b, sggMiHx, sggMiHy, sggMiHz, gm2, Hx, Hy, Hz, Ex, Ey, Ez) - !!!else - !!! call FreeSpace_AdvanceMagneticCPML( sgg%NumMedia, b, gm2, Hx, Hy, Hz, Ex, Ey, Ez) - !!!endif - endif - - - !!for tuning - !call get_secnds( time_MagnetFin) - !time_magnet=time_magnet+time_MagnetFin%segundos-time_MagnetInit%segundos - !if(n == n_info) then - ! print *,whoami,n,'Time magnet ',time_magnet - ! time_magnet=0 - !endif - !!for tuning - - !NO Wire advancing in the H-field part - ! - - !Must be called here and at the end to enforce any change in the PMC and perioric parts - !NO Wire advancing in the H-field part - !PMC BORDERS H-field advancing (duplicates the H-fields at the interface changing their sign) - - - If (this%thereAre%PMCBorders) then - call MinusCloneMagneticPMC(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) - endif - !Periodic BORDERS H-field mirroring - If (this%thereAre%PeriodicBorders) then - call CloneMagneticPeriodic(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) + if (l_auxoutput ) then + write (dubuf,*) '----> there are Holland/transition wires'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Holland/transition wires found'; call print11(this%control%layoutnumber,dubuf) endif - ! - !MultiportS H-field advancing - IF (this%thereAre%sgbcs.and.(this%control%sgbc)) then - call AdvancesgbcH endif - !MDispersives (only updated here. No need to update in the E-field part) - IF (this%thereAre%Mdispersives) call AdvanceMDispersiveH(sgg) +#ifdef CompileWithBerengerWires + if (trim(adjustl(this%control%wiresflavor))=='berenger') then -#ifdef CompileWithNIBC - !Multiports H-field advancing - IF (this%thereAre%Multiports .and.(this%control%mibc)) & - call AdvanceMultiportH (sgg%alloc,Hx,Hy,Hz,Ex,Ey,Ez,Idxe,Idye,Idze,sggMiHx,sggMiHy,sggMiHz,gm2,sgg%nummedia,this%control%conformalskin) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - - !Plane Wave H-field advancing - If (this%thereAre%PlaneWaveBoxes.and.still_planewave_time) then - if (.not.this%control%simu_devia) then - call AdvancePlaneWaveH(sgg,n, b , GM2, Idxe,Idye, Idze, Hx, Hy, Hz,still_planewave_time) - endif - endif - - - !Nodal sources E-field advancing - If (this%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,this%control%simu_devia) - !! 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 - !Wires (only updated here. No need to update in the H-field part) - if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & - (trim(adjustl(this%control%wiresflavor))=='transition')) then - IF (this%thereAre%Wires) then - if (this%control%wirecrank) then - continue - else - call AdvanceWiresH(sgg,n, this%control%layoutnumber,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic,this%control%experimentalVideal,this%control%wirethickness,eps0,mu0) - endif + write(dubuf,*) 'Init Multi-Wires...'; call print11(this%control%layoutnumber,dubuf) + call InitWires_Berenger(sgg,this%sggMiNo,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,this%control%layoutnumber,this%control%size,this%thereAre%Wires,this%control%resume,this%control%makeholes, & + this%control%isolategroupgroups,this%control%mtlnberenger,this%control%mindistwires, & + this%control%groundwires,this%control%taparrabos,Ex,Ey,Ez, & + Idxe,Idye,Idze,Idxh,Idyh,Idzh,this%control%inductance_model,g2,SINPML_fullsize,fullsize,dtcritico,eps0,mu0,this%control%verbose) + l_auxinput= this%thereAre%Wires + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + 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 Multi-wires'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Multi-wires found'; call print11(this%control%layoutnumber,dubuf) endif endif - !PMC BORDERS H-field advancing (duplicates the H-fields at the interface changing their sign) - If (this%thereAre%PMCBorders) call MinusCloneMagneticPMC(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) - !Periodic BORDERS H-field mirroring - If (this%thereAre%PeriodicBorders) then - call CloneMagneticPeriodic(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) - endif - ! - !************************************************************************************************** - !***[conformal] ******************************************************************* - !************************************************************************************************** - !conformal advance electric fields ref: ##timeStepps_advance_H## - -#ifdef CompileWithConformal - if(input_conformal_flag)then - call conformal_advance_H() - endif #endif - !************************************************************************************************** - !************************************************************************************************** - !************************************************************************************************** - - - !!!!!!!!!!end H advancing - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +#ifdef CompileWithSlantedWires + if((trim(adjustl(this%control%wiresflavor))=='slanted').or.(trim(adjustl(this%control%wiresflavor))=='semistructured')) then #ifdef CompileWithMPI - !!Flush all the MPI (esto estaba justo al principo del bucle temporal diciendo que era necesario para correcto resuming) - !lo he movido aqui a 16/10/2012 porque el farfield necesita tener los campos magneticos correctos - !e intuyo que el Bloque current tambien a tenor del comentario siguiente - !Incluyo un flush inicial antes de entrar al bucle para que el resuming sea correcto - if (this%control%size>1) then call MPI_Barrier(SUBCOMM_MPI,ierr) - call FlushMPI_H_Cray - endif - if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & - (trim(adjustl(this%control%wiresflavor))=='transition')) then - if ((this%control%size>1).and.(this%thereAre%wires)) then - call newFlushWiresMPI(this%control%layoutnumber,this%control%size) +#endif + write(dubuf,*) 'Init Slanted Wires...'; call print11(this%control%layoutnumber,dubuf) + if ((trim(adjustl(this%control%wiresflavor))=='semistructured')) then + write(dubuf,*) '...',this%control%precision; call print11(this%control%layoutnumber,dubuf) + call estructura_slanted(sgg,this%control%precision) + else + continue endif -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) + call InitWires_Slanted(sgg, this%control%layoutnumber,this%control%size, Ex, Ey, Ez, & + Idxe, Idye, Idze, Idxh, Idyh, Idzh, & + this%sggMiNo, & + this%sggMiEx, this%sggMiEy, this%sggMiEz, & + this%sggMiHx, this%sggMiHy, this%sggMiHz, & + this%thereAre%Wires, this%control%resume, & + this%control%mindistwires, this%control%groundwires,this%control%noSlantedcrecepelo , & + this%control%inductance_model, this%control%inductance_order, & + g2, SINPML_fullsize, dtcritico,eps0,mu0,this%control%verbose) + l_auxinput=this%thereAre%Wires + l_auxoutput=l_auxinput +!check for MUR1 nodes sgg 230124 + call init_murABC_slanted(sgg,SINPML_Fullsize,eps0,mu0) +!!!!!! +#ifdef CompileWithMPI + 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 Slanted wires'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Slanted wires found'; call print11(this%control%layoutnumber,dubuf) endif + endif +#endif + !!!sincroniza el dtcritico +#ifdef CompileWithMPI + call MPI_AllReduce( dtcritico, newdtcritico, 1_4, REALSIZE, MPI_MIN, SUBCOMM_MPI, ierr) + dtcritico=newdtcritico #endif + if (sgg%dt <= dtcritico) then + write(buff,'(a,e10.2e3)') 'WIR_INFO: deltat for stability OK: ',dtcritico + if ((this%control%layoutnumber==0).and.this%control%verbose) call WarnErrReport(buff) + else + if (.not.(this%control%resume.and.this%control%permitscaling)) then !no abortasr solo advertir si permittivity scaling + write(buff,'(a,e10.2e3)') 'WIR_ERROR: Possibly UNSTABLE dt, decrease wire radius, number of parallel WIREs, use -stableradholland or make dt < ',dtcritico + if (this%control%layoutnumber==0) call WarnErrReport(buff,.true.) + else + write(buff,'(a,e10.2e3)') 'WIR_WARNING: Resume and Pscaling with wires. Possibly UNSTABLE dt, decrease wire radius, number of parallel WIREs: dt is over ',dtcritico + if (this%control%layoutnumber==0) call WarnErrReport(buff,.false.) + endif endif -#ifdef CompileWithBerengerWires - if (trim(adjustl(this%control%wiresflavor))=='berenger') then - if ((this%control%size>1).and.(this%thereAre%wires)) call FlushWiresMPI_Berenger(this%control%layoutnumber,this%control%size) + !!! +!! + if (this%control%use_mtln_wires) then +#ifdef CompileWithMTLN +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + write(dubuf,*) 'Init MTLN Wires...'; call print11(this%control%layoutnumber,dubuf) + call InitWires_mtln(sgg,Ex,Ey,Ez,Idxh,Idyh,Idzh,eps0, mu0, this%mtln_parsed,this%thereAre%MTLNbundles) +#else + write(buff,'(a)') 'WIR_ERROR: Executable was not compiled with MTLN modules.' +#endif endif + + end subroutine initializeWires + + subroutine initializeAnisotropic() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr + integer :: rank #endif + +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif + write(dubuf,*) 'Init Anisotropic...'; call print11(this%control%layoutnumber,dubuf) + call InitAnisotropic(sgg,this%sggMiex,this%sggMiey,this%sggMiez,this%sggMiHx ,this%sggMiHy ,this%sggMiHz,this%thereAre%Anisotropic,this%thereAre%ThinSlot,eps0,mu0) + l_auxinput=this%thereAre%Anisotropic.or.this%thereAre%ThinSlot + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + call MPI_COMM_RANK(SUBCOMM_MPI, rank, ierr) + 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(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Structured anisotropic elements found'; call print11(this%control%layoutnumber,dubuf) + endif + end subroutine initializeAnisotropic -!!!no se si el orden wires - sgbcs del sync importa 150519 + subroutine initializeSGBC() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput #ifdef CompileWithMPI -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_sgbcs(this%control%simu_devia,this%control%layoutnumber,this%control%size) - endif -#endif + integer(kind=4) :: ierr #endif + IF (this%control%sgbc) then #ifdef CompileWithMPI -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_lumped(this%control%simu_devia,this%control%layoutnumber,this%control%size) - endif -#endif -#endif - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - !la absorcion mur precisa que se hayan flusheado los H - If (this%thereAre%MURBorders) then - call AdvanceMagneticMUR (b, sgg,sggMiHx, sggMiHy, sggMiHz, Hx, Hy, Hz,this%control%mur_second) - !y reflushear los nuevos H solo para segundo orden + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + write(dubuf,*) 'Init Multi sgbc...'; call print11(this%control%layoutnumber,dubuf) + call Initsgbcs(sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,Ex,Ey,Ez,Hx,Hy,Hz,IDxe,IDye,IDze,IDxh,IDyh,IDzh,this%control%layoutnumber,this%control%size, & + G1,G2,GM1,GM2,this%thereAre%sgbcs,this%control%resume,this%control%sgbccrank,this%control%sgbcFreq,this%control%sgbcresol,this%control%sgbcdepth,this%control%sgbcDispersive,eps0,mu0,this%control%simu_devia,this%control%stochastic) + l_auxinput= this%thereAre%sgbcs + l_auxoutput=l_auxinput #ifdef CompileWithMPI - if (this%control%mur_second) then - if (this%control%size>1) then - call MPI_Barrier(SUBCOMM_MPI,ierr) - call FlushMPI_H_Cray - endif - endif + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif - ENDIF - - !Update observation matrices !MUST GO AFTER THE MPI EXCHANGING INFO, SINCE Bloque CURRENTS NEED UPDATED INFO - IF (this%thereAre%Observation) then - !se le pasan los incrementos autenticos (bug que podia aparecer en NF2FF y Bloque currents 17/10/12) - call UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,sggMtag,tag_numbers, n,ini_save, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh,this%control%wiresflavor,SINPML_FULLSIZE,this%control%wirecrank, this%control%noconformalmapvtk,b) - - if (n>=ini_save+BuffObse) then - mindum=min(this%control%finaltimestep,ini_save+BuffObse) - !write(dubuf,'(a,i9)') ' INIT DATA FLUSHING n= ',n - !call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - !call print11(this%control%layoutnumber,dubuf) - !call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call FlushObservationFiles(sgg,ini_save,mindum,this%control%layoutnumber,this%control%size, dxe, dye, dze, dxh, dyh, dzh,b,this%control%singlefilewrite,this%control%facesNF2FF,.FALSE.) !no se flushean los farfields ahora - !write(dubuf,'(a,i9)') ' Done DATA FLUSHED n= ',n - !call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - !call print11(this%control%layoutnumber,dubuf) - !call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + if (l_auxoutput) then + write (dubuf,*) '----> there are Structured sgbc elements'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Structured sgbc elements found'; call print11(this%control%layoutnumber,dubuf) endif endif - ! - !Reporting,Timing, Partial flushing - if(n >= n_info) then - call_timing=.true. - else - call_timing=.false. - endif -#ifdef CompileWithMPI - l_aux=call_timing - call MPI_AllReduce( l_aux, call_timing, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) - call MPI_Barrier(MPI_COMM_WORLD,ierr) !050619 incluido problemas stochastic stopflusing -#endif - -!!! - if (call_timing) then - call Timing(sgg,b, n,n_info,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,initialtimestep, & - this%control%finaltimestep,perform,parar,.FALSE., & - Ex,Ey,Ez,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) - ! call Timing(sgg,b, n,n_info,initialtimestep, perform,parar,.FALSE., Ex,Ey,Ez,everflushed,maxSourceValue) - -!!!!!! -!!!!!!!!! + end subroutine initializeSGBC + + subroutine initializeMultiports() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput - if (.not.parar) then !!! si es por parada se gestiona al final -!!!!! si esta hecho lo flushea todo pero poniendo de acuerdo a todos los mpi - do i=1,sgg%NumberRequest - if (sgg%Observation(i)%done.and.(.not.sgg%Observation(i)%flushed)) then - perform%flushXdmf=.true. - perform%flushVTK=.true. - endif - end do +#ifdef CompileWithNIBC + IF (this%control%mibc) then #ifdef CompileWithMPI - l_aux=perform%flushVTK - call MPI_AllReduce( l_aux, perform%flushVTK, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - ! - l_aux=perform%flushXdmf - call MPI_AllReduce( l_aux, perform%flushXdmf, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - ! - l_aux=perform%flushDATA - call MPI_AllReduce( l_aux, perform%flushDATA, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - ! - l_aux=perform%flushFIELDS - call MPI_AllReduce( l_aux, perform%flushFIELDS, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - ! - l_aux=perform%postprocess - call MPI_AllReduce( l_aux, perform%postprocess, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif -!!!!!!!!!!!! - if (perform%flushFIELDS) then - write(dubuf,*) SEPARADOR,trim(adjustl(this%control%nentradaroot)),separador - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) 'INIT FLUSHING OF RESTARTING FIELDS n=',N - call print11(this%control%layoutnumber,dubuf) - call flush_and_save_resume(sgg, b, this%control%layoutnumber, this%control%size, this%control%nentradaroot, this%control%nresumeable2, this%thereare, n,eps0,mu0, everflushed, & - Ex, Ey, Ez, Hx, Hy, Hz,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic) + write(dubuf,*) 'Init Multiports...'; call print11(this%control%layoutnumber,dubuf) + call InitMultiports (sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx ,this%sggMiHy ,this%sggMiHz,this%control%layoutnumber,this%control%size,this%thereAre%Multiports,this%control%resume, & + Idxe,Idye,Idze,this%control%NOcompomur,this%control%AD,%this%control%cfl,eps0,mu0) + l_auxinput= this%thereAre%Multiports + l_auxoutput=l_auxinput #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) 'DONE FLUSHING OF RESTARTING FIELDS n=',N - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - endif - if (perform%isFlush()) then - ! - flushFF=perform%postprocess - if (this%thereAre%FarFields.and.flushFF) then - write(dubuf,'(a,i9)') ' INIT OBSERVATION DATA FLUSHING and Near-to-Far field n= ',n - else - write(dubuf,'(a,i9)') ' INIT OBSERVATION DATA FLUSHING n= ',n - endif - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - !! - if (this%thereAre%Observation) call FlushObservationFiles(sgg,ini_save, n,this%control%layoutnumber, this%control%size, dxe, dye, dze, dxh, dyh, dzh,b,this%control%singlefilewrite,this%control%facesNF2FF,flushFF) - !! -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) + if (l_auxoutput) then + write (dubuf,*) '----> there are Structured multiport elements'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Structured multiport elements found'; call print11(this%control%layoutnumber,dubuf) + endif + endif #endif - if (this%thereAre%FarFields.and.flushFF) then - write(dubuf,'(a,i9)') ' Done OBSERVATION DATA FLUSHED and Near-to-Far field n= ',n - else - write(dubuf,'(a,i9)') ' Done OBSERVATION DATA FLUSHED n= ',n - endif - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - ! - if (perform%postprocess) then - write(dubuf,'(a,i9)') 'Postprocessing frequency domain probes, if any, at n= ',n - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - somethingdone=.false. - at=n*sgg%dt - if (this%thereAre%Observation) call PostProcessOnthefly(this%control%layoutnumber,this%control%size,sgg,this%control%nentradaroot,at,somethingdone,this%control%niapapostprocess,this%control%forceresampled) + end subroutine initializeMultiports + + subroutine initializeConformalElements() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput + +#ifdef CompileWithConformal + if(input_conformal_flag)then #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) - call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - somethingdone=newsomethingdone + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - if (somethingdone) then - write(dubuf,*) 'End Postprocessing frequency domain probes.' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) 'No frequency domain probes snapshots found to be postrocessed' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - endif - endif - !! - if (perform%flushvtk) then - write(dubuf,'(a,i9)') ' Post-processing .vtk files n= ',n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - somethingdone=.false. - if (this%thereAre%Observation) call createvtkOnTheFly(this%control%layoutnumber,this%control%size,sgg,this%control%vtkindex,somethingdone,this%control%mpidir,tagtype,sggMtag,this%control%dontwritevtk) + write(dubuf,*) 'Init Conformal Elements ...'; call print11(this%control%layoutnumber,dubuf) +!WIP +!DEBUG + call initialize_memory_FDTD_conf_fields (sgg,this%sggMiEx, & + & this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,Ex,Ey,Ez,Hx,Hy,Hz,& + & this%control%layoutnumber,this%control%size, this%control%verbose); + l_auxinput=input_conformal_flag + l_auxoutput=l_auxinput #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) - call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - somethingdone=newsomethingdone + 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 (somethingdone) then - write(dubuf,*) 'End flushing .vtk snapshots' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) 'No .vtk snapshots found to be flushed' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - endif - endif - if (perform%flushXdmf) then - write(dubuf,'(a,i9)') ' Post-processing .xdmf files n= ',n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - somethingdone=.false. + ! refactor JUN2015 - if (this%thereAre%Observation) call createxdmfOnTheFly(sgg,this%control%layoutnumber,this%control%size,this%control%vtkindex,this%control%createh5bin,somethingdone,this%control%mpidir) - if (this%control%createh5bin) call createh5bintxt(sgg,this%control%layoutnumber,this%control%size) !lo deben llamar todos haya on on this%thereAre%observation + !!!!!!!sgg 051214 !rellena correctamente los campos magneticos. Necesario para construir los surfaces a partir del wireframe + ! call fillMagnetic(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz, b) + !!!!!!!ojo solo es valido para PEC!!!! cambiar luego !!?!?!?!?!? + if (l_auxoutput ) then + write (dubuf,*) '----> there are conformal elements'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no conformal elements found'; call print11(this%control%layoutnumber,dubuf) + end if + endif +#endif + end subroutine initializeConformalElements + subroutine initializeEDispersives() + character (len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) - call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - somethingdone=newsomethingdone + integer(kind=4) :: ierr #endif - if (somethingdone) then - write(dubuf,*) 'End flushing .xdmf snapshots' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) 'No .xdmf snapshots found to be flushed' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - endif - endif #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - endif !del if (performflushDATA.or.... - ! - if (this%control%singlefilewrite.and.perform%Unpack) then - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - write(dubuf,'(a,i9)') ' Unpacking .bin files and prostprocessing them at n= ',n - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - if (this%thereAre%Observation) call unpacksinglefiles(sgg,this%control%layoutnumber,this%control%size,this%control%singlefilewrite,initialtimestep,this%control%resume) !dump the remaining to disk - somethingdone=.false. - if (this%control%singlefilewrite.and.perform%Unpack) then - at=n*sgg%dt - if (this%thereAre%Observation) call PostProcessOnthefly(this%control%layoutnumber,this%control%size,sgg,this%control%nentradaroot,at,somethingdone,this%control%niapapostprocess,this%control%forceresampled) - endif -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) - call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - somethingdone=newsomethingdone -#endif - write(dubuf,'(a,i9)') ' Done Unpacking .bin files and prostprocessing them at n= ',n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - endif !del if (singlefilewrite.... -!!!si ha hecho algo reporta que va a continuar - if ((this%control%singlefilewrite.and.perform%Unpack).or.perform%isFlush()) then - write(dubuf,'(a,i9)') ' Continuing simulation at n= ',n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - endif - endif !!!del if (.not.parar) - endif !!!del if(n >= n_info - !!!!!!!!all the previous must be together - - this%control%fatalerror=.false. - if (parar) then - this%control%fatalerror=.true. - exit ciclo_temporal - endif -#ifdef CompileWithPrescale - if (this%control%permitscaling) then -#ifndef miguelPscaleStandAlone - if ((sgg%tiempo(n)>=EpsMuTimeScale_input_parameters%tini).and.& - &(sgg%tiempo(n)<=EpsMuTimeScale_input_parameters%tend)) then + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - call updateconstants(sgg,n,this%thereare,g1,g2,gM1,gM2, & - Idxe,Idye,Idze,Idxh,Idyh,Idzh, & !needed by CPML to be updated - this%control%sgbc,this%control%mibc,input_conformal_flag, & - this%control%wiresflavor, this%control%wirecrank, this%control%fieldtotl,& - this%control%sgbcDispersive,this%control%finaltimestep, & - eps0,mu0, & - this%control%simu_devia, & - EpsMuTimeScale_input_parameters,pscale_alpha,still_planewave_time & + write(dubuf,*) 'Init EDispersives...'; call print11(this%control%layoutnumber,dubuf) + call InitEDispersives(sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%thereAre%EDispersives,this%control%resume,g1,g2,ex,ey,ez) + l_auxinput=this%thereAre%EDispersives + l_auxoutput=l_auxinput #ifdef CompileWithMPI - ,this%control%layoutnumber,this%control%size & + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif - ,this%control%stochastic,this%control%verbose) -#ifndef miguelPscaleStandAlone + if (l_auxoutput ) then + write (dubuf,*) '----> there are Structured Electric dispersive elements'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Structured Electric dispersive elements found'; call print11(this%control%layoutnumber,dubuf) endif + end subroutine initializeEDispersives + + subroutine initializeMDispersives() + character (len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr #endif - endif + +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! Increase time step - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! write(*write(*,*) 'timestepping: ', n - n=n+1 !sube de iteracion - end do ciclo_temporal ! End of the time-stepping loop - - - -#ifdef CompileWithProfiling - call nvtxEndRange -#endif - -#ifdef CompileWithConformal - if(input_conformal_flag)then - call conformal_final_simulation (conf_timeSteps, n) - endif + write(dubuf,*) 'Init MDispersives...'; call print11(this%control%layoutnumber,dubuf) + call InitMDispersives(sgg,this%sggMiHx,this%sggMiHy,this%sggMiHz,this%thereAre%MDispersives,this%control%resume,gm1,gm2,hx,hy,hz) + l_auxinput=this%thereAre%MDispersives + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + 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 Magnetic dispersive elements'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Structured Magnetic dispersive elements found'; call print11(this%control%layoutnumber,dubuf) + endif + end subroutine initializeMDispersives + subroutine initializePlanewave() + character (len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) + integer(kind=4) :: ierr #endif - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - if (n>this%control%finaltimestep) n=this%control%finaltimestep !readjust n since after finishing it is increased - this%control%finaltimestep=n - lastexecutedtime=sgg%tiempo(this%control%finaltimestep) - !se llama con dummylog para no perder los flags de parada - call Timing(sgg,b, n,ndummy,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,initialtimestep, & - this%control%finaltimestep,d_perform,dummylog,.FALSE., & - Ex,Ey,Ez,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) - write(dubuf,*)'END FDTD time stepping. Beginning posprocessing at n= ',n - call print11(this%control%layoutnumber,dubuf) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + write(dubuf,*) 'Init Multi Plane-Waves...'; call print11(this%control%layoutnumber,dubuf) + call InitPlaneWave (sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,this%control%layoutnumber,this%control%size,SINPML_fullsize,this%thereAre%PlaneWaveBoxes,this%control%resume,eps0,mu0) - if ((this%control%flushsecondsFields/=0).or.perform%flushFIELDS) then - write(dubuf,'(a,i9)') ' INIT FINAL FLUSHING OF RESTARTING FIELDS n= ',n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call flush_and_save_resume(sgg, b, this%control%layoutnumber, this%control%size, this%control%nentradaroot, this%control%nresumeable2, this%thereare, n,eps0,mu0, everflushed, & - Ex, Ey, Ez, Hx, Hy, Hz,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic) - write(dubuf,'(a,i9)') ' DONE FINAL FLUSHING OF RESTARTING FIELDS N=',n - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - endif -! - if (this%thereAre%FarFields) then - write(dubuf,'(a,i9)') ' INIT FINAL OBSERVATION DATA FLUSHING and Near-to-Far field n= ',n - else - write(dubuf,'(a,i9)') ' INIT FINAL OBSERVATION DATA FLUSHING n= ',n - endif - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - if (this%thereAre%Observation) THEN - !dump the remaining to disk - call FlushObservationFiles(sgg,ini_save, n,this%control%layoutnumber, this%control%size, dxe, dye, dze, dxh, dyh, dzh,b,this%control%singlefilewrite,this%control%facesNF2FF,.TRUE.) - call CloseObservationFiles(sgg,this%control%layoutnumber,this%control%size,this%control%singlefilewrite,initialtimestep,lastexecutedtime,this%control%resume) !dump the remaining to disk -#ifdef CompileWithMTLN - if (this%control%use_mtln_wires) then - ! call GatherMPI_MTL() - call FlushMTLNObservationFiles(this%control%nentradaroot, mtlnProblem = .false.) - end if + l_auxinput=this%thereAre%PlaneWaveBoxes + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif - endif - - if (this%thereAre%FarFields) then - write(dubuf,'(a,i9)') ' DONE FINAL OBSERVATION DATA FLUSHED and Near-to-Far field n= ',n - else - write(dubuf,'(a,i9)') ' DONE FINAL OBSERVATION DATA FLUSHED n= ',n - endif - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) - call print11(this%control%layoutnumber,dubuf) - call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + if ( l_auxoutput) then + write (dubuf,*) '----> there are Plane Wave'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Plane waves are found'; call print11(this%control%layoutnumber,dubuf) + endif + end subroutine initializePlanewave + subroutine initializeNodalSources() + character (len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) + integer(kind=4) :: ierr #endif - write(dubuf,'(a,i9)') 'INIT FINAL Postprocessing frequency domain probes, if any, at n= ',n - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - somethingdone=.false. - at=n*sgg%dt - if (this%thereAre%Observation) call PostProcess(this%control%layoutnumber,this%control%size,sgg,this%control%nentradaroot,at,somethingdone,this%control%niapapostprocess,this%control%forceresampled) #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) - call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - somethingdone=newsomethingdone + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - !!!!!!!!!! - if (somethingdone) then - write(dubuf,*) 'DONE FINAL Postprocessing frequency domain probes.' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) 'No FINAL frequency domain probes snapshots found to be postrocessed' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - endif -! - write(dubuf,*)'INIT FINAL FLUSHING .vtk if any.' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - somethingdone=.false. + write(dubuf,*) 'Init Nodal Sources...'; call print11(this%control%layoutnumber,dubuf) + if (.not.this%control%hopf) then + call InitNodalSources(sgg,this%control%layoutnumber,sgg%NumNodalSources,sgg%NodalSource,sgg%Sweep,this%thereAre%NodalE,this%thereAre%NodalH) + else + call InitHopf(sgg,sgg%NumNodalSources,sgg%NodalSource,sgg%Sweep,this%control%ficherohopf) !lo manejara antonio con las entradas que precise + this%thereAre%NodalE=.false. !no habra mas nodales excepto la de Hopf + this%thereAre%NodalH=.false. + endif + + l_auxinput=this%thereAre%NodalH.or.this%thereAre%NodalE + l_auxoutput=l_auxinput +#ifdef CompileWithMPI + 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 Nodal sources'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no Structured Nodal sources are found'; call print11(this%control%layoutnumber,dubuf) + endif - if (this%thereAre%Observation) call createvtk(this%control%layoutnumber,this%control%size,sgg,this%control%vtkindex,somethingdone,this%control%mpidir,tagtype,sggMtag,this%control%dontwritevtk) + end subroutine initializeNodalSources + subroutine initializeObservation() + character(len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) - call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - somethingdone=newsomethingdone + integer(kind=4) :: ierr #endif - if (somethingdone) then - write(dubuf,*) 'DONE FINAL FLUSHING .vtk snapshots' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) 'No FINAL .vtk snapshots found to be flushed' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - endif -! - write(dubuf,*)'INIT FINAL FLUSHING .xdmf if any.' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - somethingdone=.false. - if (this%thereAre%Observation) call createxdmf(sgg,this%control%layoutnumber,this%control%size,this%control%vtkindex,this%control%createh5bin,somethingdone,this%control%mpidir) - if (this%control%createh5bin) call createh5bintxt(sgg,this%control%layoutnumber,this%control%size) !lo deben llamar todos haya o no this%thereAre%observation - ! call create_interpreted_mesh(sgg) + #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) - call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - somethingdone=newsomethingdone + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - if (somethingdone) then - write(dubuf,*) 'DONE FINAL FLUSHING .xdmf snapshots' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) 'No FINAL .xdmf snapshots found to be flushed' - call print11(this%control%layoutnumber,dubuf) - write(dubuf,*) SEPARADOR//separador//separador - call print11(this%control%layoutnumber,dubuf) - endif + write(dubuf,*) 'Init Observation...'; call print11(this%control%layoutnumber,dubuf) + call InitObservation (sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,this%sggMtag,tag_numbers, & + this%thereAre%Observation,this%thereAre%wires,this%thereAre%FarFields,this%control%resume,this%initialtimestep,this%control%finaltimestep,this%lastexecutedtime, & + this%control%nentradaroot,this%control%layoutnumber,this%control%size,this%control%saveall,this%control%singlefilewrite,this%control%wiresflavor,& + SINPML_FULLSIZE,this%control%facesNF2FF,this%control%NF2FFDecim,eps0,mu0,this%control%simu_devia,this%control%mpidir,this%control%niapapostprocess,this%bounds) + l_auxinput=this%thereAre%Observation.or.this%thereAre%FarFields + l_auxoutput=l_auxinput #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( l_auxinput, l_auxoutput, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) #endif - call Timing(sgg,b, n,ndummy,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,initialtimestep, & - this%control%finaltimestep,perform,parar,.FALSE., & - Ex,Ey,Ez,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) - write(dubuf,*)'END FINAL POSTPROCESSING at n= ',n - call print11(this%control%layoutnumber,dubuf) - finishedwithsuccess=.true. - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - return -!!!me he dado cuenta de que nunca entra aqui hoy 120617 pero no me he atrevido a borrar las lineas que siguen - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! Tell each module to free-up memory - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh,this%thereare,this%control%wiresflavor ) - ! + if (l_auxoutput ) then + write (dubuf,*) '----> there are observation requests'; call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) '----> no observation requests are found'; call print11(this%control%layoutnumber,dubuf) + endif + end subroutine initializeObservation + #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) + subroutine initializeMPI() + character(len=bufsize) :: dubuf + integer(kind=4) :: ierr + if (this%control%size>1) then + call MPI_Barrier(SUBCOMM_MPI,ierr) + write(dubuf,*) 'Init MPI MediaMatrix flush...'; call print11(this%control%layoutnumber,dubuf) + call InitMPI(sgg%sweep,sgg%alloc) + call MPI_Barrier(SUBCOMM_MPI,ierr) + call InitExtraFlushMPI(this %control%layoutnumber,sgg%sweep,sgg%alloc,sgg%med,sgg%nummedia,this%sggMiEz,this%sggMiHz) + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_H(sgg%alloc,this%control%layoutnumber,this%control%size, this%sggMiHx,this%sggMiHy,this%sggMiHz) + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_E(sgg%alloc,this%control%layoutnumber,this%control%size, this%sggMiEx,this%sggMiEy,this%sggMiEz) + call MPI_Barrier(SUBCOMM_MPI,ierr) + write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) + endif + +!!!!!!!!!!!!!!!!!!!!!fin juego con fuego 210815 + + !MPI initialization + if (this%control%size>1) then + write(dubuf,*) 'Init MPI Cray...'; call print11(this%control%layoutnumber,dubuf) + call InitMPI_Cray(this%control%layoutnumber,this%control%size,sgg%sweep,sgg%alloc, & + sgg%Border%IsDownPeriodic,sgg%Border%IsUpPeriodic, & + Ex,Ey,Ez,Hx,Hy,Hz) + call MPI_Barrier(SUBCOMM_MPI,ierr) + write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) + + !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(this%control%wiresflavor))=='holland') .or. & + (trim(adjustl(this%control%wiresflavor))=='transition') .or. & + this%control%use_mtln_wires) then + write(dubuf,*) 'Init MPI Holland Wires...'; call print11(this%control%layoutnumber,dubuf) + call newInitWiresMPI(this%control%layoutnumber,this%thereAre%wires,this%control%size,this%control%resume,sgg%sweep) + call MPI_Barrier(SUBCOMM_MPI,ierr) + write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) + endif + +#ifdef CompileWithBerengerWires + if (trim(adjustl(this%control%wiresflavor))=='berenger') then + write(dubuf,*) 'Init MPI Multi-Wires...'; call print11(this%control%layoutnumber,dubuf) + call InitWiresMPI_Berenger(this%control%layoutnumber,this%thereAre%wires,this%control%size,this%control%resume,sgg%sweep) + call MPI_Barrier(SUBCOMM_MPI,ierr) + write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) + endif #endif - !----------------------------------------------------> + !llamalo siempre para forzar los flush extra en caso de materiales anisotropos o multiport + write(dubuf,*) 'Init Extra Flush MPI...'; call print11(this%control%layoutnumber,dubuf) + call InitExtraFlushMPI_Cray(this%control%layoutnumber,sgg%sweep,sgg%alloc,sgg%Med,sgg%NumMedia,this%sggMiez,this%sggMiHz, & + Ex,Ey,Ez,Hx,Hy,Hz,this%thereAre%MURBorders) + call MPI_Barrier(SUBCOMM_MPI,ierr) + write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) + endif - contains + + !must be called now in case the MPI has changed the connectivity info + if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & + (trim(adjustl(this%control%wiresflavor))=='transition')) then + call ReportWireJunctions(this%control%layoutnumber,this%control%size,this%thereAre%wires,sgg%Sweep(iHz)%ZI, sgg%Sweep(iHz)%ZE,this%control%groundwires,this%control%strictOLD,this%control%verbose) + endif + +#ifdef CompileWithBerengerWires + if (trim(adjustl(this%control%wiresflavor))=='berenger') then + call ReportWireJunctionsBerenger(this%control%layoutnumber,this%control%size,this%thereAre%wires,sgg%Sweep(iHz)%ZI, sgg%Sweep(iHz)%ZE,this%control%groundwires,this%control%strictOLD,this%control%verbose) + !dama no tenia el equivalente 050416 + endif +#endif +#ifdef CompileWithSlantedWires + if ((trim(adjustl(this%control%wiresflavor))=='slanted').or.(trim(adjustl(this%control%wiresflavor))=='semistructured')) then + continue + endif +#endif + + end subroutine initializeMPI +#endif - subroutine flushPlanewaveOff(pw_switched_off, pw_still_time, pw_thereAre) - logical, intent(inout) :: pw_switched_off, pw_still_time, pw_thereAre - logical :: pw_still_time_aux, pw_thereAre_aux - integer (kind=4) :: ierr - if (.not.pw_switched_off) then - pw_still_time = pw_still_time.and.this%thereAre%PlaneWaveBoxes - pw_thereAre = this%thereAre%PlaneWaveBoxes #ifdef CompileWithMPI - if (this%control%size>1) then - pw_still_time_aux = pw_still_time - call MPI_AllReduce(pw_still_time_aux, pw_still_time, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) - pw_thereAre_aux = pw_thereAre - call MPI_AllReduce(pw_thereAre_aux, pw_thereAre, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + subroutine flushMPIdata() + integer(kind=4) :: ierr + call MPI_Barrier(SUBCOMM_MPI,ierr) + !!Flush all the MPI data (needed a initial flush for correct resuming) + if (this%control%size>1) then + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_H_Cray + endif + if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & + (trim(adjustl(this%control%wiresflavor))=='transition')) then + if ((this%control%size>1).and.(this%thereAre%wires)) then + call newFlushWiresMPI(this%control%layoutnumber,this%control%size) endif -#endif - if (.not.pw_still_time) then - pw_switched_off=.true. - write(dubuf,*) 'Switching plane-wave off at n=', N - if (pw_thereAre) call print11(this%control%layoutnumber,dubuf) +#ifdef CompileWithStochastic + if (this%control%stochastic) then + call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) endif +#endif endif - end subroutine - subroutine advanceE() -#ifdef CompileWithProfiling - call nvtxStartRange("Antes del bucle EX") +#ifdef CompileWithBerengerWires + if (trim(adjustl(this%control%wiresflavor))=='berenger') then + if ((this%control%size>1).and.(this%thereAre%wires)) call FlushWiresMPI_Berenger(this%control%layoutnumber,this%control%size) + endif #endif - call Advance_Ex (Ex, Hy, Hz, Idyh, Idzh, sggMiEx, b,g1,g2) -#ifdef CompileWithProfiling - call nvtxEndRange - - call nvtxStartRange("Antes del bucle EY") + end subroutine flushMPIdata #endif - call Advance_Ey (Ey, Hz, Hx, Idzh, Idxh, sggMiEy, b,g1,g2) - -#ifdef CompileWithProfiling - call nvtxEndRange - call nvtxStartRange("Antes del bucle EZ") + subroutine printSimulationStart() + character(len=bufsize) :: dubuf + TYPE (tiempo_t) :: time_out2 +#ifdef CompileWithMPI + integer (kind=4) :: ierr #endif - call Advance_Ez (Ez, Hx, Hy, Idxh, Idyh, sggMiEz, b,g1,g2) -#ifdef CompileWithProfiling - call nvtxEndRange + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF (this%control%resume) then + write(dubuf,*)'END PREPROCESSING. RESUMING simulation from n=',this%n + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*)'END PREPROCESSING. STARTING simulation.' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - end subroutine + CALL get_secnds (time_out2) + write(dubuf,*) 'Start Date/time ', time_out2%fecha( 7: 8),'/',& + &time_out2%fecha( 5: 6),' ',time_out2%hora( 1: 2), ':',& + &time_out2%hora( 3: 4),':',time_out2%hora( 5: 6) + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + endif + end subroutine printSimulationStart - subroutine Advance_Ex(Ex,Hy,Hz,Idyh,Idzh,sggMiEx,b,g1,g2) + subroutine fillMtag(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) !------------------------> + type (SGGFDTDINFO), intent(IN) :: sgg type (bounds_t), intent( IN) :: b - REAL (KIND=RKIND) , pointer, dimension ( : ) :: g1, g2 - ! - real (kind = RKIND), dimension ( 0 : b%dyh%NY-1 ) , intent( IN) :: Idyh - real (kind = RKIND), dimension ( 0 : b%dzh%NZ-1 ) , intent( IN) :: Idzh - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEx%NX-1 , 0 : b%sggMiEx%NY-1 , 0 : b%sggMiEx%NZ-1 ) , intent( IN) :: sggMiEx - real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) , intent( INOUT) :: Ex - real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) , intent( IN) :: HY - real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) , intent( IN) :: HZ + INTEGER(KIND = IKINDMTAG), dimension ( 0 : b%sggMiHx%NX-1 , 0 : b%sggMiHy%NY-1 , 0 : b%sggMiHz%NZ-1 ) , intent( INOUT) :: sggMtag + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHx%NX-1 , 0 : b%sggMiHx%NY-1 , 0 : b%sggMiHx%NZ-1 ) , intent( IN ) :: sggMiHx + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHy%NX-1 , 0 : b%sggMiHy%NY-1 , 0 : b%sggMiHy%NZ-1 ) , intent( IN ) :: sggMiHy + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHz%NX-1 , 0 : b%sggMiHz%NY-1 , 0 : b%sggMiHz%NZ-1 ) , intent( IN ) :: sggMiHz + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEx%NX-1 , 0 : b%sggMiEx%NY-1 , 0 : b%sggMiEx%NZ-1 ) , intent( IN ) :: sggMiEx + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEy%NX-1 , 0 : b%sggMiEy%NY-1 , 0 : b%sggMiEy%NZ-1 ) , intent( IN ) :: sggMiEy + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEz%NX-1 , 0 : b%sggMiEz%NY-1 , 0 : b%sggMiEz%NZ-1 ) , intent( IN ) :: sggMiEz + type (taglist_t) :: tag_numbers !------------------------> Variables locales - real (kind = RKIND) :: Idzhk, Idyhj integer(kind = 4) :: i, j, k - integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio + integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio1,medio2,medio3,medio4,medio5 + logical :: mediois1,mediois2,mediois3,mediois4 + integer, dimension(3) :: lbx, lby, lbz + lbx = lbound(tag_numbers%face%x) + lby = lbound(tag_numbers%face%y) + lbz = lbound(tag_numbers%face%z) + + mediois3=.true.; mediois4=.true. #ifdef CompileWithOpenMP -!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idzhk,Idyhj) -#endif -#ifdef CompileWithACC -!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idzhk,Idyhj) copyin(Ex,sggMiEx,Hy,Hz,Idyh,Idzh,b,G1,G2) copyout(Ex) +!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4,medio5,mediois1,mediois2,mediois3,mediois4) #endif - Do k=1,b%sweepEx%NZ - Do j=1,b%sweepEx%NY - Do i=1,b%sweepEx%NX - Idzhk=Idzh(k) - Idyhj=Idyh(j) - medio =sggMiEx(i,j,k) - Ex(i,j,k)=G1(MEDIO)*Ex(i,j,k)+G2(MEDIO)* & - ((Hz(i,j,k)-Hz(i,j-1,k))*Idyhj-(Hy(i,j,k)-Hy(i,j,k-1))*Idzhk) + Do k=1,b%sweepHx%NZ + Do j=1,b%sweepHx%NY + Do i=1,b%sweepHx%NX + medio1 =sggMiEy(i,j,k) + medio2 =sggMiEy(i,j,k+1) + medio3 =sggMiEz(i,j,k) + medio4 =sggMiEz(i,j+1,k) + medio5 =sggMiHx(i,j,k) + mediois1= (medio5==1).and.(medio1/=1).and.(medio2/=1).and.(medio3==1).and.(medio4==1) + mediois2= (medio5==1).and.(medio3/=1).and.(medio4/=1).and.(medio1==1).and.(medio2==1) + mediois3= .true. !.not.((medio5==1).and.(((sggMiHx(i-1,j,k)/=1).or.(sggMiHx(i+1,j,k)/=1)))) !esta condicion en realidad no detecta alabeos de una celda que siendo slots son acoples de un agujerito solo en el peor de los casos + if ((mediois1.or.mediois2).and.(mediois3)) then + !solo lo hace con celdas de vacio porque en particular el mismo medio sgbc con diferentes orientaciones tiene distintos indices de medio y lo activaria erroneamente si lo hago para todos los medios + tag_numbers%face%x(i+lbx(1)-1,j+lbx(2)-1,k+lbx(3)-1)=-ibset(iabs(tag_numbers%face%x(i+lbx(1)-1,j+lbx(2)-1,k+lbx(3)-1)),3) + !ojo no cambiar: interacciona con observation tags 141020 !151020 a efectos de mapvtk el signo importa + endif End do End do End do -#ifdef CompileWithOpenMP +#ifdef CompileWithOpenMP !$OMP END PARALLEL DO +!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4,medio5,mediois1,mediois2,mediois3,mediois4) #endif - return - end subroutine Advance_Ex - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Ey(Ey,Hz,Hx,Idzh,Idxh,sggMiEy,b,g1,g2) - - !------------------------> - type (bounds_t), intent( IN) :: b - REAL (KIND=RKIND) , pointer, dimension ( : ) :: g1, g2 - ! - real (kind = RKIND), dimension ( 0 : b%dzh%NZ-1 ) , intent( IN) :: Idzh - real (kind = RKIND), dimension ( 0 : b%dxh%NX-1 ) , intent( IN) :: Idxh - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEy%NX-1 , 0 : b%sggMiEy%NY-1 , 0 : b%sggMiEy%NZ-1 ) , intent( IN) :: sggMiEy - real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) , intent( INOUT) :: EY - real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) , intent( IN) :: HZ - real (kind = RKIND), dimension ( 0 : b%Hx%NX-1 , 0 : b%Hx%NY-1 , 0 : b%Hx%NZ-1 ) , intent( IN) :: HX - !------------------------> Variables locales - real (kind = RKIND) :: Idzhk - integer(kind = 4) :: i, j, k - integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio + Do k=1,b%sweepHy%NZ + Do j=1,b%sweepHy%NY + Do i=1,b%sweepHy%NX + medio1 =sggMiEz(i,j,k) + medio2 =sggMiEz(i+1,j,k) + medio3 =sggMiEx(i,j,k) + medio4 =sggMiEx(i,j,k+1) + medio5 =sggMiHy(i,j,k) + mediois1= (medio5==1).and.(medio1/=1).and.(medio2/=1).and.(medio3==1).and.(medio4==1) + mediois2= (medio5==1).and.(medio3/=1).and.(medio4/=1).and.(medio1==1).and.(medio2==1) + mediois3= .true. !.not.((medio5==1).and.(((sggMiHy(i,j-1,k)/=1).or.(sggMiHy(i,j+1,k)/=1)))) + if ((mediois1.or.mediois2).and.(mediois3)) then + tag_numbers%face%y(i+lby(1)-1,j+lby(2)-1,k+lby(3)-1)=-ibset(iabs(tag_numbers%face%y(i+lby(1)-1,j+lby(2)-1,k+lby(3)-1)),4) + endif + End do + End do + End do #ifdef CompileWithOpenMP -!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idzhk) -#endif -#ifdef CompileWithACC -!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idzhk) copyin(Ey,sggMiEy,Hz,Hx,Idzh,Idxh,b,G1,G2) copyout(Ey) +!$OMP END PARALLEL DO +!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4,medio5,mediois1,mediois2,mediois3,mediois4) #endif - Do k=1,b%sweepEy%NZ - Do j=1,b%sweepEy%NY - Do i=1,b%sweepEy%NX - Idzhk=Idzh(k) - medio =sggMiEy(i,j,k) - Ey(i,j,k)=G1(MEDIO)*Ey(i,j,k)+G2(MEDIO)*((Hx(i,j,k)-Hx(i,j,k-1))*Idzhk-(Hz(i,j,k)-Hz(i-1,j,k))*Idxh(i)) + Do k=1,b%sweepHz%NZ + Do j=1,b%sweepHz%NY + Do i=1,b%sweepHz%NX + medio1 =sggMiEx(i,j,k) + medio2 =sggMiEx(i,j+1,k) + medio3 =sggMiEy(i,j,k) + medio4 =sggMiEy(i+1,j,k) + medio5 =sggMiHz(i,j,k) + mediois1= (medio5==1).and.(medio1/=1).and.(medio2/=1).and.(medio3==1).and.(medio4==1) + mediois2= (medio5==1).and.(medio3/=1).and.(medio4/=1).and.(medio1==1).and.(medio2==1) + mediois3= .true. !.not.((medio5==1).and.(((sggMiHz(i,j,k-1)/=1).or.(sggMiHz(i,j,k+1)/=1)))) + if ((mediois1.or.mediois2).and.(mediois3)) then + tag_numbers%face%z(i+lbz(1)-1,j+lbz(2)-1,k+lbz(3)-1)=-ibset(iabs(tag_numbers%face%z(i+lbz(1)-1,j+lbz(2)-1,k+lbz(3)-1)),5) + endif End do End do End do #ifdef CompileWithOpenMP !$OMP END PARALLEL DO #endif + return + end subroutine fillMtag + subroutine crea_timevector(sgg,lastexecutedtimestep,finaltimestep,lastexecutedtime) + integer (kind=4) :: lastexecutedtimestep,finaltimestep,i + real (kind=RKIND_tiempo) :: lastexecutedtime + type (SGGFDTDINFO), intent(INOUT) :: sgg + allocate (sgg%tiempo(lastexecutedtimestep:finaltimestep+2)) + sgg%tiempo(lastexecutedtimestep)=lastexecutedtime + do i=lastexecutedtimestep+1,finaltimestep+2 + sgg%tiempo(i)=sgg%tiempo(i-1)+sgg%dt !equiespaciados por defecto !luego los modifica prescale + end do + return + end subroutine + end subroutine solver_init - return - end subroutine Advance_Ey + subroutine solver_run(this, sgg, eps0, mu0, sinPML_fullsize, fullsize, tag_numbers, tagtype) + class(solver_t) :: this + type(sggfdtdinfo), intent(in) :: sgg - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Ez(Ez,Hx,Hy,Idxh,Idyh,sggMiEz,b,g1,g2) + real(kind=rkind), intent(inout) :: eps0,mu0 - !------------------------> - type (bounds_t), intent( IN) :: b - REAL (KIND=RKIND) , pointer, dimension ( : ) :: g1, g2 - ! - real (kind = RKIND), dimension ( 0 : b%dyh%NY-1 ) , intent( IN) :: Idyh - real (kind = RKIND), dimension ( 0 : b%dxh%NX-1 ) , intent( IN) :: Idxh - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEz%NX-1 , 0 : b%sggMiEz%NY-1 , 0 : b%sggMiEz%NZ-1 ) , intent( IN) :: sggMiEz - real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) , intent( INOUT) :: Ez - real (kind = RKIND), dimension ( 0 : b%HX%NX-1 , 0 : b%HX%NY-1 , 0 : b%HX%NZ-1 ) , intent( IN) :: HX - real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) , intent( IN) :: HY - !------------------------> Variables locales - real (kind = RKIND) :: Idyhj - integer(kind = 4) :: i, j, k - integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio -#ifdef CompileWithOpenMP -!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idyhj) + type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize, fullsize + type(taglist_t), intent(in) :: tag_numbers + type (tagtype_t), intent(in) :: tagtype + + real(kind=rkind), pointer, dimension (:,:,:) :: Ex, Ey, Ez, Hx, Hy, Hz + real(kind=rkind), pointer, dimension (:) :: Idxe, Idye, Idze, Idxh, Idyh, Idzh, dxe, dye, dze, dxh, dyh, dzh + real(kind=rkind), pointer, dimension (:) :: g1,g2,gM1,gM2 + + logical :: call_timing, l_aux, flushFF, somethingdone, newsomethingdone + integer :: i + real (kind=rkind) :: pscale_alpha + REAL (kind=rkind_tiempo) :: at + character(len=bufsize) :: dubuf +#ifdef CompileWithMPI + integer(kind=4) :: ierr #endif -#ifdef CompileWithACC -!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idyhj) copyin(Ez,sggMiEz,Hx,Hy,Idxh,Idyh,b,G1,G2) copyout(Ez) +#ifdef CompileWithProfiling + call nvtxStartRange("Antes del bucle N") #endif - Do k=1,b%sweepEz%NZ - Do j=1,b%sweepEz%NY - Do i=1,b%sweepEz%NX - Idyhj=Idyh(j) - medio =sggMiEz(i,j,k) - Ez(i,j,k)=G1(MEDIO)*Ez(i,j,k)+G2(MEDIO)*((Hy(i,j,k)-Hy(i-1,j,k))*Idxh(i)-(Hx(i,j,k)-Hx(i,j-1,k))*Idyhj) - End do - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO +!240424 sgg creo el comunicador mpi de las sondas conformal aqui. debe irse con el nuevo conformal +#ifdef CompileWithConformal +#ifdef CompileWithMPI + call initMPIConformalProbes() +#endif #endif - return - end subroutine Advance_Ez + this%still_planewave_time=.true. !inicializacion de la variable + flushFF = .false. + pscale_alpha=1.0 !se le entra con 1.0 + Ex => this%Ex; Ey => this%Ey; Ez => this%Ez; Hx => this%Hx; Hy => this%Hy; Hz => this%Hz - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + Idxe => this%Idxe; Idye => this%Idye; Idze => this%Idze; Idxh => this%Idxh; Idyh => this%Idyh; Idzh => this%Idzh; dxe => this%dxe; dye => this%dye; dze => this%dze; dxh => this%dxh; dyh => this%dyh; dzh => this%dzh + g1 => this%g1 + g2 => this%g2 + gm1 => this%gm1 + gm2 => this%gm2 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Hx(Hx,Ey,Ez,IdyE,IdzE,sggMiHx,b,gm1,gm2) + ciclo_temporal : DO while (this%n <= this%control%finaltimestep) + + call this%step(sgg, eps0, mu0, sinPML_fullsize, tag_numbers) + call updateAndFlush() - !------------------------> - type (bounds_t), intent( IN) :: b - REAL (KIND=RKIND) , pointer, dimension ( : ) :: gm1 ,gm2 - !! - real (kind = RKIND), dimension ( 0 : b%dyE%NY-1 ) , intent( IN) :: IdyE - real (kind = RKIND), dimension ( 0 : b%dzE%NZ-1 ) , intent( IN) :: IdzE - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHx%NX-1 , 0 : b%sggMiHx%NY-1 , 0 : b%sggMiHx%NZ-1 ) , intent( IN) :: sggMiHx - real (kind = RKIND), dimension ( 0 : b%Hx%NX-1 , 0 : b%Hx%NY-1 , 0 : b%Hx%NZ-1 ) , intent( INOUT) :: Hx - real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) , intent( IN) :: EY - real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) , intent( IN) :: EZ - !------------------------> Variables locales - real (kind = RKIND) :: Idzek, Idyej - integer(kind = 4) :: i, j, k - integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio -#ifdef CompileWithOpenMP -!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idzek,Idyej) + if(this%n >= this%n_info) then + call_timing=.true. + else + call_timing=.false. + endif +#ifdef CompileWithMPI + l_aux=call_timing + call MPI_AllReduce( l_aux, call_timing, 1_4, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr) + call MPI_Barrier(MPI_COMM_WORLD,ierr) !050619 incluido problemas stochastic stopflusing #endif -#ifdef CompileWithACC -!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idzek,Idyej) copyin(Hx,sggMiHx,Ey,Ez,Idye,Idze,b,GM1,GM2) copyout(Hx) + + if (call_timing) then + call Timing(sgg,this%bounds,this%n,this%n_info,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,this%initialtimestep, & + this%control%finaltimestep,this%perform,this%parar,.FALSE., & + Ex,Ey,Ez,this%everflushed,this%control%nentradaroot,this%control%maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) + + if (.not.this%parar) then !!! si es por parada se gestiona al final +!!!!! si esta hecho lo flushea todo pero poniendo de acuerdo a todos los mpi + do i=1,sgg%NumberRequest + if (sgg%Observation(i)%done.and.(.not.sgg%Observation(i)%flushed)) then + this%perform%flushXdmf=.true. + this%perform%flushVTK=.true. + endif + end do +#ifdef CompileWithMPI + l_aux=this%perform%flushVTK + call MPI_AllReduce( l_aux, this%perform%flushVTK, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + ! + l_aux=this%perform%flushXdmf + call MPI_AllReduce( l_aux, this%perform%flushXdmf, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + ! + l_aux=this%perform%flushDATA + call MPI_AllReduce( l_aux, this%perform%flushDATA, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + ! + l_aux=this%perform%flushFIELDS + call MPI_AllReduce( l_aux, this%perform%flushFIELDS, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + ! + l_aux=this%perform%postprocess + call MPI_AllReduce( l_aux, this%perform%postprocess, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) #endif - Do k=1,b%sweepHx%NZ - Do j=1,b%sweepHx%NY - Do i=1,b%sweepHx%NX - Idzek=Idze(k) - Idyej=Idye(j) - medio =sggMiHx(i,j,k) - Hx(i,j,k)=GM1(MEDIO)*Hx(i,j,k)+GM2(MEDIO)*((Ey(i,j,k+1)-Ey(i,j,k))*Idzek-(Ez(i,j+1,k)-Ez(i,j,k))*Idyej) - End do - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO +!!!!!!!!!!!! + if (this%perform%flushFIELDS) then + write(dubuf,*) SEPARADOR,trim(adjustl(this%control%nentradaroot)),separador + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) 'INIT FLUSHING OF RESTARTING FIELDS n=',this%n + call print11(this%control%layoutnumber,dubuf) + call flush_and_save_resume(sgg, this%bounds, this%control%layoutnumber, this%control%size, this%control%nentradaroot, this%control%nresumeable2, this%thereare, this%n,eps0,mu0, this%everflushed, & + Ex, Ey, Ez, Hx, Hy, Hz,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - return - end subroutine Advance_Hx + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) 'DONE FLUSHING OF RESTARTING FIELDS n=',this%n + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + endif + if (this%perform%isFlush()) then + ! + flushFF=this%perform%postprocess + if (this%thereAre%FarFields.and.flushFF) then + write(dubuf,'(a,i9)') ' INIT OBSERVATION DATA FLUSHING and Near-to-Far field n= ',this%n + else + write(dubuf,'(a,i9)') ' INIT OBSERVATION DATA FLUSHING n= ',this%n + endif + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + !! + if (this%thereAre%Observation) call FlushObservationFiles(sgg,this%ini_save, this%n,this%control%layoutnumber, this%control%size, dxe, dye, dze, dxh, dyh, dzh,this%bounds,this%control%singlefilewrite,this%control%facesNF2FF,flushFF) + !! +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + if (this%thereAre%FarFields.and.flushFF) then + write(dubuf,'(a,i9)') ' Done OBSERVATION DATA FLUSHED and Near-to-Far field n= ',this%n + else + write(dubuf,'(a,i9)') ' Done OBSERVATION DATA FLUSHED n= ',this%n + endif + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + ! + if (this%perform%postprocess) then + write(dubuf,'(a,i9)') 'Postprocessing frequency domain probes, if any, at n= ',this%n + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + somethingdone=.false. + at=this%n*sgg%dt + if (this%thereAre%Observation) call PostProcessOnthefly(this%control%layoutnumber,this%control%size,sgg,this%control%nentradaroot,at,somethingdone,this%control%niapapostprocess,this%control%forceresampled) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + somethingdone=newsomethingdone +#endif + if (somethingdone) then + write(dubuf,*) 'End Postprocessing frequency domain probes.' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) 'No frequency domain probes snapshots found to be postrocessed' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + endif + endif + !! + if (this%perform%flushvtk) then + write(dubuf,'(a,i9)') ' Post-processing .vtk files n= ',this%n + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + somethingdone=.false. + if (this%thereAre%Observation) call createvtkOnTheFly(this%control%layoutnumber,this%control%size,sgg,this%control%vtkindex,somethingdone,this%control%mpidir,tagtype,this%sggMtag,this%control%dontwritevtk) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + somethingdone=newsomethingdone +#endif + if (somethingdone) then + write(dubuf,*) 'End flushing .vtk snapshots' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) 'No .vtk snapshots found to be flushed' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + endif + endif + if (this%perform%flushXdmf) then + write(dubuf,'(a,i9)') ' Post-processing .xdmf files n= ',this%n + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + somethingdone=.false. - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Hy(Hy,Ez,Ex,IdzE,IdxE,sggMiHy,b,gm1,gm2) + if (this%thereAre%Observation) call createxdmfOnTheFly(sgg,this%control%layoutnumber,this%control%size,this%control%vtkindex,this%control%createh5bin,somethingdone,this%control%mpidir) + if (this%control%createh5bin) call createh5bintxt(sgg,this%control%layoutnumber,this%control%size) !lo deben llamar todos haya on on this%thereAre%observation - !------------------------> - type (bounds_t), intent( IN) :: b - REAL (KIND=RKIND) , pointer, dimension ( : ) :: gm1 ,gm2 - ! - real (kind = RKIND), dimension ( 0 : b%dzE%NZ-1 ) , intent( IN) :: IdzE - real (kind = RKIND), dimension ( 0 : b%dxE%NX-1 ) , intent( IN) :: IdxE - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHy%NX-1 , 0 : b%sggMiHy%NY-1 , 0 : b%sggMiHy%NZ-1 ) , intent( IN) :: sggMiHy - real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) , intent( INOUT) :: HY - real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) , intent( IN) :: EZ - real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) , intent( IN) :: EX - !------------------------> Variables locales - real (kind = RKIND) :: Idzek - integer(kind = 4) :: i, j, k - integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio -#ifdef CompileWithOpenMP -!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idzek) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + somethingdone=newsomethingdone #endif -#ifdef CompileWithACC -!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idzek) copyin(Hy,sggMiHy,Ez,Ex,Idze,Idxe,b,GM1,GM2) copyout(Hy) + if (somethingdone) then + write(dubuf,*) 'End flushing .xdmf snapshots' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) 'No .xdmf snapshots found to be flushed' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + endif + endif + +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - Do k=1,b%sweepHy%NZ - Do j=1,b%sweepHy%NY - Do i=1,b%sweepHy%NX - Idzek=Idze(k) - medio =sggMiHy(i,j,k) - Hy(i,j,k)=GM1(MEDIO)*Hy(i,j,k)+GM2(MEDIO)*((Ez(i+1,j,k)-Ez(i,j,k))*Idxe(i)-(Ex(i,j,k+1)-Ex(i,j,k))*Idzek) - End do - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO + endif !del if (this%performflushDATA.or.... + ! + + + if (this%control%singlefilewrite.and.this%perform%Unpack) call singleUnpack() + if ((this%control%singlefilewrite.and.this%perform%Unpack).or.this%perform%isFlush()) then + write(dubuf,'(a,i9)') ' Continuing simulation at n= ',this%n + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + endif + + endif !!!del if (.not.this%parar) + endif !!!del if(n >= n_info +! !!!!!!!!all the previous must be together + + this%control%fatalerror=.false. + if (this%parar) then + this%control%fatalerror=.true. + exit ciclo_temporal + endif +#ifdef CompileWithPrescale + if (this%control%permitscaling) then +#ifndef miguelPscaleStandAlone + if ((sgg%tiempo(this%n)>=EpsMuTimeScale_input_parameters%tini).and.& + &(sgg%tiempo(this%n)<=EpsMuTimeScale_input_parameters%tend)) then #endif - return - end subroutine Advance_Hy + call updateconstants(sgg,this%n,this%thereare,g1,g2,gM1,gM2, & + Idxe,Idye,Idze,Idxh,Idyh,Idzh, & !needed by CPML to be updated + this%control%sgbc,this%control%mibc,input_conformal_flag, & + this%control%wiresflavor, this%control%wirecrank, this%control%fieldtotl,& + this%control%sgbcDispersive,this%control%finaltimestep, & + eps0,mu0, & + this%control%simu_devia, & + EpsMuTimeScale_input_parameters,pscale_alpha,this%still_planewave_time & +#ifdef CompileWithMPI + ,this%control%layoutnumber,this%control%size & +#endif + ,this%control%stochastic,this%control%verbose) +#ifndef miguelPscaleStandAlone + endif +#endif + endif +#endif + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!! Increase time step + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! write(*write(*,*) 'timestepping: ', n + this%n=this%n+1 !sube de iteracion + end do ciclo_temporal ! End of the time-stepping loop + +contains + subroutine updateAndFlush() + integer(kind=4) :: mindum + IF (this%thereAre%Observation) then + call UpdateObservation(sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,this%sggMiHx,this%sggMiHy,this%sggMiHz,this%sggMtag,tag_numbers, this%n,this%ini_save, Ex, Ey, Ez, Hx, Hy, Hz, dxe, dye, dze, dxh, dyh, dzh,this%control%wiresflavor,SINPML_FULLSIZE,this%control%wirecrank, this%control%noconformalmapvtk,this%bounds) + if (this%n>=this%ini_save+BuffObse) then + mindum=min(this%control%finaltimestep,this%ini_save+BuffObse) + call FlushObservationFiles(sgg,this%ini_save,mindum,this%control%layoutnumber,this%control%size, dxe, dye, dze, dxh, dyh, dzh,this%bounds,this%control%singlefilewrite,this%control%facesNF2FF,.FALSE.) !no se flushean los farfields ahora + endif + endif + end subroutine + + subroutine singleUnpack() + character (LEN=BUFSIZE) :: dubuf + logical :: somethingdone + real (kind=rkind_tiempo) :: at +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#endif + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + write(dubuf,'(a,i9)') ' Unpacking .bin files and prostprocessing them at n= ',this%n + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + if (this%thereAre%Observation) call unpacksinglefiles(sgg,this%control%layoutnumber,this%control%size,this%control%singlefilewrite,this%initialtimestep,this%control%resume) !dump the remaining to disk + somethingdone=.false. + if (this%control%singlefilewrite.and.this%perform%Unpack) then + at=this%n*sgg%dt + if (this%thereAre%Observation) call PostProcessOnthefly(this%control%layoutnumber,this%control%size,sgg,this%control%nentradaroot,at,somethingdone,this%control%niapapostprocess,this%control%forceresampled) + endif +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + somethingdone=newsomethingdone +#endif + write(dubuf,'(a,i9)') ' Done Unpacking .bin files and prostprocessing them at n= ',this%n + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + + end subroutine singleUnpack + + + end subroutine solver_run + + subroutine step(this, sgg, eps0, mu0, sinPML_fullsize, tag_numbers) + class(solver_t) :: this + type(sggfdtdinfo), intent(in) :: sgg + real(kind=rkind), intent(inout) :: eps0,mu0 - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Hz(Hz,Ex,Ey,IdxE,IdyE,sggMiHz,b,gm1,gm2) + + type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize + type(taglist_t), intent(in) :: tag_numbers - !------------------------> - type (bounds_t), intent( IN) :: b - REAL (KIND=RKIND) , pointer, dimension ( : ) :: gm1 ,gm2 - ! - real (kind = RKIND), dimension ( 0 : b%dyE%NY-1 ) , intent( IN) :: IdyE - real (kind = RKIND), dimension ( 0 : b%dxE%NX-1 ) , intent( IN) :: IdxE - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHz%NX-1 , 0 : b%sggMiHz%NY-1 , 0 : b%sggMiHz%NZ-1 ) , intent( IN) :: sggMiHz - real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) , intent( INOUT) :: Hz - real (kind = RKIND), dimension ( 0 : b%EX%NX-1 , 0 : b%EX%NY-1 , 0 : b%EX%NZ-1 ) , intent( IN) :: EX - real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) , intent( IN) :: EY - !------------------------> Variables locales - real (kind = RKIND) :: Idyej - integer(kind = 4) :: i, j, k - integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio -#ifdef CompileWithOpenMP -!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idyej) -#endif -#ifdef CompileWithACC -!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idyej) copyin(Hz,sggMiHz,Ex,Ey,Idxe,Idye,b,GM1,GM2) copyout(Hz) -#endif - Do k=1,b%sweepHz%NZ - Do j=1,b%sweepHz%NY - Do i=1,b%sweepHz%NX - Idyej=Idye(j) - medio =sggMiHz(i,j,k) - Hz(i,j,k)=GM1(MEDIO)*Hz(i,j,k)+GM2(MEDIO)*((Ex(i,j+1,k)-Ex(i,j,k))*Idyej-(Ey(i+1,j,k)-Ey(i,j,k))*Idxe(i)) - End do - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO + + logical :: planewave_switched_off = .false., thereareplanewave + + real(kind=rkind), pointer, dimension (:,:,:) :: Ex, Ey, Ez, Hx, Hy, Hz + real(kind=rkind), pointer, dimension (:) :: Idxe, Idye, Idze, Idxh, Idyh, Idzh, dxe, dye, dze, dxh, dyh, dzh + real(kind=rkind), pointer, dimension (:) :: g1,g2,gM1,gM2 + +#ifdef CompileWithMPI + integer(kind=4) :: ierr #endif - return - end subroutine Advance_Hz - subroutine advanceConformalE() + Ex => this%Ex; Ey => this%Ey; Ez => this%Ez; Hx => this%Hx; Hy => this%Hy; Hz => this%Hz + + Idxe => this%Idxe; Idye => this%Idye; Idze => this%Idze; Idxh => this%Idxh; Idyh => this%Idyh; Idzh => this%Idzh; dxe => this%dxe; dye => this%dye; dze => this%dze; dxh => this%dxh; dyh => this%dyh; dzh => this%dzh + + g1 => this%g1 + g2 => this%g2 + gm1 => this%gm1 + gm2 => this%gm2 + + + + + call flushPlanewaveOff(planewave_switched_off, this%still_planewave_time, thereareplanewave) + IF (this%thereAre%Anisotropic) call AdvanceAnisotropicE(sgg%alloc,ex,ey,ez,hx,hy,hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh) + call advanceE() #ifdef CompileWithConformal - if(input_conformal_flag)then - call conformal_advance_E() - endif + if(this%control%input_conformal_flag) call conformal_advance_E() #endif - end subroutine + call advanceWires() + call advancePMLE() + +#ifdef CompileWithNIBC + IF (this%thereAre%Multiports.and.(this%control%mibc)) call AdvanceMultiportE(sgg%alloc,Ex, Ey, Ez) +#endif + IF (this%thereAre%sgbcs.and.(this%control%sgbc)) call AdvancesgbcE(real(sgg%dt,RKIND),this%control%sgbcDispersive,this%control%simu_devia,this%control%stochastic) + if (this%thereAre%Lumpeds) call AdvanceLumpedE(sgg,this%n,this%control%simu_devia,this%control%stochastic) + IF (this%thereAre%Edispersives) call AdvanceEDispersiveE(sgg) + If (this%thereAre%PlaneWaveBoxes.and.this%still_planewave_time) then + if(.not.this%control%simu_devia) call AdvancePlaneWaveE(sgg,this%n, this%bounds,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,this%still_planewave_time) + end if + If (this%thereAre%NodalE) call AdvanceNodalE(sgg,this%sggMiEx,this%sggMiEy,this%sggMiEz,sgg%NumMedia,this%n, this%bounds,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,this%control%simu_devia) - subroutine advanceWires() - if (( (trim(adjustl(this%control%wiresflavor))=='holland') .or. & - (trim(adjustl(this%control%wiresflavor))=='transition')) .and. .not. this%control%use_mtln_wires) then - IF (this%thereAre%Wires) then - if (this%control%wirecrank) then - call AdvanceWiresEcrank(sgg, N, this%control%layoutnumber,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic) - else -#ifdef CompileWithMTLN - if (mtln_parsed%has_multiwires) then - write(buff, *) 'ERROR: Multiwires in simulation but -mtlnwires flag has not been selected' - call WarnErrReport(buff) - end if +#ifdef CompileWithMPI + if (this%control%size>1) then + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_E_Cray + endif #endif - call AdvanceWiresE(sgg,N, this%control%layoutnumber,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic,this%control%experimentalVideal,this%control%wirethickness,eps0,mu0) - endif + IF (this%thereAre%Anisotropic) call AdvanceAnisotropicH(sgg%alloc,ex,ey,ez,hx,hy,hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh) + call advanceH() + If (this%thereAre%PMLbodies) call AdvancePMLbodyH() + If (this%thereAre%PMLBorders) call AdvanceMagneticCPML(sgg%NumMedia, this%bounds, this%sggMiHx, this%sggMiHy, this%sggMiHz, gm2, Hx, Hy, Hz, Ex, Ey, Ez) + If (this%thereAre%PMCBorders) call MinusCloneMagneticPMC(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) + If (this%thereAre%PeriodicBorders) call CloneMagneticPeriodic(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) + IF (this%thereAre%sgbcs.and.(this%control%sgbc)) call AdvancesgbcH() + IF (this%thereAre%Mdispersives) call AdvanceMDispersiveH(sgg) +#ifdef CompileWithNIBC + IF (this%thereAre%Multiports .and.(this%control%mibc)) & + call AdvanceMultiportH (sgg%alloc,Hx,Hy,Hz,Ex,Ey,Ez,Idxe,Idye,Idze,this%sggMiHx,this%sggMiHy,this%sggMiHz,gm2,sgg%nummedia,this%control%conformalskin) +#endif + If (this%thereAre%PlaneWaveBoxes.and.this%still_planewave_time) then + if (.not.this%control%simu_devia) call AdvancePlaneWaveH(sgg,this%n, this%bounds, GM2, Idxe,Idye, Idze, Hx, Hy, Hz,this%still_planewave_time) + endif + If (this%thereAre%NodalH) call AdvanceNodalH(sgg,this%sggMiHx,this%sggMiHy,this%sggMiHz,sgg%NumMedia,this%n, this%bounds,GM2,Idxe,Idye,Idze,Hx,Hy,Hz,this%control%simu_devia) + + if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & + (trim(adjustl(this%control%wiresflavor))=='transition')) then + IF (this%thereAre%Wires) then + if (this%control%wirecrank) then + continue + else + call AdvanceWiresH(sgg,this%n, this%control%layoutnumber,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic,this%control%experimentalVideal,this%control%wirethickness,eps0,mu0) endif endif + endif + If (this%thereAre%PMCBorders) call MinusCloneMagneticPMC(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) + If (this%thereAre%PeriodicBorders) call CloneMagneticPeriodic(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) + +#ifdef CompileWithConformal + if(this%control%input_conformal_flag) call conformal_advance_H() +#endif + +#ifdef CompileWithMPI + !!Flush all the MPI (esto estaba justo al principo del bucle temporal diciendo que era necesario para correcto resuming) + !lo he movido aqui a 16/10/2012 porque el farfield necesita tener los campos magneticos correctos + !e intuyo que el Bloque current tambien a tenor del comentario siguiente + !Incluyo un flush inicial antes de entrar al bucle para que el resuming sea correcto + if (this%control%size>1) then + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_H_Cray + endif + if ((trim(adjustl(this%control%wiresflavor))=='holland') .or. & + (trim(adjustl(this%control%wiresflavor))=='transition')) then + if ((this%control%size>1).and.(this%thereAre%wires)) call newFlushWiresMPI(this%control%layoutnumber,this%control%size) +#ifdef CompileWithStochastic + if (this%control%stochastic) call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) +#endif + endif #ifdef CompileWithBerengerWires - if (trim(adjustl(this%control%wiresflavor))=='berenger') then - IF (this%thereAre%Wires) call AdvanceWiresE_Berenger(sgg,n) - endif + if (trim(adjustl(this%control%wiresflavor))=='berenger') then + if ((this%control%size>1).and.(this%thereAre%wires)) call FlushWiresMPI_Berenger(this%control%layoutnumber,this%control%size) + endif #endif -#ifdef CompileWithSlantedWires - if((trim(adjustl(this%control%wiresflavor))=='slanted').or.(trim(adjustl(this%control%wiresflavor))=='semistructured')) then - call AdvanceWiresE_Slanted(sgg,n) - endif #endif - if (this%control%use_mtln_wires) then -#ifdef CompileWithMTLN - call AdvanceWiresE_mtln(sgg,Idxh,Idyh,Idzh,eps0,mu0) -#else - write(buff,'(a)') 'WIR_ERROR: Executable was not compiled with MTLN modules.' -#endif - end if - end subroutine +!!!no se si el orden wires - sgbcs del sync importa 150519 +#ifdef CompileWithMPI +#ifdef CompileWithStochastic + if (this%control%stochastic) call syncstoch_mpi_sgbcs(this%control%simu_devia,this%control%layoutnumber,this%control%size) +#endif +#endif - !PML E-field advancing (IT IS IMPORTANT TO FIRST CALL THE PML ADVANCING ROUTINES, SINCE THE DISPERSIVE - !ROUTINES INJECT THE POLARIZATION CURRENTS EVERYWHERE (PML INCLUDED) - !SO THAT DISPERSIVE MATERIALS CAN ALSO BE TRUNCATED BY CPML) - subroutine advancePMLE() - If (this%thereAre%PMLbodies) then !waveport absorbers - call AdvancePMLbodyE - endif - If (this%thereAre%PMLBorders) then - call AdvanceelectricCPML(sgg%NumMedia, b,sggMiEx,sggMiEy,sggMiEz,G2,Ex,Ey,Ez,Hx,Hy,Hz) +#ifdef CompileWithMPI +#ifdef CompileWithStochastic + if (this%control%stochastic) call syncstoch_mpi_lumped(this%control%simu_devia,this%control%layoutnumber,this%control%size) +#endif +#endif + If (this%thereAre%MURBorders) then + call AdvanceMagneticMUR(this%bounds, sgg,this%sggMiHx, this%sggMiHy, this%sggMiHz, Hx, Hy, Hz,this%control%mur_second) +#ifdef CompileWithMPI + if (this%control%mur_second) then + if (this%control%size>1) then + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_H_Cray + endif endif - end subroutine +#endif + endif +contains + subroutine flushPlanewaveOff(pw_switched_off, pw_still_time, pw_thereAre) + logical, intent(inout) :: pw_switched_off, pw_still_time, pw_thereAre + logical :: pw_still_time_aux, pw_thereAre_aux + integer (kind=4) :: ierr + character(len=bufsize) :: dubuf + if (.not.pw_switched_off) then + pw_still_time = pw_still_time.and.this%thereAre%PlaneWaveBoxes + pw_thereAre = this%thereAre%PlaneWaveBoxes +#ifdef CompileWithMPI + if (this%control%size>1) then + pw_still_time_aux = pw_still_time + call MPI_AllReduce(pw_still_time_aux, pw_still_time, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + pw_thereAre_aux = pw_thereAre + call MPI_AllReduce(pw_thereAre_aux, pw_thereAre, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + endif +#endif + if (.not.pw_still_time) then + pw_switched_off=.true. + write(dubuf,*) 'Switching plane-wave off at n=', this%n + if (pw_thereAre) call print11(this%control%layoutnumber,dubuf) + endif + endif + end subroutine + subroutine advanceE() +#ifdef CompileWithProfiling + call nvtxStartRange("Antes del bucle EX") +#endif + call Advance_Ex (Ex, Hy, Hz, Idyh, Idzh, this%sggMiEx, this%bounds,g1,g2) +#ifdef CompileWithProfiling + call nvtxEndRange - !!!!!!!!!sgg 051214 fill in the magnetic walls after the wireframe info + call nvtxStartRange("Antes del bucle EY") +#endif + call Advance_Ey (Ey, Hz, Hx, Idzh, Idxh, this%sggMiEy, this%bounds,g1,g2) + +#ifdef CompileWithProfiling + call nvtxEndRange + call nvtxStartRange("Antes del bucle EZ") +#endif + call Advance_Ez (Ez, Hx, Hy, Idxh, Idyh, this%sggMiEz, this%bounds,g1,g2) +#ifdef CompileWithProfiling + call nvtxEndRange +#endif + end subroutine - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine XXXXfillMagnetic(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz, b) + subroutine Advance_Ex(Ex,Hy,Hz,Idyh,Idzh,sggMiEx,b,g1,g2) - !------------------------> - type (SGGFDTDINFO), intent(IN) :: sgg - type (bounds_t), intent( IN) :: b - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHx%NX-1 , 0 : b%sggMiHx%NY-1 , 0 : b%sggMiHx%NZ-1 ) , intent( INOUT) :: sggMiHx - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHy%NX-1 , 0 : b%sggMiHy%NY-1 , 0 : b%sggMiHy%NZ-1 ) , intent( INOUT) :: sggMiHy - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHz%NX-1 , 0 : b%sggMiHz%NY-1 , 0 : b%sggMiHz%NZ-1 ) , intent( INOUT) :: sggMiHz - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEx%NX-1 , 0 : b%sggMiEx%NY-1 , 0 : b%sggMiEx%NZ-1 ) , intent( INOUT) :: sggMiEx - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEy%NX-1 , 0 : b%sggMiEy%NY-1 , 0 : b%sggMiEy%NZ-1 ) , intent( INOUT) :: sggMiEy - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEz%NX-1 , 0 : b%sggMiEz%NY-1 , 0 : b%sggMiEz%NZ-1 ) , intent( INOUT) :: sggMiEz - !------------------------> Variables locales - integer(kind = 4) :: i, j, k - integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio1,medio2,medio3,medio4 - logical :: mediois1,mediois2,mediois3,mediois4 -#ifdef CompileWithOpenMP -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) -#endif - Do k=1,b%sweepHx%NZ - Do j=1,b%sweepHx%NY - Do i=1,b%sweepHx%NX - medio1 =sggMiEy(i,j,k) - medio2 =sggMiEy(i,j,k+1) - medio3 =sggMiEz(i,j,k) - medio4 =sggMiEz(i,j+1,k) - !mediois1= sgg%med(medio1)%is%already_YEEadvanced_byconformal .or. sgg%med(medio1)%is%split_and_useless .or. (medio1==0) !!!errror mio de concepto 061214 - !mediois2= sgg%med(medio2)%is%already_YEEadvanced_byconformal .or. sgg%med(medio2)%is%split_and_useless .or. (medio2==0) - !mediois3= sgg%med(medio3)%is%already_YEEadvanced_byconformal .or. sgg%med(medio3)%is%split_and_useless .or. (medio3==0) - !mediois4= sgg%med(medio4)%is%already_YEEadvanced_byconformal .or. sgg%med(medio4)%is%split_and_useless .or. (medio4==0) - mediois1= (medio1==0) - mediois2= (medio2==0) - mediois3= (medio3==0) - mediois4= (medio4==0) - if (mediois1.and.mediois2.and.mediois3.and.mediois4) sggMiHx(i,j,k)=0 - End do - End do - End do + !------------------------> + type (bounds_t), intent( IN) :: b + REAL (KIND=RKIND) , pointer, dimension ( : ) :: g1, g2 + ! + real (kind = RKIND), dimension ( 0 : b%dyh%NY-1 ) , intent( IN) :: Idyh + real (kind = RKIND), dimension ( 0 : b%dzh%NZ-1 ) , intent( IN) :: Idzh + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEx%NX-1 , 0 : b%sggMiEx%NY-1 , 0 : b%sggMiEx%NZ-1 ) , intent( IN) :: sggMiEx + real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) , intent( INOUT) :: Ex + real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) , intent( IN) :: HY + real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) , intent( IN) :: HZ + !------------------------> Variables locales + real (kind = RKIND) :: Idzhk, Idyhj + integer(kind = 4) :: i, j, k + integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio #ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) +!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idzhk,Idyhj) #endif - Do k=1,b%sweepHy%NZ - Do j=1,b%sweepHy%NY - Do i=1,b%sweepHy%NX - medio1 =sggMiEz(i,j,k) - medio2 =sggMiEz(i+1,j,k) - medio3 =sggMiEx(i,j,k) - medio4 =sggMiEx(i,j,k+1) - mediois1= (medio1==0) - mediois2= (medio2==0) - mediois3= (medio3==0) - mediois4= (medio4==0) - if (mediois1.and.mediois2.and.mediois3.and.mediois4) sggMiHy(i,j,k)=0 - End do - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) +#ifdef CompileWithACC +!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idzhk,Idyhj) copyin(Ex,sggMiEx,Hy,Hz,Idyh,Idzh,b,G1,G2) copyout(Ex) #endif - Do k=1,b%sweepHz%NZ - Do j=1,b%sweepHz%NY - Do i=1,b%sweepHz%NX - medio1 =sggMiEx(i,j,k) - medio2 =sggMiEx(i,j+1,k) - medio3 =sggMiEy(i,j,k) - medio4 =sggMiEy(i+1,j,k) - mediois1= (medio1==0) - mediois2= (medio2==0) - mediois3= (medio3==0) - mediois4= (medio4==0) - if (mediois1.and.mediois2.and.mediois3.and.mediois4) sggMiHz(i,j,k)=0 - End do + Do k=1,b%sweepEx%NZ + Do j=1,b%sweepEx%NY + Do i=1,b%sweepEx%NX + Idzhk=Idzh(k) + Idyhj=Idyh(j) + medio =sggMiEx(i,j,k) + Ex(i,j,k)=G1(MEDIO)*Ex(i,j,k)+G2(MEDIO)* & + ((Hz(i,j,k)-Hz(i,j-1,k))*Idyhj-(Hy(i,j,k)-Hy(i,j,k-1))*Idzhk) End do End do -#ifdef CompileWithOpenMP + End do +#ifdef CompileWithOpenMP !$OMP END PARALLEL DO #endif - ! -#ifdef CompileWithOpenMP -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) -#endif - Do k=1,b%sweepHx%NZ - Do j=1,b%sweepHx%NY - Do i=1,b%sweepHx%NX - if ((sggMiHx(i,j,k)==0).or.(sgg%med(sggMiHx(i,j,k))%is%pec)) THEN - sggMiEy(i,j,k) =0 - sggMiEy(i,j,k+1) =0 - sggMiEz(i,j,k) =0 - sggMiEz(i,j+1,k) =0 - ENDIF - End do - End do - End do + return + end subroutine Advance_Ex + + subroutine Advance_Ey(Ey,Hz,Hx,Idzh,Idxh,sggMiEy,b,g1,g2) + + !------------------------> + type (bounds_t), intent( IN) :: b + REAL (KIND=RKIND) , pointer, dimension ( : ) :: g1, g2 + ! + real (kind = RKIND), dimension ( 0 : b%dzh%NZ-1 ) , intent( IN) :: Idzh + real (kind = RKIND), dimension ( 0 : b%dxh%NX-1 ) , intent( IN) :: Idxh + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEy%NX-1 , 0 : b%sggMiEy%NY-1 , 0 : b%sggMiEy%NZ-1 ) , intent( IN) :: sggMiEy + real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) , intent( INOUT) :: EY + real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) , intent( IN) :: HZ + real (kind = RKIND), dimension ( 0 : b%Hx%NX-1 , 0 : b%Hx%NY-1 , 0 : b%Hx%NZ-1 ) , intent( IN) :: HX + !------------------------> Variables locales + real (kind = RKIND) :: Idzhk + integer(kind = 4) :: i, j, k + integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio #ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) +!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idzhk) #endif - Do k=1,b%sweepHy%NZ - Do j=1,b%sweepHy%NY - Do i=1,b%sweepHy%NX - if ((sggMiHy(i,j,k)==0).or.(sgg%med(sggMiHy(i,j,k))%is%pec)) THEN - sggMiEz(i,j,k) =0 - sggMiEz(i+1,j,k) =0 - sggMiEx(i,j,k) =0 - sggMiEx(i,j,k+1) =0 - ENDIF - End do - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) +#ifdef CompileWithACC +!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idzhk) copyin(Ey,sggMiEy,Hz,Hx,Idzh,Idxh,b,G1,G2) copyout(Ey) #endif - Do k=1,b%sweepHz%NZ - Do j=1,b%sweepHz%NY - Do i=1,b%sweepHz%NX - if ((sggMiHz(i,j,k)==0).or.(sgg%med(sggMiHz(i,j,k))%is%pec)) THEN - sggMiEx(i,j,k) =0 - sggMiEx(i,j+1,k) =0 - sggMiEy(i,j,k) =0 - sggMiEy(i+1,j,k) =0 - ENDIF - End do + Do k=1,b%sweepEy%NZ + Do j=1,b%sweepEy%NY + Do i=1,b%sweepEy%NX + Idzhk=Idzh(k) + medio =sggMiEy(i,j,k) + Ey(i,j,k)=G1(MEDIO)*Ey(i,j,k)+G2(MEDIO)*((Hx(i,j,k)-Hx(i,j,k-1))*Idzhk-(Hz(i,j,k)-Hz(i-1,j,k))*Idxh(i)) End do End do + End do #ifdef CompileWithOpenMP !$OMP END PARALLEL DO #endif - return - end subroutine XXXXfillMagnetic - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine fillMtag(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) - !------------------------> - type (SGGFDTDINFO), intent(IN) :: sgg - type (bounds_t), intent( IN) :: b - INTEGER(KIND = IKINDMTAG), dimension ( 0 : b%sggMiHx%NX-1 , 0 : b%sggMiHy%NY-1 , 0 : b%sggMiHz%NZ-1 ) , intent( INOUT) :: sggMtag - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHx%NX-1 , 0 : b%sggMiHx%NY-1 , 0 : b%sggMiHx%NZ-1 ) , intent( IN ) :: sggMiHx - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHy%NX-1 , 0 : b%sggMiHy%NY-1 , 0 : b%sggMiHy%NZ-1 ) , intent( IN ) :: sggMiHy - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHz%NX-1 , 0 : b%sggMiHz%NY-1 , 0 : b%sggMiHz%NZ-1 ) , intent( IN ) :: sggMiHz - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEx%NX-1 , 0 : b%sggMiEx%NY-1 , 0 : b%sggMiEx%NZ-1 ) , intent( IN ) :: sggMiEx - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEy%NX-1 , 0 : b%sggMiEy%NY-1 , 0 : b%sggMiEy%NZ-1 ) , intent( IN ) :: sggMiEy - integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEz%NX-1 , 0 : b%sggMiEz%NY-1 , 0 : b%sggMiEz%NZ-1 ) , intent( IN ) :: sggMiEz - type (taglist_t) :: tag_numbers - !------------------------> Variables locales - integer(kind = 4) :: i, j, k - integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio1,medio2,medio3,medio4,medio5 - logical :: mediois1,mediois2,mediois3,mediois4 - integer, dimension(3) :: lbx, lby, lbz - lbx = lbound(tag_numbers%face%x) - lby = lbound(tag_numbers%face%y) - lbz = lbound(tag_numbers%face%z) + return + end subroutine Advance_Ey - mediois3=.true.; mediois4=.true. -#ifdef CompileWithOpenMP -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4,medio5,mediois1,mediois2,mediois3,mediois4) -#endif - Do k=1,b%sweepHx%NZ - Do j=1,b%sweepHx%NY - Do i=1,b%sweepHx%NX - medio1 =sggMiEy(i,j,k) - medio2 =sggMiEy(i,j,k+1) - medio3 =sggMiEz(i,j,k) - medio4 =sggMiEz(i,j+1,k) - medio5 =sggMiHx(i,j,k) - mediois1= (medio5==1).and.(medio1/=1).and.(medio2/=1).and.(medio3==1).and.(medio4==1) - mediois2= (medio5==1).and.(medio3/=1).and.(medio4/=1).and.(medio1==1).and.(medio2==1) - mediois3= .true. !.not.((medio5==1).and.(((sggMiHx(i-1,j,k)/=1).or.(sggMiHx(i+1,j,k)/=1)))) !esta condicion en realidad no detecta alabeos de una celda que siendo slots son acoples de un agujerito solo en el peor de los casos - if ((mediois1.or.mediois2).and.(mediois3)) then - !solo lo hace con celdas de vacio porque en particular el mismo medio sgbc con diferentes orientaciones tiene distintos indices de medio y lo activaria erroneamente si lo hago para todos los medios - tag_numbers%face%x(i+lbx(1)-1,j+lbx(2)-1,k+lbx(3)-1)=-ibset(iabs(tag_numbers%face%x(i+lbx(1)-1,j+lbx(2)-1,k+lbx(3)-1)),3) - !ojo no cambiar: interacciona con observation tags 141020 !151020 a efectos de mapvtk el signo importa - endif - End do - End do - End do + subroutine Advance_Ez(Ez,Hx,Hy,Idxh,Idyh,sggMiEz,b,g1,g2) + + !------------------------> + type (bounds_t), intent( IN) :: b + REAL (KIND=RKIND) , pointer, dimension ( : ) :: g1, g2 + ! + real (kind = RKIND), dimension ( 0 : b%dyh%NY-1 ) , intent( IN) :: Idyh + real (kind = RKIND), dimension ( 0 : b%dxh%NX-1 ) , intent( IN) :: Idxh + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEz%NX-1 , 0 : b%sggMiEz%NY-1 , 0 : b%sggMiEz%NZ-1 ) , intent( IN) :: sggMiEz + real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) , intent( INOUT) :: Ez + real (kind = RKIND), dimension ( 0 : b%HX%NX-1 , 0 : b%HX%NY-1 , 0 : b%HX%NZ-1 ) , intent( IN) :: HX + real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) , intent( IN) :: HY + !------------------------> Variables locales + real (kind = RKIND) :: Idyhj + integer(kind = 4) :: i, j, k + integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio #ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4,medio5,mediois1,mediois2,mediois3,mediois4) +!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idyhj) #endif - Do k=1,b%sweepHy%NZ - Do j=1,b%sweepHy%NY - Do i=1,b%sweepHy%NX - medio1 =sggMiEz(i,j,k) - medio2 =sggMiEz(i+1,j,k) - medio3 =sggMiEx(i,j,k) - medio4 =sggMiEx(i,j,k+1) - medio5 =sggMiHy(i,j,k) - mediois1= (medio5==1).and.(medio1/=1).and.(medio2/=1).and.(medio3==1).and.(medio4==1) - mediois2= (medio5==1).and.(medio3/=1).and.(medio4/=1).and.(medio1==1).and.(medio2==1) - mediois3= .true. !.not.((medio5==1).and.(((sggMiHy(i,j-1,k)/=1).or.(sggMiHy(i,j+1,k)/=1)))) - if ((mediois1.or.mediois2).and.(mediois3)) then - tag_numbers%face%y(i+lby(1)-1,j+lby(2)-1,k+lby(3)-1)=-ibset(iabs(tag_numbers%face%y(i+lby(1)-1,j+lby(2)-1,k+lby(3)-1)),4) - endif - End do +#ifdef CompileWithACC +!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idyhj) copyin(Ez,sggMiEz,Hx,Hy,Idxh,Idyh,b,G1,G2) copyout(Ez) +#endif + Do k=1,b%sweepEz%NZ + Do j=1,b%sweepEz%NY + Do i=1,b%sweepEz%NX + Idyhj=Idyh(j) + medio =sggMiEz(i,j,k) + Ez(i,j,k)=G1(MEDIO)*Ez(i,j,k)+G2(MEDIO)*((Hy(i,j,k)-Hy(i-1,j,k))*Idxh(i)-(Hx(i,j,k)-Hx(i,j-1,k))*Idyhj) End do End do + End do #ifdef CompileWithOpenMP !$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4,medio5,mediois1,mediois2,mediois3,mediois4) #endif - Do k=1,b%sweepHz%NZ - Do j=1,b%sweepHz%NY - Do i=1,b%sweepHz%NX - medio1 =sggMiEx(i,j,k) - medio2 =sggMiEx(i,j+1,k) - medio3 =sggMiEy(i,j,k) - medio4 =sggMiEy(i+1,j,k) - medio5 =sggMiHz(i,j,k) - mediois1= (medio5==1).and.(medio1/=1).and.(medio2/=1).and.(medio3==1).and.(medio4==1) - mediois2= (medio5==1).and.(medio3/=1).and.(medio4/=1).and.(medio1==1).and.(medio2==1) - mediois3= .true. !.not.((medio5==1).and.(((sggMiHz(i,j,k-1)/=1).or.(sggMiHz(i,j,k+1)/=1)))) - if ((mediois1.or.mediois2).and.(mediois3)) then - tag_numbers%face%z(i+lbz(1)-1,j+lbz(2)-1,k+lbz(3)-1)=-ibset(iabs(tag_numbers%face%z(i+lbz(1)-1,j+lbz(2)-1,k+lbz(3)-1)),5) - endif - End do + return + end subroutine Advance_Ez + + subroutine advanceH() +#ifdef CompileWithProfiling + call nvtxStartRange("Antes del bucle HX") +#endif + call Advance_Hx (Hx, Ey, Ez, Idye, Idze, this%sggMiHx, this%bounds,gm1,gm2) +#ifdef CompileWithProfiling + call nvtxEndRange + call nvtxStartRange("Antes del bucle HY") +#endif + call Advance_Hy (Hy, Ez, Ex, Idze, Idxe, this%sggMiHy, this%bounds,gm1,gm2) +#ifdef CompileWithProfiling + call nvtxEndRange + call nvtxStartRange("Antes del bucle HZ") +#endif + call Advance_Hz (Hz, Ex, Ey, Idxe, Idye, this%sggMiHz, this%bounds,gm1,gm2) +#ifdef CompileWithProfiling + call nvtxEndRange +#endif + end subroutine advanceH + + subroutine Advance_Hx(Hx,Ey,Ez,IdyE,IdzE,sggMiHx,b,gm1,gm2) + + !------------------------> + type (bounds_t), intent( IN) :: b + REAL (KIND=RKIND) , pointer, dimension ( : ) :: gm1 ,gm2 + !! + real (kind = RKIND), dimension ( 0 : b%dyE%NY-1 ) , intent( IN) :: IdyE + real (kind = RKIND), dimension ( 0 : b%dzE%NZ-1 ) , intent( IN) :: IdzE + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHx%NX-1 , 0 : b%sggMiHx%NY-1 , 0 : b%sggMiHx%NZ-1 ) , intent( IN) :: sggMiHx + real (kind = RKIND), dimension ( 0 : b%Hx%NX-1 , 0 : b%Hx%NY-1 , 0 : b%Hx%NZ-1 ) , intent( INOUT) :: Hx + real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) , intent( IN) :: EY + real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) , intent( IN) :: EZ + !------------------------> Variables locales + real (kind = RKIND) :: Idzek, Idyej + integer(kind = 4) :: i, j, k + integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio +#ifdef CompileWithOpenMP +!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idzek,Idyej) +#endif +#ifdef CompileWithACC +!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idzek,Idyej) copyin(Hx,sggMiHx,Ey,Ez,Idye,Idze,b,GM1,GM2) copyout(Hx) +#endif + Do k=1,b%sweepHx%NZ + Do j=1,b%sweepHx%NY + Do i=1,b%sweepHx%NX + Idzek=Idze(k) + Idyej=Idye(j) + medio =sggMiHx(i,j,k) + Hx(i,j,k)=GM1(MEDIO)*Hx(i,j,k)+GM2(MEDIO)*((Ey(i,j,k+1)-Ey(i,j,k))*Idzek-(Ez(i,j+1,k)-Ez(i,j,k))*Idyej) End do End do + End do #ifdef CompileWithOpenMP !$OMP END PARALLEL DO #endif - return - end subroutine fillMtag - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 - - - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Find the bounds and store everything under the bounds_t variable b - ! There is redundancy which should be corrected to leave everything in terms of b - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine findbounds(sgg,b) - ! - type (SGGFDTDINFO), intent(IN) :: sgg - type (bounds_t), intent(out) :: b - ! - - !No tocar. Dejar como estan alocateados - b%dxe%XI=sgg%alloc(iHx)%XI - b%dxe%XE=sgg%alloc(iHx)%XE - b%dye%YI=sgg%alloc(iHy)%YI - b%dye%YE=sgg%alloc(iHy)%YE - b%dze%ZI=sgg%alloc(iHz)%ZI - b%dze%ZE=sgg%alloc(iHz)%ZE - ! - b%dxh%XI=sgg%alloc(iEx)%XI - b%dxh%XE=sgg%alloc(iEx)%XE - b%dyh%YI=sgg%alloc(iEy)%YI - b%dyh%YE=sgg%alloc(iEy)%YE - b%dzh%ZI=sgg%alloc(iEz)%ZI - b%dzh%ZE=sgg%alloc(iEz)%ZE + return + end subroutine Advance_Hx - ! - !No tocar. Dejar como estan alocateados - b%Ex%XI=sgg%Alloc(iEx)%XI - b%Ex%XE=sgg%Alloc(iEx)%XE - b%Ey%XI=sgg%Alloc(iEy)%XI - b%Ey%XE=sgg%Alloc(iEy)%XE - b%Ez%XI=sgg%Alloc(iEz)%XI - b%Ez%XE=sgg%Alloc(iEz)%XE - ! - b%Hx%XI=sgg%Alloc(iHx)%XI - b%Hx%XE=sgg%Alloc(iHx)%XE - b%Hy%XI=sgg%Alloc(iHy)%XI - b%Hy%XE=sgg%Alloc(iHy)%XE - b%Hz%XI=sgg%Alloc(iHz)%XI - b%Hz%XE=sgg%Alloc(iHz)%XE - ! - b%Ex%YI=sgg%Alloc(iEx)%YI - b%Ex%YE=sgg%Alloc(iEx)%YE - b%Ey%YI=sgg%Alloc(iEy)%YI - b%Ey%YE=sgg%Alloc(iEy)%YE - b%Ez%YI=sgg%Alloc(iEz)%YI - b%Ez%YE=sgg%Alloc(iEz)%YE - ! - b%Hx%YI=sgg%Alloc(iHx)%YI - b%Hx%YE=sgg%Alloc(iHx)%YE - b%Hy%YI=sgg%Alloc(iHy)%YI - b%Hy%YE=sgg%Alloc(iHy)%YE - b%Hz%YI=sgg%Alloc(iHz)%YI - b%Hz%YE=sgg%Alloc(iHz)%YE - ! - b%Ex%ZI=sgg%Alloc(iEx)%ZI - b%Ex%ZE=sgg%Alloc(iEx)%ZE - b%Ey%ZI=sgg%Alloc(iEy)%ZI - b%Ey%ZE=sgg%Alloc(iEy)%ZE - b%Ez%ZI=sgg%Alloc(iEz)%ZI - b%Ez%ZE=sgg%Alloc(iEz)%ZE - ! - b%Hx%ZI=sgg%Alloc(iHx)%ZI - b%Hx%ZE=sgg%Alloc(iHx)%ZE - b%Hy%ZI=sgg%Alloc(iHy)%ZI - b%Hy%ZE=sgg%Alloc(iHy)%ZE - b%Hz%ZI=sgg%Alloc(iHz)%ZI - b%Hz%ZE=sgg%Alloc(iHz)%ZE - ! - ! - ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine Advance_Hy(Hy,Ez,Ex,IdzE,IdxE,sggMiHy,b,gm1,gm2) - !matrix indexes. Nothing to change. Asi estan alocateados - b%sggMiEx%XI=sgg%Alloc(iEx)%XI - b%sggMiEx%XE=sgg%Alloc(iEx)%XE - b%sggMiEy%XI=sgg%Alloc(iEy)%XI - b%sggMiEy%XE=sgg%Alloc(iEy)%XE - b%sggMiEz%XI=sgg%Alloc(iEz)%XI - b%sggMiEz%XE=sgg%Alloc(iEz)%XE - ! - b%sggMiHx%XI=sgg%Alloc(iHx)%XI - b%sggMiHx%XE=sgg%Alloc(iHx)%XE - b%sggMiHy%XI=sgg%Alloc(iHy)%XI - b%sggMiHy%XE=sgg%Alloc(iHy)%XE - b%sggMiHz%XI=sgg%Alloc(iHz)%XI - b%sggMiHz%XE=sgg%Alloc(iHz)%XE - ! - b%sggMiEx%YI=sgg%Alloc(iEx)%YI - b%sggMiEx%YE=sgg%Alloc(iEx)%YE - b%sggMiEy%YI=sgg%Alloc(iEy)%YI - b%sggMiEy%YE=sgg%Alloc(iEy)%YE - b%sggMiEz%YI=sgg%Alloc(iEz)%YI - b%sggMiEz%YE=sgg%Alloc(iEz)%YE - ! - b%sggMiHx%YI=sgg%Alloc(iHx)%YI - b%sggMiHx%YE=sgg%Alloc(iHx)%YE - b%sggMiHy%YI=sgg%Alloc(iHy)%YI - b%sggMiHy%YE=sgg%Alloc(iHy)%YE - b%sggMiHz%YI=sgg%Alloc(iHz)%YI - b%sggMiHz%YE=sgg%Alloc(iHz)%YE - ! - b%sggMiEx%ZI=sgg%Alloc(iEx)%ZI - b%sggMiEx%ZE=sgg%Alloc(iEx)%ZE - b%sggMiEy%ZI=sgg%Alloc(iEy)%ZI - b%sggMiEy%ZE=sgg%Alloc(iEy)%ZE - b%sggMiEz%ZI=sgg%Alloc(iEz)%ZI - b%sggMiEz%ZE=sgg%Alloc(iEz)%ZE - ! - b%sggMiHx%ZI=sgg%Alloc(iHx)%ZI - b%sggMiHx%ZE=sgg%Alloc(iHx)%ZE - b%sggMiHy%ZI=sgg%Alloc(iHy)%ZI - b%sggMiHy%ZE=sgg%Alloc(iHy)%ZE - b%sggMiHz%ZI=sgg%Alloc(iHz)%ZI - b%sggMiHz%ZE=sgg%Alloc(iHz)%ZE - ! - ! - ! - b%sweepEx%XI=sgg%Sweep(iEx)%XI - b%sweepEx%XE=sgg%Sweep(iEx)%XE - b%sweepEy%XI=sgg%Sweep(iEy)%XI - b%sweepEy%XE=sgg%Sweep(iEy)%XE - b%sweepEz%XI=sgg%Sweep(iEz)%XI - b%sweepEz%XE=sgg%Sweep(iEz)%XE - ! - b%sweepHx%XI=sgg%Sweep(iHx)%XI - b%sweepHx%XE=sgg%Sweep(iHx)%XE - b%sweepHy%XI=sgg%Sweep(iHy)%XI - b%sweepHy%XE=sgg%Sweep(iHy)%XE - b%sweepHz%XI=sgg%Sweep(iHz)%XI - b%sweepHz%XE=sgg%Sweep(iHz)%XE - ! - ! - b%sweepEx%YI=sgg%Sweep(iEx)%YI - b%sweepEx%YE=sgg%Sweep(iEx)%YE - b%sweepEy%YI=sgg%Sweep(iEy)%YI - b%sweepEy%YE=sgg%Sweep(iEy)%YE - b%sweepEz%YI=sgg%Sweep(iEz)%YI - b%sweepEz%YE=sgg%Sweep(iEz)%YE - ! - b%sweepHx%YI=sgg%Sweep(iHx)%YI - b%sweepHx%YE=sgg%Sweep(iHx)%YE - b%sweepHy%YI=sgg%Sweep(iHy)%YI - b%sweepHy%YE=sgg%Sweep(iHy)%YE - b%sweepHz%YI=sgg%Sweep(iHz)%YI - b%sweepHz%YE=sgg%Sweep(iHz)%YE - ! - b%sweepEx%ZI=sgg%Sweep(iEx)%ZI - b%sweepEx%ZE=sgg%Sweep(iEx)%ZE - b%sweepEy%ZI=sgg%Sweep(iEy)%ZI - b%sweepEy%ZE=sgg%Sweep(iEy)%ZE - b%sweepEz%ZI=sgg%Sweep(iEz)%ZI - b%sweepEz%ZE=sgg%Sweep(iEz)%ZE - ! - b%sweepHx%ZI=sgg%Sweep(iHx)%ZI - b%sweepHx%ZE=sgg%Sweep(iHx)%ZE - b%sweepHy%ZI=sgg%Sweep(iHy)%ZI - b%sweepHy%ZE=sgg%Sweep(iHy)%ZE - b%sweepHz%ZI=sgg%Sweep(iHz)%ZI - b%sweepHz%ZE=sgg%Sweep(iHz)%ZE - ! - b%sweepSINPMLEx%XI=sgg%SINPMLSweep(iEx)%XI - b%sweepSINPMLEy%XI=sgg%SINPMLSweep(iEy)%XI - b%sweepSINPMLEz%XI=sgg%SINPMLSweep(iEz)%XI - b%sweepSINPMLHx%XI=sgg%SINPMLSweep(iHx)%XI - b%sweepSINPMLHy%XI=sgg%SINPMLSweep(iHy)%XI - b%sweepSINPMLHz%XI=sgg%SINPMLSweep(iHz)%XI - ! - b%sweepSINPMLEx%XE=sgg%SINPMLSweep(iEx)%XE - b%sweepSINPMLEy%XE=sgg%SINPMLSweep(iEy)%XE - b%sweepSINPMLEz%XE=sgg%SINPMLSweep(iEz)%XE - b%sweepSINPMLHx%XE=sgg%SINPMLSweep(iHx)%XE - b%sweepSINPMLHy%XE=sgg%SINPMLSweep(iHy)%XE - b%sweepSINPMLHz%XE=sgg%SINPMLSweep(iHz)%XE - ! - b%sweepSINPMLEx%YI=sgg%SINPMLSweep(iEx)%YI - b%sweepSINPMLEy%YI=sgg%SINPMLSweep(iEy)%YI - b%sweepSINPMLEz%YI=sgg%SINPMLSweep(iEz)%YI - b%sweepSINPMLHx%YI=sgg%SINPMLSweep(iHx)%YI - b%sweepSINPMLHy%YI=sgg%SINPMLSweep(iHy)%YI - b%sweepSINPMLHz%YI=sgg%SINPMLSweep(iHz)%YI - ! - b%sweepSINPMLEx%YE=sgg%SINPMLSweep(iEx)%YE - b%sweepSINPMLEy%YE=sgg%SINPMLSweep(iEy)%YE - b%sweepSINPMLEz%YE=sgg%SINPMLSweep(iEz)%YE - b%sweepSINPMLHx%YE=sgg%SINPMLSweep(iHx)%YE - b%sweepSINPMLHy%YE=sgg%SINPMLSweep(iHy)%YE - b%sweepSINPMLHz%YE=sgg%SINPMLSweep(iHz)%YE - ! - b%sweepSINPMLEx%ZI=sgg%SINPMLSweep(iEx)%ZI - b%sweepSINPMLEy%ZI=sgg%SINPMLSweep(iEy)%ZI - b%sweepSINPMLEz%ZI=sgg%SINPMLSweep(iEz)%ZI - b%sweepSINPMLHx%ZI=sgg%SINPMLSweep(iHx)%ZI - b%sweepSINPMLHy%ZI=sgg%SINPMLSweep(iHy)%ZI - b%sweepSINPMLHz%ZI=sgg%SINPMLSweep(iHz)%ZI - ! - b%sweepSINPMLEx%ZE=sgg%SINPMLSweep(iEx)%ZE - b%sweepSINPMLEy%ZE=sgg%SINPMLSweep(iEy)%ZE - b%sweepSINPMLEz%ZE=sgg%SINPMLSweep(iEz)%ZE - b%sweepSINPMLHx%ZE=sgg%SINPMLSweep(iHx)%ZE - b%sweepSINPMLHy%ZE=sgg%SINPMLSweep(iHy)%ZE - b%sweepSINPMLHz%ZE=sgg%SINPMLSweep(iHz)%ZE + !------------------------> + type (bounds_t), intent( IN) :: b + REAL (KIND=RKIND) , pointer, dimension ( : ) :: gm1 ,gm2 + ! + real (kind = RKIND), dimension ( 0 : b%dzE%NZ-1 ) , intent( IN) :: IdzE + real (kind = RKIND), dimension ( 0 : b%dxE%NX-1 ) , intent( IN) :: IdxE + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHy%NX-1 , 0 : b%sggMiHy%NY-1 , 0 : b%sggMiHy%NZ-1 ) , intent( IN) :: sggMiHy + real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) , intent( INOUT) :: HY + real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) , intent( IN) :: EZ + real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) , intent( IN) :: EX + !------------------------> Variables locales + real (kind = RKIND) :: Idzek + integer(kind = 4) :: i, j, k + integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio +#ifdef CompileWithOpenMP +!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idzek) +#endif +#ifdef CompileWithACC +!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idzek) copyin(Hy,sggMiHy,Ez,Ex,Idze,Idxe,b,GM1,GM2) copyout(Hy) +#endif + Do k=1,b%sweepHy%NZ + Do j=1,b%sweepHy%NY + Do i=1,b%sweepHy%NX + Idzek=Idze(k) + medio =sggMiHy(i,j,k) + Hy(i,j,k)=GM1(MEDIO)*Hy(i,j,k)+GM2(MEDIO)*((Ez(i+1,j,k)-Ez(i,j,k))*Idxe(i)-(Ex(i,j,k+1)-Ex(i,j,k))*Idzek) + End do + End do + End do +#ifdef CompileWithOpenMP +!$OMP END PARALLEL DO +#endif + return + end subroutine Advance_Hy - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !find lenghts - !this is automatic. Nothing to change - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - b%Ex%NX=b%Ex%XE-b%Ex%XI+1 - b%Ex%NY=b%Ex%YE-b%Ex%YI+1 - b%Ex%NZ=b%Ex%ZE-b%Ex%ZI+1 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine Advance_Hz(Hz,Ex,Ey,IdxE,IdyE,sggMiHz,b,gm1,gm2) - b%Ey%NX=b%Ey%XE-b%Ey%XI+1 - b%Ey%NY=b%Ey%YE-b%Ey%YI+1 - b%Ey%NZ=b%Ey%ZE-b%Ey%ZI+1 + !------------------------> + type (bounds_t), intent( IN) :: b + REAL (KIND=RKIND) , pointer, dimension ( : ) :: gm1 ,gm2 + ! + real (kind = RKIND), dimension ( 0 : b%dyE%NY-1 ) , intent( IN) :: IdyE + real (kind = RKIND), dimension ( 0 : b%dxE%NX-1 ) , intent( IN) :: IdxE + integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHz%NX-1 , 0 : b%sggMiHz%NY-1 , 0 : b%sggMiHz%NZ-1 ) , intent( IN) :: sggMiHz + real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) , intent( INOUT) :: Hz + real (kind = RKIND), dimension ( 0 : b%EX%NX-1 , 0 : b%EX%NY-1 , 0 : b%EX%NZ-1 ) , intent( IN) :: EX + real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) , intent( IN) :: EY + !------------------------> Variables locales + real (kind = RKIND) :: Idyej + integer(kind = 4) :: i, j, k + integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio +#ifdef CompileWithOpenMP +!$OMP PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idyej) +#endif +#ifdef CompileWithACC +!$ACC parallel loop DEFAULT(present) collapse (2) private (i,j,k,medio,Idyej) copyin(Hz,sggMiHz,Ex,Ey,Idxe,Idye,b,GM1,GM2) copyout(Hz) +#endif + Do k=1,b%sweepHz%NZ + Do j=1,b%sweepHz%NY + Do i=1,b%sweepHz%NX + Idyej=Idye(j) + medio =sggMiHz(i,j,k) + Hz(i,j,k)=GM1(MEDIO)*Hz(i,j,k)+GM2(MEDIO)*((Ex(i,j+1,k)-Ex(i,j,k))*Idyej-(Ey(i+1,j,k)-Ey(i,j,k))*Idxe(i)) + End do + End do + End do +#ifdef CompileWithOpenMP +!$OMP END PARALLEL DO +#endif + return + end subroutine Advance_Hz + + subroutine advanceWires() + character(len=bufsize) :: buff + if (( (trim(adjustl(this%control%wiresflavor))=='holland') .or. & + (trim(adjustl(this%control%wiresflavor))=='transition')) .and. .not. this%control%use_mtln_wires) then + IF (this%thereAre%Wires) then + if (this%control%wirecrank) then + call AdvanceWiresEcrank(sgg, this%n, this%control%layoutnumber,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic) + else +#ifdef CompileWithMTLN + if (this%mtln_parsed%has_multiwires) then + write(buff, *) 'ERROR: Multiwires in simulation but -mtlnwires flag has not been selected' + call WarnErrReport(buff) + end if +#endif + call AdvanceWiresE(sgg,this%n, this%control%layoutnumber,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic,this%control%experimentalVideal,this%control%wirethickness,eps0,mu0) + endif + endif + endif +#ifdef CompileWithBerengerWires + if (trim(adjustl(this%control%wiresflavor))=='berenger') then + IF (this%thereAre%Wires) call AdvanceWiresE_Berenger(sgg,n) + endif +#endif +#ifdef CompileWithSlantedWires + if((trim(adjustl(this%control%wiresflavor))=='slanted').or.(trim(adjustl(this%control%wiresflavor))=='semistructured')) then + call AdvanceWiresE_Slanted(sgg,n) + endif +#endif + if (this%control%use_mtln_wires) then +#ifdef CompileWithMTLN + call AdvanceWiresE_mtln(sgg,Idxh,Idyh,Idzh,eps0,mu0) +#else + write(buff,'(a)') 'WIR_ERROR: Executable was not compiled with MTLN modules.' +#endif + end if - b%Ez%NX=b%Ez%XE-b%Ez%XI+1 - b%Ez%NY=b%Ez%YE-b%Ez%YI+1 - b%Ez%NZ=b%Ez%ZE-b%Ez%ZI+1 - ! - b%Hx%NX=b%Hx%XE-b%Hx%XI+1 - b%Hx%NY=b%Hx%YE-b%Hx%YI+1 - b%Hx%NZ=b%Hx%ZE-b%Hx%ZI+1 - ! - b%Hy%NX=b%Hy%XE-b%Hy%XI+1 - b%Hy%NY=b%Hy%YE-b%Hy%YI+1 - b%Hy%NZ=b%Hy%ZE-b%Hy%ZI+1 - ! - b%Hz%NX=b%Hz%XE-b%Hz%XI+1 - b%Hz%NY=b%Hz%YE-b%Hz%YI+1 - b%Hz%NZ=b%Hz%ZE-b%Hz%ZI+1 - ! - ! - b%sweepEx%NX=b%sweepEx%XE-b%sweepEx%XI+1 - b%sweepEx%NY=b%sweepEx%YE-b%sweepEx%YI+1 - b%sweepEx%NZ=b%sweepEx%ZE-b%sweepEx%ZI+1 - ! - b%sweepEy%NX=b%sweepEy%XE-b%sweepEy%XI+1 - b%sweepEy%NY=b%sweepEy%YE-b%sweepEy%YI+1 - b%sweepEy%NZ=b%sweepEy%ZE-b%sweepEy%ZI+1 - ! - b%sweepEz%NX=b%sweepEz%XE-b%sweepEz%XI+1 - b%sweepEz%NY=b%sweepEz%YE-b%sweepEz%YI+1 - b%sweepEz%NZ=b%sweepEz%ZE-b%sweepEz%ZI+1 - ! - b%sweepHx%NX=b%sweepHx%XE-b%sweepHx%XI+1 - b%sweepHx%NY=b%sweepHx%YE-b%sweepHx%YI+1 - b%sweepHx%NZ=b%sweepHx%ZE-b%sweepHx%ZI+1 - ! - b%sweepHy%NX=b%sweepHy%XE-b%sweepHy%XI+1 - b%sweepHy%NY=b%sweepHy%YE-b%sweepHy%YI+1 - b%sweepHy%NZ=b%sweepHy%ZE-b%sweepHy%ZI+1 - ! - b%sweepHz%NX=b%sweepHz%XE-b%sweepHz%XI+1 - b%sweepHz%NY=b%sweepHz%YE-b%sweepHz%YI+1 - b%sweepHz%NZ=b%sweepHz%ZE-b%sweepHz%ZI+1 - ! - ! - b%sggMiEx%NX=b%sggMiEx%XE-b%sggMiEx%XI+1 - b%sggMiEx%NY=b%sggMiEx%YE-b%sggMiEx%YI+1 - b%sggMiEx%NZ=b%sggMiEx%ZE-b%sggMiEx%ZI+1 - b%sggMiEy%NX=b%sggMiEy%XE-b%sggMiEy%XI+1 - b%sggMiEy%NY=b%sggMiEy%YE-b%sggMiEy%YI+1 - b%sggMiEy%NZ=b%sggMiEy%ZE-b%sggMiEy%ZI+1 - b%sggMiEz%NX=b%sggMiEz%XE-b%sggMiEz%XI+1 - b%sggMiEz%NY=b%sggMiEz%YE-b%sggMiEz%YI+1 - b%sggMiEz%NZ=b%sggMiEz%ZE-b%sggMiEz%ZI+1 - ! - b%sggMiHx%NX=b%sggMiHx%XE-b%sggMiHx%XI+1 - b%sggMiHx%NY=b%sggMiHx%YE-b%sggMiHx%YI+1 - b%sggMiHx%NZ=b%sggMiHx%ZE-b%sggMiHx%ZI+1 - b%sggMiHy%NX=b%sggMiHy%XE-b%sggMiHy%XI+1 - b%sggMiHy%NY=b%sggMiHy%YE-b%sggMiHy%YI+1 - b%sggMiHy%NZ=b%sggMiHy%ZE-b%sggMiHy%ZI+1 - b%sggMiHz%NX=b%sggMiHz%XE-b%sggMiHz%XI+1 - b%sggMiHz%NY=b%sggMiHz%YE-b%sggMiHz%YI+1 - b%sggMiHz%NZ=b%sggMiHz%ZE-b%sggMiHz%ZI+1 - ! - ! - !estas longitudes son relativas al layout !ojo - b%dxe%NX=b%dxe%XE-b%dxe%XI+1 - b%dye%NY=b%dye%YE-b%dye%YI+1 - b%dze%NZ=b%dze%ZE-b%dze%ZI+1 - ! - b%dxh%NX=b%dxh%XE-b%dxh%XI+1 - b%dyh%NY=b%dyh%YE-b%dyh%YI+1 - b%dzh%NZ=b%dzh%ZE-b%dzh%ZI+1 + end subroutine advanceWires +! !PML E-field advancing (IT IS IMPORTANT TO FIRST CALL THE PML ADVANCING ROUTINES, SINCE THE DISPERSIVE +! !ROUTINES INJECT THE POLARIZATION CURRENTS EVERYWHERE (PML INCLUDED) +! !SO THAT DISPERSIVE MATERIALS CAN ALSO BE TRUNCATED BY CPML) + subroutine advancePMLE() + If (this%thereAre%PMLbodies) then !waveport absorbers + call AdvancePMLbodyE + endif + If (this%thereAre%PMLBorders) then + call AdvanceelectricCPML(sgg%NumMedia, this%bounds,this%sggMiEx,this%sggMiEy,this%sggMiEz,G2,Ex,Ey,Ez,Hx,Hy,Hz) + endif + end subroutine - end subroutine +#ifdef CompileWithMPI + subroutine initMPIConformalProbes() + integer (kind=4) :: group_conformalprobes_dummy, ierr +!!!!sgg250424 niapa para que funcionen sondas conformal mpi +!todos deben crear el subcomunicador mpi una sola vez + if (input_conformal_flag) then + SUBCOMM_MPI_conformal_probes=1 + MPI_conformal_probes_root=this%control%layoutnumber + else + SUBCOMM_MPI_conformal_probes=0 + MPI_conformal_probes_root=-1 + endif + call MPIinitSubcomm(this%control%layoutnumber,this%control%size,SUBCOMM_MPI_conformal_probes,& + MPI_conformal_probes_root,group_conformalprobes_dummy) + ! print *,'-----creating--->',this%control%layoutnumber,SIZE,SUBCOMM_MPI_conformal_probes,MPI_conformal_probes_root + call MPI_BASRRIER(SUBCOMM_MPI, ierr) + !!!no lo hago pero al salir deberia luego destruir el grupo call MPI_Group_free(output(ii)%item(i)%MPIgroupindex,ierr) + end subroutine initMPIConformalProbes +#endif + end subroutine step - end subroutine launch_simulation + subroutine solver_end(this, sgg, eps0, mu0, tagtype, finishedwithsuccess) + class(solver_t) :: this + type(sggfdtdinfo), intent(in) :: sgg + real(kind=rkind), intent(in) :: eps0,mu0 + type (tagtype_t), intent(in) :: tagtype + logical, intent(inout) :: finishedwithsuccess + + real(kind=rkind), pointer, dimension (:,:,:) :: Ex, Ey, Ez, Hx, Hy, Hz + real(kind=rkind), pointer, dimension (:) :: dxe, dye, dze, dxh, dyh, dzh + real(kind=rkind_tiempo) :: at + integer (kind=4) :: ndummy + logical :: dummylog, somethingdone, newsomethingdone + character(len=bufsize) :: dubuf + +#ifdef CompileWithMPI + integer (kind=4) :: ierr +#endif + Ex => this%Ex; Ey => this%Ey; Ez => this%Ez; Hx => this%Hx; Hy => this%Hy; Hz => this%Hz; + dxe => this%dxe; dye => this%dye; dze => this%dze; dxh => this%dxh; dyh => this%dyh; dzh => this%dzh + +#ifdef CompileWithProfiling + call nvtxEndRange +#endif + +#ifdef CompileWithConformal + if(this%control%input_conformal_flag) call conformal_final_simulation (conf_timeSteps, this%n) +#endif + +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + + if (this%n>this%control%finaltimestep) this%n = this%control%finaltimestep !readjust n since after finishing it is increased + this%control%finaltimestep = this%n + this%lastexecutedtime=sgg%tiempo(this%control%finaltimestep) + !se llama con dummylog para no perder los flags de parada + call Timing(sgg,this%bounds,this%n,ndummy,this%control%layoutnumber, this%control%size, & + this%control%maxCPUtime,this%control%flushsecondsFields, this%control%flushsecondsData, & + this%initialtimestep, this%control%finaltimestep,this%d_perform,dummylog,.FALSE., & + Ex,Ey,Ez,this%everflushed,this%control%nentradaroot,this%control%maxSourceValue, & + this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) + + write(dubuf,*)'END FDTD time stepping. Beginning posprocessing at n= ',this%n + call print11(this%control%layoutnumber,dubuf) + + if ((this%control%flushsecondsFields/=0).or.this%perform%flushFIELDS) then + write(dubuf,'(a,i9)') ' INIT FINAL FLUSHING OF RESTARTING FIELDS n= ',this%n + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call flush_and_save_resume(sgg, this%bounds, this%control%layoutnumber, this%control%size, this%control%nentradaroot, this%control%nresumeable2, this%thereare, this%n,eps0,mu0, this%everflushed, & + Ex, Ey, Ez, Hx, Hy, Hz,this%control%wiresflavor,this%control%simu_devia,this%control%stochastic) + write(dubuf,'(a,i9)') ' DONE FINAL FLUSHING OF RESTARTING FIELDS N=',this%n + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + endif + + if (this%thereAre%FarFields) then + write(dubuf,'(a,i9)') ' INIT FINAL OBSERVATION DATA FLUSHING and Near-to-Far field n= ',this%n + else + write(dubuf,'(a,i9)') ' INIT FINAL OBSERVATION DATA FLUSHING n= ',this%n + endif + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + if (this%thereAre%Observation) THEN + call FlushObservationFiles(sgg,this%ini_save, this%n,this%control%layoutnumber, this%control%size, dxe, dye, dze, dxh, dyh, dzh,this%bounds,this%control%singlefilewrite,this%control%facesNF2FF,.TRUE.) + call CloseObservationFiles(sgg,this%control%layoutnumber,this%control%size,this%control%singlefilewrite,this%initialtimestep,this%lastexecutedtime,this%control%resume) !dump the remaining to disk +#ifdef CompileWithMTLN + if (this%control%use_mtln_wires) then + call FlushMTLNObservationFiles(this%control%nentradaroot, mtlnProblem = .false.) + end if +#endif + endif + + if (this%thereAre%FarFields) then + write(dubuf,'(a,i9)') ' DONE FINAL OBSERVATION DATA FLUSHED and Near-to-Far field n= ',this%n + else + write(dubuf,'(a,i9)') ' DONE FINAL OBSERVATION DATA FLUSHED n= ',this%n + endif + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + call print11(this%control%layoutnumber,dubuf) + call print11(this%control%layoutnumber,SEPARADOR//separador//separador) + +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + + write(dubuf,'(a,i9)') 'INIT FINAL Postprocessing frequency domain probes, if any, at n= ',this%n + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + somethingdone=.false. + at=this%n*sgg%dt + if (this%thereAre%Observation) call PostProcess(this%control%layoutnumber,this%control%size,sgg,this%control%nentradaroot,at,somethingdone,this%control%niapapostprocess,this%control%forceresampled) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce(somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + somethingdone=newsomethingdone +#endif + + if (somethingdone) then + write(dubuf,*) 'DONE FINAL Postprocessing frequency domain probes.' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) 'No FINAL frequency domain probes snapshots found to be postrocessed' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + endif + + write(dubuf,*)'INIT FINAL FLUSHING .vtk if any.' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + somethingdone=.false. + + if (this%thereAre%Observation) call createvtk(this%control%layoutnumber,this%control%size,sgg,this%control%vtkindex,somethingdone,this%control%mpidir,tagtype,this%sggMtag,this%control%dontwritevtk) + +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce(somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + somethingdone=newsomethingdone +#endif + if (somethingdone) then + write(dubuf,*) 'DONE FINAL FLUSHING .vtk snapshots' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) 'No FINAL .vtk snapshots found to be flushed' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + endif + + write(dubuf,*)'INIT FINAL FLUSHING .xdmf if any.' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + somethingdone=.false. + if (this%thereAre%Observation) call createxdmf(sgg,this%control%layoutnumber,this%control%size,this%control%vtkindex,this%control%createh5bin,somethingdone,this%control%mpidir) + if (this%control%createh5bin) call createh5bintxt(sgg,this%control%layoutnumber,this%control%size) !lo deben llamar todos haya o no this%thereAre%observation +! call create_interpreted_mesh(sgg) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) + call MPI_AllReduce(somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + somethingdone=newsomethingdone +#endif + if (somethingdone) then + write(dubuf,*) 'DONE FINAL FLUSHING .xdmf snapshots' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + else + write(dubuf,*) 'No FINAL .xdmf snapshots found to be flushed' + call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) SEPARADOR//separador//separador + call print11(this%control%layoutnumber,dubuf) + endif +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + call Timing(sgg,this%bounds,this%n,ndummy,this%control%layoutnumber, & + this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields, & + this%control%flushsecondsData,this%initialtimestep, & + this%control%finaltimestep,this%perform,this%parar,.FALSE., & + Ex,Ey,Ez,this%everflushed,this%control%nentradaroot,this%control%maxSourceValue,this%control%opcionestotales, & + this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) + write(dubuf,*)'END FINAL POSTPROCESSING at n= ',this%n + call print11(this%control%layoutnumber,dubuf) + finishedwithsuccess=.true. + return + end subroutine !las sggmixx se desctruyen el en main pq se alocatean alli subroutine Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe ,dye ,dze ,Idxe ,Idye ,Idze ,dxh ,dyh ,dzh ,Idxh ,Idyh ,Idzh,thereare,wiresflavor ) @@ -2936,126 +2814,7 @@ subroutine Destroy_All_exceptSGGMxx(sgg,Ex, Ey, Ez, Hx, Hy, Hz,G1,G2,GM1,GM2,dxe end subroutine Destroy_All_exceptSGGMxx - subroutine crea_timevector(sgg,lastexecutedtimestep,finaltimestep,lastexecutedtime) - integer (kind=4) :: lastexecutedtimestep,finaltimestep,i - real (kind=RKIND_tiempo) :: lastexecutedtime - type (SGGFDTDINFO), intent(INOUT) :: sgg - allocate (sgg%tiempo(lastexecutedtimestep:finaltimestep+2)) - sgg%tiempo(lastexecutedtimestep)=lastexecutedtime - do i=lastexecutedtimestep+1,finaltimestep+2 - sgg%tiempo(i)=sgg%tiempo(i-1)+sgg%dt !equiespaciados por defecto !luego los modifica prescale - end do - return - end subroutine - - !!!!pruebas mergeando bucles (06/09/2016) !no se gana nada (ademas no he validado resultados, solo testeado velocidad) - -!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! subroutine Advance_ExEyEz(Ex,Ey,Ez,Hx,Hy,Hz,Idxh,Idyh,Idzh,sggMiEx,sggMiEy,sggMiEz,b,g1,g2) -!! -!! !------------------------> -!! type (bounds_t), intent( IN) :: b -!! REAL (KIND=RKIND) , pointer, dimension ( : ) :: g1, g2 -!! ! -!! real (kind = RKIND), dimension ( 0 : b%dxh%NX-1 ) , intent( IN) :: Idxh -!! real (kind = RKIND), dimension ( 0 : b%dyh%NY-1 ) , intent( IN) :: Idyh -!! real (kind = RKIND), dimension ( 0 : b%dzh%NZ-1 ) , intent( IN) :: Idzh -!! integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEx%NX-1 , 0 : b%sggMiEx%NY-1 , 0 : b%sggMiEx%NZ-1 ) , intent( IN) :: sggMiEx -!! integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEy%NX-1 , 0 : b%sggMiEy%NY-1 , 0 : b%sggMiEy%NZ-1 ) , intent( IN) :: sggMiEy -!! integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiEz%NX-1 , 0 : b%sggMiEz%NY-1 , 0 : b%sggMiEz%NZ-1 ) , intent( IN) :: sggMiEz -!! real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) , intent( INOUT) :: Ex -!! real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) , intent( INOUT) :: EY -!! real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) , intent( INOUT) :: Ez -!! real (kind = RKIND), dimension ( 0 : b%Hx%NX-1 , 0 : b%Hx%NY-1 , 0 : b%Hx%NZ-1 ) , intent( IN) :: HX -!! real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) , intent( IN) :: HY -!! real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) , intent( IN) :: HZ -!! !------------------------> Variables locales -!! real (kind = RKIND) :: Idzhk, Idyhj -!! integer(kind = 4) :: i, j, k -!! integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio -!! -!! -!!#ifdef CompileWithOpenMP -!!!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio,Idzhk,Idyhj) -!!#endif -!! Do k=1,max(b%sweepEx%NZ,b%sweepEy%NZ,b%sweepEz%NZ) -!! Idzhk=Idzh(k) -!! Do j=1,max(b%sweepEx%NY,b%sweepEy%NY,b%sweepEz%NY) -!! Idyhj=Idyh(j) -!! Do i=1,max(b%sweepEx%NX,b%sweepEy%NX,b%sweepEz%NX) -!! medio =sggMiEx(i,j,k) -!! Ex(i,j,k)=G1(MEDIO)*Ex(i,j,k)+G2(MEDIO)*((Hz(i,j,k)-Hz(i,j-1,k))*Idyhj-(Hy(i,j,k)-Hy(i,j,k-1))*Idzhk) -!! medio =sggMiEy(i,j,k) -!! Ey(i,j,k)=G1(MEDIO)*Ey(i,j,k)+G2(MEDIO)*((Hx(i,j,k)-Hx(i,j,k-1))*Idzhk-(Hz(i,j,k)-Hz(i-1,j,k))*Idxh(i)) -!! medio =sggMiEz(i,j,k) -!! Ez(i,j,k)=G1(MEDIO)*Ez(i,j,k)+G2(MEDIO)*((Hy(i,j,k)-Hy(i-1,j,k))*Idxh(i)-(Hx(i,j,k)-Hx(i,j-1,k))*Idyhj) -!! End do -!! End do -!! End do -!!#ifdef CompileWithOpenMP -!!!$OMP END PARALLEL DO -!!#endif -!! return -!! end subroutine Advance_ExEyEz -!! -!! -!! -!! -!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! -!! -!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! subroutine Advance_HxHyHz(Hx,Hy,Hz,Ex,Ey,Ez,IdxE,IdyE,IdzE,sggMiHx,sggMiHy,sggMiHz,b,gm1,gm2) -!! -!! !------------------------> -!! type (bounds_t), intent( IN) :: b -!! REAL (KIND=RKIND) , pointer, dimension ( : ) :: gm1 ,gm2 -!! !! -!! real (kind = RKIND), dimension ( 0 : b%dxE%NX-1 ) , intent( IN) :: IdxE -!! real (kind = RKIND), dimension ( 0 : b%dyE%NY-1 ) , intent( IN) :: IdyE -!! real (kind = RKIND), dimension ( 0 : b%dzE%NZ-1 ) , intent( IN) :: IdzE -!! integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHx%NX-1 , 0 : b%sggMiHx%NY-1 , 0 : b%sggMiHx%NZ-1 ) , intent( IN) :: sggMiHx -!! integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHy%NX-1 , 0 : b%sggMiHy%NY-1 , 0 : b%sggMiHy%NZ-1 ) , intent( IN) :: sggMiHy -!! integer(kind = INTEGERSIZEOFMEDIAMATRICES), dimension ( 0 : b%sggMiHz%NX-1 , 0 : b%sggMiHz%NY-1 , 0 : b%sggMiHz%NZ-1 ) , intent( IN) :: sggMiHz -!! real (kind = RKIND), dimension ( 0 : b%Hx%NX-1 , 0 : b%Hx%NY-1 , 0 : b%Hx%NZ-1 ) , intent( INOUT) :: Hx -!! real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) , intent( INOUT) :: HY -!! real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) , intent( INOUT) :: Hz -!! real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) , intent( IN) :: EX -!! real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) , intent( IN) :: EY -!! real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) , intent( IN) :: EZ -!! !------------------------> Variables locales -!! real (kind = RKIND) :: Idzek, Idyej -!! integer(kind = 4) :: i, j, k -!! integer(kind = INTEGERSIZEOFMEDIAMATRICES) :: medio -!!#ifdef CompileWithOpenMP -!!!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio,Idzek,Idyej) -!!#endif -!! Do k=1,max(b%sweepHx%NZ,b%sweepHy%NZ,b%sweepHz%NZ) -!! Idzek=Idze(k) -!! Do j=1,max(b%sweepHx%NY,b%sweepHy%NY,b%sweepHz%NY) -!! Idyej=Idye(j) -!! Do i=1,max(b%sweepHx%NX,b%sweepHy%NX,b%sweepHz%NX) -!! medio =sggMiHx(i,j,k) -!! Hx(i,j,k)=GM1(MEDIO)*Hx(i,j,k)+GM2(MEDIO)*((Ey(i,j,k+1)-Ey(i,j,k))*Idzek-(Ez(i,j+1,k)-Ez(i,j,k))*Idyej) -!! medio =sggMiHy(i,j,k) -!! Hy(i,j,k)=GM1(MEDIO)*Hy(i,j,k)+GM2(MEDIO)*((Ez(i+1,j,k)-Ez(i,j,k))*Idxe(i)-(Ex(i,j,k+1)-Ex(i,j,k))*Idzek) -!! medio =sggMiHz(i,j,k) -!! Hz(i,j,k)=GM1(MEDIO)*Hz(i,j,k)+GM2(MEDIO)*((Ex(i,j+1,k)-Ex(i,j,k))*Idyej-(Ey(i+1,j,k)-Ey(i,j,k))*Idxe(i)) -!! End do -!! End do -!! End do -!!#ifdef CompileWithOpenMP -!!!$OMP END PARALLEL DO -!!#endif -!! return -!! end subroutine Advance_HxHyHz - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 end module diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 1495d1bd..ba2d511a 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -9,6 +9,7 @@ set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/mod) if (SEMBA_FDTD_ENABLE_MTLN) add_subdirectory(mtln) set(MTLN_TESTS_LIBRARY mtln_tests) + add_subdirectory(system) set(SYSTEM_TESTS_LIBRARY system_tests) endif() if (SEMBA_FDTD_ENABLE_SMBJSON) @@ -16,6 +17,9 @@ if (SEMBA_FDTD_ENABLE_SMBJSON) set(SMBJSON_TESTS_LIBRARY smbjson_tests) endif() +add_subdirectory(mor) +set(MOR_TESTS_LIBRARY mor_tests) + add_executable(fdtd_tests "fdtd_tests.cpp" ) @@ -23,6 +27,8 @@ add_executable(fdtd_tests target_link_libraries(fdtd_tests ${MTLN_TESTS_LIBRARY} ${SMBJSON_TESTS_LIBRARY} + ${MOR_TESTS_LIBRARY} + ${SYSTEM_TESTS_LIBRARY} ${HDF_TESTS_LIBRARY} GTest::gtest_main ) \ No newline at end of file diff --git a/test/fdtd_tests.cpp b/test/fdtd_tests.cpp index b67ac0cf..b7a315b3 100644 --- a/test/fdtd_tests.cpp +++ b/test/fdtd_tests.cpp @@ -2,11 +2,14 @@ #ifdef CompileWithMTLN #include "mtln/mtln_tests.h" + #include "system/system_tests.h" #endif #ifdef CompileWithSMBJSON #include "smbjson/smbjson_tests.h" #endif +#include "mor/mor_tests.h" + int main(int argc, char **argv) { ::testing::InitGoogleTest(&argc, argv); return RUN_ALL_TESTS(); diff --git a/test/mor/CMakeLists.txt b/test/mor/CMakeLists.txt new file mode 100644 index 00000000..c243e8f9 --- /dev/null +++ b/test/mor/CMakeLists.txt @@ -0,0 +1,20 @@ +message(STATUS "Creating build system for test/mor") + +set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/mod) + +add_library (mor_test_fortran + "test_evolution_operator.F90" +) + +target_link_libraries(mor_test_fortran + fhash + ${JSONFORTRAN_LIB} + semba-main +) + +add_library(mor_tests "mor_tests.cpp") + +target_link_libraries(mor_tests + mor_test_fortran + GTest::gtest +) diff --git a/test/mor/mor_tests.cpp b/test/mor/mor_tests.cpp new file mode 100644 index 00000000..6a18eb94 --- /dev/null +++ b/test/mor/mor_tests.cpp @@ -0,0 +1 @@ +#include "mor_tests.h" \ No newline at end of file diff --git a/test/mor/mor_tests.h b/test/mor/mor_tests.h new file mode 100644 index 00000000..25ac95b8 --- /dev/null +++ b/test/mor/mor_tests.h @@ -0,0 +1,26 @@ +#include + +extern "C" int test_evolution_operator_dimension_Field_basis(); +extern "C" int test_evolution_operator_position_E_basis(); +extern "C" int test_evolution_operator_position_H_basis(); +extern "C" int test_evolution_operator_E_indices_map(); +extern "C" int test_evolution_operator_H_indices_map(); +extern "C" int test_evolution_operator_indices_map_all_fields(); +extern "C" int test_evolution_operator_column_map_creation(); +extern "C" int test_evolution_operator_comparison_with_solver(); +extern "C" int test_evolution_operator_read_bounds_from_semba(); +extern "C" int test_evolution_operator_get_field_outputs(); +extern "C" int test_evolution_operator_check_map_consistency(); + +TEST(mor, evolutionOperator_BasisDimension) { EXPECT_EQ(0, test_evolution_operator_dimension_Field_basis()); } +TEST(mor, evolutionOperator_PositionEBasis) { EXPECT_EQ(0, test_evolution_operator_position_E_basis()); } +TEST(mor, evolutionOperator_PositionHBasis) { EXPECT_EQ(0, test_evolution_operator_position_H_basis()); } +TEST(mor, evolutionOperator_EIndicesMap) { EXPECT_EQ(0, test_evolution_operator_E_indices_map()); } +TEST(mor, evolutionOperator_HIndicesMap) { EXPECT_EQ(0, test_evolution_operator_H_indices_map()); } +TEST(mor, evolutionOperator_IndicesMapAllFields) { EXPECT_EQ(0, test_evolution_operator_indices_map_all_fields()); } +TEST(mor, evolutionOperator_ColumnMapCreation) { EXPECT_EQ(0, test_evolution_operator_column_map_creation()); } +TEST(mor, evolutionOperator_CheckMapConsistency) { EXPECT_EQ(0, test_evolution_operator_check_map_consistency()); } +TEST(mor, evolutionOperator_ReadFieldBoundsFromSemba) { EXPECT_EQ(0, test_evolution_operator_read_bounds_from_semba()); } +TEST(mor, evolutionOperator_GetFieldOutputs) { EXPECT_EQ(0, test_evolution_operator_get_field_outputs()); } + +TEST(mor, evolutionOperator_ComparisonWithSolver) { EXPECT_EQ(0, test_evolution_operator_comparison_with_solver()); } diff --git a/test/mor/test_evolution_operator.F90 b/test/mor/test_evolution_operator.F90 new file mode 100644 index 00000000..0c669b68 --- /dev/null +++ b/test/mor/test_evolution_operator.F90 @@ -0,0 +1,712 @@ +integer function test_evolution_operator_dimension_Field_basis() bind (C, name="test_evolution_operator_dimension_Field_basis") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + use fhash, only: fhash_tbl_t, key => fhash_key + + implicit none + + real(RKIND), dimension(2,2,2) :: M_E + real(RKIND), dimension(2,2,2) :: M_ee, M_eo, M_oe, M_oo + real(RKIND), dimension(3,3,3) :: A + real(RKIND), allocatable :: M_H(:,:,:,:,:,:) + integer, parameter :: M1 = 2, M2 = 3, M3 = 3 + + err = 0 + + M_E = 0.0_RKIND + A = 0.0_RKIND + call GenerateElectricalInputBasis(M_E, 1, 2, M_ee, M_eo, M_oe, M_oo) + call GenerateMagneticalInputBasis(A, M1, M2, M3, M_H) + + if (size(M_ee, 1) /= 2 .or. size(M_ee, 2) /= 2 .or. size(M_ee, 3) /= 2) err = err + 1 + if (size(M_eo, 1) /= 2 .or. size(M_eo, 2) /= 2 .or. size(M_eo, 3) /= 2) err = err + 1 + if (size(M_oe, 1) /= 2 .or. size(M_oe, 2) /= 2 .or. size(M_oe, 3) /= 2) err = err + 1 + if (size(M_oo, 1) /= 2 .or. size(M_oo, 2) /= 2 .or. size(M_oo, 3) /= 2) err = err + 1 + + if (size(M_H,1) /= M1 .or. size(M_H,2) /= M2 .or. size(M_H,3) /= M3) err = err + 1 + if (size(M_H,4) /= 3 .or. size(M_H,5) /= 3 .or. size(M_H,6) /= 3) err = err + 1 + +end function test_evolution_operator_dimension_Field_basis + +integer function test_evolution_operator_position_E_basis() bind(C, name="test_evolution_operator_position_E_basis") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + + implicit none + + integer, parameter :: D1 = 2, D2 = 2, D3 = 2 + real(RKIND), dimension(D1,D2,D3) :: M_E + real(RKIND), dimension(D1,D2,D3) :: M_ee, M_eo, M_oe, M_oo, M_sum + integer, parameter :: dim1 = 1, dim2 = 2 + integer :: i, j, k + + err = 0 + + call GenerateElectricalInputBasis(M_E, dim1, dim2, M_ee, M_eo, M_oe, M_oo) + + do i = 1, D1 + do j = 1, D2 + do k = 1, D3 + if (abs(M_ee(i,j,k) + M_eo(i,j,k) + M_oe(i,j,k) + M_oo(i,j,k) - 1.0_RKIND) > 1.0e-12_RKIND) then + err = err + 1 + end if + + if (count([M_ee(i,j,k), M_eo(i,j,k), M_oe(i,j,k), M_oo(i,j,k)] == 1.0_RKIND) /= 1) then + err = err + 1 + end if + end do + end do + end do + + M_sum = M_ee + M_eo + M_oe + M_oo + if (any(abs(M_sum - 1.0_RKIND) > 1.0e-12_RKIND)) then + err = err + 1 + end if + +end function test_evolution_operator_position_E_basis + +integer function test_evolution_operator_position_H_basis() bind(C, name="test_evolution_operator_position_H_basis") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + + implicit none + + integer, parameter :: D1 = 2, D2 = 2, D3 = 2 + real(RKIND), dimension(D1,D2,D3) :: A + real(RKIND), allocatable :: M_H(:,:,:,:,:,:) + integer, parameter :: M1 = 2, M2 = 3, M3 = 3 + integer :: i, j, k + integer :: i_m1, i_m2, i_m3 + integer :: count_ones + + err = 0 + + A = 0.0_RKIND + call GenerateMagneticalInputBasis(A, M1, M2, M3, M_H) + + ! Loop over the dimensions of the H basis + do i = 1, D1 + do j = 1, D2 + do k = 1, D3 + count_ones = 0 + + ! Loop over all the elements in the H basis + do i_m1 = 1, M1 + do i_m2 = 1, M2 + do i_m3 = 1, M3 + if (abs(M_H(i_m1,i_m2,i_m3,i,j,k) - 1.0_RKIND) < 1.0e-12_RKIND) then + count_ones = count_ones + 1 + else if (abs(M_H(i_m1,i_m2,i_m3,i,j,k)) > 1.0e-12_RKIND) then + err = err + 1 + end if + end do + end do + end do + + if (count_ones /= 1) then + err = err + 1 + end if + + end do + end do + end do + +end function test_evolution_operator_position_H_basis + +! One final test related to the basis of the inputs for the construction of the evolution operator could be check if the separation corresponds with the one detected in the map + +integer function test_evolution_operator_E_indices_map() bind(C, name="test_evolution_operator_E_indices_map") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + use fhash, key => fhash_key + + implicit none + + integer :: i, j, k + integer :: m + type(bounds_t) :: bounds + type(fhash_tbl_t) :: RowIndexMap + type(int_array) :: wrapper + integer :: ElementsInMap + + bounds%Ex%NX = 2 + bounds%Ex%NY = 3 + bounds%Ex%NZ = 4 + + bounds%Hy%NX = 1 + bounds%Hy%NY = 4 + bounds%Hy%NZ = 3 + + bounds%Hz%NX = 1 + bounds%Hz%NY = 3 + bounds%Hz%NZ = 4 + + err = 0 + ElementsInMap = 0 + + call AddElectricFieldIndices(RowIndexMap, bounds%Ex, bounds%Hy, bounds%Hz, 0, 0, 0, 'k', 'j') + + do i = 1, bounds%Ex%NX + do j = 1, bounds%Ex%NY + do k = 1, bounds%Ex%NZ + m = ((i - 1)*bounds%Ex%NY + (j - 1))*bounds%Ex%NZ + k + + call fhash_get_int_array(RowIndexMap, key(m), wrapper) + + ! Check if the map has been created correctly for each i, j, k + if (size(wrapper%data) == 0) then + err = err + 1 + cycle + else + ElementsInMap = ElementsInMap + 1 + end if + + ! First we check the number of neighbours in the frontier of the first direction + if (j == 1 .or. j == bounds%Ex%Ny) then + if (k == 1 .or. k == bounds%Ex%NZ) then + if (size(wrapper%data) /= 3) then + err = err + 1 + end if + else + if (size(wrapper%data) /= 4) then + err = err + 1 + end if + end if + ! Then we check the number of neighbours in the frontier of the second direction that are not neighbours of the first direction + else if (k == 1 .or. k == bounds%Ex%NZ) then + if (size(wrapper%data) /= 4) then + err = err + 1 + end if + ! Finally we check the number of neighbours in the interior of the grid + else + if (size(wrapper%data) /= 5) then + err = err + 1 + end if + end if + + end do + end do + end do + + if (ElementsInMap /= bounds%Ex%NX * bounds%Ex%NY * bounds%Ex%NZ) then + err = err + 1 + end if + +end function test_evolution_operator_E_indices_map + +integer function test_evolution_operator_H_indices_map() bind(C, name="test_evolution_operator_H_indices_map") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + use fhash, key => fhash_key + + implicit none + + integer :: i, j, k + integer :: m + type(bounds_t) :: bounds + type(fhash_tbl_t) :: RowIndexMap + type(int_array) :: wrapper + integer :: ElementsInMap + integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz + + bounds%Ex%NX = 1 + bounds%Ex%NY = 4 + bounds%Ex%NZ = 4 + + bounds%Ey%NX = 2 + bounds%Ey%NY = 3 + bounds%Ey%NZ = 4 + + bounds%Ez%NX = 2 + bounds%Ez%NY = 4 + bounds%Ez%NZ = 3 + + bounds%Hx%NX = 2 + bounds%Hx%NY = 3 + bounds%Hx%NZ = 3 + + bounds%Hy%NX = 1 + bounds%Hy%NY = 4 + bounds%Hy%NZ = 3 + + bounds%Hz%NX = 1 + bounds%Hz%NY = 3 + bounds%Hz%NZ = 4 + + shiftEx = 0 + shiftEy = 0 + bounds%Ex%Nx * bounds%Ex%Ny * bounds%Ex%Nz + shiftEz = shiftEy + bounds%Ey%Nx * bounds%Ey%Ny * bounds%Ey%Nz + shiftHx = shiftEz + bounds%Ez%Nx * bounds%Ez%Ny * bounds%Ez%Nz + shiftHy = shiftHx + bounds%Hx%Nx * bounds%Hx%Ny * bounds%Hx%Nz + shiftHz = shiftHy + bounds%Hy%Nx * bounds%Hy%Ny * bounds%Hy%Nz + + err = 0 + ElementsInMap = 0 + + ! To verify the H indices map, first I need to create the map of all the Electric fields + + call AddElectricFieldIndices(RowIndexMap, bounds%Ey, bounds%Hx, bounds%Hz, shiftEy, shiftHx, shiftHz, 'k', 'i') + call AddElectricFieldIndices(RowIndexMap, bounds%Ez, bounds%Hx, bounds%Hy, shiftEz, shiftHx, shiftHy, 'j', 'i') + call AddMagneticFieldIndices(RowIndexMap, bounds%Hx, bounds%Ez, bounds%Ey, shiftHx, shiftEz, shiftEy, 'j', 'k') + + do i = 1, bounds%Hx%NX + do j = 1, bounds%Hx%NY + do k = 1, bounds%Hx%NZ + m = ((i - 1)*bounds%Hx%NY + (j - 1))*bounds%Hx%NZ + k + + call fhash_get_int_array(RowIndexMap, key(shiftHx + m), wrapper) + + ! Check if the map has been created correctly for each i, j, k + if (size(wrapper%data) == 0) then + err = err + 1 + cycle + else + ElementsInMap = ElementsInMap + 1 + end if + + ! In theory, the indices related to the H field must be maximum 17 and minimum 9, due to the form of the evolution operator, + ! it is difficult to check the exact number of neighbours, but we can check the limits + if (size(wrapper%data) < 9 .or. size(wrapper%data) > 17) then + err = err + 1 + end if + + ! In this particular test, the frontiers must have those specific number of neighbours due to the geometry + ! First we check the number of neighbours in the frontier of the first direction + if (j == 1 .or. j == bounds%Hx%Ny) then + if (k == 1 .or. k == bounds%Hx%NZ) then + if (size(wrapper%data) /= 11) then + err = err + 1 + end if + else + if (size(wrapper%data) /= 12) then + err = err + 1 + end if + end if + ! Then we check the number of neighbours in the frontier of the second direction that are not neighbours of the first direction + else if (k == 1 .or. k == bounds%Hx%NZ) then + if (size(wrapper%data) /= 12) then + err = err + 1 + end if + ! Finally we check the number of neighbours in the interior of the grid + else + if (size(wrapper%data) /= 13) then + err = err + 1 + end if + end if + + end do + end do + end do + + if (ElementsInMap /= bounds%Hx%NX * bounds%Hx%NY * bounds%Hx%NZ) then + err = err + 1 + end if +end function test_evolution_operator_H_indices_map + + +integer function test_evolution_operator_indices_map_all_fields() bind(C, name="test_evolution_operator_indices_map_all_fields") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + use fhash, key => fhash_key + + implicit none + + integer :: m + type(bounds_t) :: bounds + type(fhash_tbl_t) :: RowIndexMap + type(int_array) :: wrapper + integer :: totalElements + + bounds%Ex%NX = 1 + bounds%Ex%NY = 4 + bounds%Ex%NZ = 4 + + bounds%Ey%NX = 2 + bounds%Ey%NY = 3 + bounds%Ey%NZ = 4 + + bounds%Ez%NX = 2 + bounds%Ez%NY = 4 + bounds%Ez%NZ = 3 + + bounds%Hx%NX = 2 + bounds%Hx%NY = 3 + bounds%Hx%NZ = 3 + + bounds%Hy%NX = 1 + bounds%Hy%NY = 4 + bounds%Hy%NZ = 3 + + bounds%Hz%NX = 1 + bounds%Hz%NY = 3 + bounds%Hz%NZ = 4 + + err = 0 + + totalElements = bounds%Ex%NX * bounds%Ex%NY * bounds%Ex%NZ + & + bounds%Ey%NX * bounds%Ey%NY * bounds%Ey%NZ + & + bounds%Ez%NX * bounds%Ez%NY * bounds%Ez%NZ + & + bounds%Hx%NX * bounds%Hx%NY * bounds%Hx%NZ + & + bounds%Hy%NX * bounds%Hy%NY * bounds%Hy%NZ + & + bounds%Hz%NX * bounds%Hz%NY * bounds%Hz%NZ + + call GenerateRowIndexMap(bounds, RowIndexMap) + + do m = 1, totalElements + call fhash_get_int_array(RowIndexMap, key(m), wrapper) + + if (size(wrapper%data) == 0) then + err = err + 1 + end if + end do + + end function test_evolution_operator_indices_map_all_fields + + integer function test_evolution_operator_column_map_creation() bind(C, name="test_evolution_operator_column_map_creation") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + use fhash, key => fhash_key + + implicit none + + integer :: m + type(bounds_t) :: bounds + type(fhash_tbl_t) :: ColIndexMap + type(int_array) :: wrapper + integer :: totalElements + + bounds%Ex%NX = 1 + bounds%Ex%NY = 4 + bounds%Ex%NZ = 4 + + bounds%Ey%NX = 2 + bounds%Ey%NY = 3 + bounds%Ey%NZ = 4 + + bounds%Ez%NX = 2 + bounds%Ez%NY = 4 + bounds%Ez%NZ = 3 + + bounds%Hx%NX = 2 + bounds%Hx%NY = 3 + bounds%Hx%NZ = 3 + + bounds%Hy%NX = 1 + bounds%Hy%NY = 4 + bounds%Hy%NZ = 3 + + bounds%Hz%NX = 1 + bounds%Hz%NY = 3 + bounds%Hz%NZ = 4 + + err = 0 + + totalElements = bounds%Ex%NX * bounds%Ex%NY * bounds%Ex%NZ + & + bounds%Ey%NX * bounds%Ey%NY * bounds%Ey%NZ + & + bounds%Ez%NX * bounds%Ez%NY * bounds%Ez%NZ + & + bounds%Hx%NX * bounds%Hx%NY * bounds%Hx%NZ + & + bounds%Hy%NX * bounds%Hy%NY * bounds%Hy%NZ + & + bounds%Hz%NX * bounds%Hz%NY * bounds%Hz%NZ + + call GenerateColumnIndexMap(bounds, ColIndexMap) + + do m = 1, totalElements + call fhash_get_int_array(ColIndexMap, key(m), wrapper) + + if (size(wrapper%data) == 0) then + err = err + 1 + end if + end do + + end function test_evolution_operator_column_map_creation + + integer function test_evolution_operator_check_map_consistency() bind(C, name="test_evolution_operator_check_map_consistency") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + use fhash, key => fhash_key + + implicit none + + integer :: m, i + type(bounds_t) :: bounds + type(fhash_tbl_t) :: ColIndexMap, RowIndexMap + type(int_array) :: wrapperCol, wrapperRow + integer :: totalElements + + bounds%Ex%NX = 1 + bounds%Ex%NY = 4 + bounds%Ex%NZ = 4 + + bounds%Ey%NX = 2 + bounds%Ey%NY = 3 + bounds%Ey%NZ = 4 + + bounds%Ez%NX = 2 + bounds%Ez%NY = 4 + bounds%Ez%NZ = 3 + + bounds%Hx%NX = 2 + bounds%Hx%NY = 3 + bounds%Hx%NZ = 3 + + bounds%Hy%NX = 1 + bounds%Hy%NY = 4 + bounds%Hy%NZ = 3 + + bounds%Hz%NX = 1 + bounds%Hz%NY = 3 + bounds%Hz%NZ = 4 + + err = 0 + + totalElements = bounds%Ex%NX * bounds%Ex%NY * bounds%Ex%NZ + & + bounds%Ey%NX * bounds%Ey%NY * bounds%Ey%NZ + & + bounds%Ez%NX * bounds%Ez%NY * bounds%Ez%NZ + & + bounds%Hx%NX * bounds%Hx%NY * bounds%Hx%NZ + & + bounds%Hy%NX * bounds%Hy%NY * bounds%Hy%NZ + & + bounds%Hz%NX * bounds%Hz%NY * bounds%Hz%NZ + + call GenerateRowIndexMap(bounds, RowIndexMap) + call GenerateColumnIndexMap(bounds, ColIndexMap) + + do m = 1, totalElements + call fhash_get_int_array(ColIndexMap, key(m), wrapperCol) + + do i = 1, size(wrapperCol%data) + call fhash_get_int_array(RowIndexMap, key(wrapperCol%data(i)), wrapperRow) + + if (all(wrapperRow%data /= m)) then + err = err + 1 + end if + end do + end do + + do m = 1, totalElements + call fhash_get_int_array(RowIndexMap, key(m), wrapperRow) + + do i = 1, size(wrapperRow%data) + call fhash_get_int_array(ColIndexMap, key(wrapperRow%data(i)), wrapperCol) + + if (all(wrapperCol%data /= m)) then + err = err + 1 + end if + end do + end do + + end function test_evolution_operator_check_map_consistency + + integer function test_evolution_operator_read_bounds_from_semba() bind(C, name="test_evolution_operator_read_bounds_from_semba") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + use SEMBA_FDTD_mod + + + implicit none + + type(bounds_t) :: bounds + type(semba_fdtd_t) :: semba + character(len=*),parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'grid_50x3x3.fdtd.json' + + err = 0 + + call semba%init(trim('-i '//filename)) + call get_field_bounds_from_sembaFullsize(bounds, semba%fullsize) + + if (bounds%Ex%Nx /= 50 .or. bounds%Ex%Ny /= 4 .or. bounds%Ex%Nz /= 4) err = err + 1 + if (bounds%Ey%Nx /= 51 .or. bounds%Ey%Ny /= 3 .or. bounds%Ey%Nz /= 4) err = err + 1 + if (bounds%Ez%Nx /= 51 .or. bounds%Ez%Ny /= 4 .or. bounds%Ez%Nz /= 3) err = err + 1 + if (bounds%Hx%Nx /= 51 .or. bounds%Hx%Ny /= 3 .or. bounds%Hx%Nz /= 3) err = err + 1 + if (bounds%Hy%Nx /= 50 .or. bounds%Hy%Ny /= 4 .or. bounds%Hy%Nz /= 3) err = err + 1 + if (bounds%Hz%Nx /= 50 .or. bounds%Hz%Ny /= 3 .or. bounds%Hz%Nz /= 4) err = err + 1 + + + end function test_evolution_operator_read_bounds_from_semba + + integer function test_evolution_operator_get_field_outputs() bind(C, name="test_evolution_operator_get_field_outputs") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + use SEMBA_FDTD_mod + + implicit none + + type(bounds_t) :: bounds + type(semba_fdtd_t) :: semba + type(solver_t) :: solver + type(field_array_t), allocatable :: fieldArrayInput(:), fieldArrayOutput(:) + real(RKIND), allocatable :: initialState(:), finalState(:) + integer :: i, j, k, nFields + + character(len=*),parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'grid_3x3x3.fdtd.json' + + err = 0 + + call semba%init(trim('-i '//filename)) + call solver%init_control(semba%l, semba%maxSourceValue, semba%time_desdelanzamiento) + call solver%init(semba%sgg,semba%eps0, semba%mu0, semba%sggMiNo,& + semba%sggMiEx,semba%sggMiEy,semba%sggMiEz,& + semba%sggMiHx,semba%sggMiHy,semba%sggMiHz, & + semba%sggMtag, semba%SINPML_fullsize, semba%fullsize, semba%tag_numbers) + + call get_field_bounds_from_sembaFullsize(bounds, semba%fullsize) + + ! Creating an initial field array with all the fields with zeros + allocate(fieldArrayInput(6)) + + fieldArrayInput(1)%field_type = 'Ex' + allocate(fieldArrayInput(1)%data(bounds%Ex%Nx, bounds%Ex%Ny, bounds%Ex%Nz)) + fieldArrayInput(1)%data = 0.0_RKIND + + fieldArrayInput(2)%field_type = 'Ey' + allocate(fieldArrayInput(2)%data(bounds%Ey%Nx, bounds%Ey%Ny, bounds%Ey%Nz)) + fieldArrayInput(2)%data = 0.0_RKIND + + fieldArrayInput(3)%field_type = 'Ez' + allocate(fieldArrayInput(3)%data(bounds%Ez%Nx, bounds%Ez%Ny, bounds%Ez%Nz)) + fieldArrayInput(3)%data = 0.0_RKIND + + fieldArrayInput(4)%field_type = 'Hx' + allocate(fieldArrayInput(4)%data(bounds%Hx%Nx, bounds%Hx%Ny, bounds%Hx%Nz)) + fieldArrayInput(4)%data = 0.0_RKIND + + fieldArrayInput(5)%field_type = 'Hy' + allocate(fieldArrayInput(5)%data(bounds%Hy%Nx, bounds%Hy%Ny, bounds%Hy%Nz)) + fieldArrayInput(5)%data = 0.0_RKIND + + fieldArrayInput(6)%field_type = 'Hz' + allocate(fieldArrayInput(6)%data(bounds%Hz%Nx, bounds%Hz%Ny, bounds%Hz%Nz)) + fieldArrayInput(6)%data = 0.0_RKIND + + ! Putting a non zero value in Ex(2,2,2) + fieldArrayInput(1)%data(2,2,2) = 1.0_RKIND + + + call GenerateStateFromFields(fieldArrayInput, initialState) + call EvolveState(semba, solver, initialState, finalState) + call GenerateFieldArrayFromState(finalState, fieldArrayInput, fieldArrayOutput) + + ! We expect to see values different from zero in Ex(2,2,2), Hy(2,2,2), Hy(2,2,1), Hz(2,2,2) and Hz(2,1,2) and zeros in the rest of the components of the fields + if (abs(fieldArrayOutput(1)%data(2,2,2)) < 1.0e-12_RKIND) err = err + 1 + + if (abs(fieldArrayOutput(5)%data(2,2,2)) < 1.0e-12_RKIND) err = err + 1 + if (abs(fieldArrayOutput(5)%data(2,2,1)) < 1.0e-12_RKIND) err = err + 1 + + if (abs(fieldArrayOutput(6)%data(2,2,2)) < 1.0e-12_RKIND) err = err + 1 + if (abs(fieldArrayOutput(6)%data(2,1,2)) < 1.0e-12_RKIND) err = err + 1 + + do nFields = 1, size(fieldArrayOutput) + do i = 1, size(fieldArrayOutput(nFields)%data, 1) + do j = 1, size(fieldArrayOutput(nFields)%data, 2) + do k = 1, size(fieldArrayOutput(nFields)%data, 3) + select case (fieldArrayOutput(nFields)%field_type) + case ('Ex') + if (i == 2 .and. j == 2 .and. k == 2) cycle + if (abs(fieldArrayOutput(nFields)%data(i,j,k)) > 1.0e-12_RKIND) err = err + 1 + case ('Ey') + if (abs(fieldArrayOutput(nFields)%data(i,j,k)) > 1.0e-12_RKIND) err = err + 1 + case ('Ez') + if (abs(fieldArrayOutput(nFields)%data(i,j,k)) > 1.0e-12_RKIND) err = err + 1 + case ('Hx') + if (abs(fieldArrayOutput(nFields)%data(i,j,k)) > 1.0e-12_RKIND) err = err + 1 + case ('Hy') + if ((i == 2 .and. j == 2 .and. k == 2) .or. (i == 2 .and. j == 2 .and. k == 1)) cycle + if (abs(fieldArrayOutput(nFields)%data(i,j,k)) > 1.0e-12_RKIND) err = err + 1 + case ('Hz') + if ((i == 2 .and. j == 2 .and. k == 2) .or. (i == 2 .and. j == 1 .and. k == 2)) cycle + if (abs(fieldArrayOutput(nFields)%data(i,j,k)) > 1.0e-12_RKIND) err = err + 1 + end select + end do + end do + end do + end do + + end function test_evolution_operator_get_field_outputs + + integer function test_evolution_operator_comparison_with_solver() bind(C, name="test_evolution_operator_comparison_with_solver") result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + use SEMBA_FDTD_mod + + implicit none + + type(bounds_t) :: bounds + type(semba_fdtd_t) :: semba + type(solver_t) :: solver + type(field_array_t), allocatable :: fieldArrayInput(:), fieldArrayOutput(:) + real(RKIND), allocatable :: initialState(:), finalState(:) + integer :: i, j, k, nFields + + character(len=*),parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'grid_3x3x3.fdtd.json' + + err = 0 + + ! Creating the results from the evolution operator + call semba%init(trim('-i '//filename)) + call solver%init_control(semba%l, semba%maxSourceValue, semba%time_desdelanzamiento) + call solver%init(semba%sgg,semba%eps0, semba%mu0, semba%sggMiNo,& + semba%sggMiEx,semba%sggMiEy,semba%sggMiEz,& + semba%sggMiHx,semba%sggMiHy,semba%sggMiHz, & + semba%sggMtag, semba%SINPML_fullsize, semba%fullsize, semba%tag_numbers) + + call get_field_bounds_from_sembaFullsize(bounds, semba%fullsize) + + ! Creating an initial field array with all the fields with zeros + allocate(fieldArrayInput(6)) + + fieldArrayInput(1)%field_type = 'Ex' + allocate(fieldArrayInput(1)%data(bounds%Ex%Nx, bounds%Ex%Ny, bounds%Ex%Nz)) + fieldArrayInput(1)%data = 0.0_RKIND + + fieldArrayInput(2)%field_type = 'Ey' + allocate(fieldArrayInput(2)%data(bounds%Ey%Nx, bounds%Ey%Ny, bounds%Ey%Nz)) + fieldArrayInput(2)%data = 0.0_RKIND + + fieldArrayInput(3)%field_type = 'Ez' + allocate(fieldArrayInput(3)%data(bounds%Ez%Nx, bounds%Ez%Ny, bounds%Ez%Nz)) + fieldArrayInput(3)%data = 0.0_RKIND + + fieldArrayInput(4)%field_type = 'Hx' + allocate(fieldArrayInput(4)%data(bounds%Hx%Nx, bounds%Hx%Ny, bounds%Hx%Nz)) + fieldArrayInput(4)%data = 0.0_RKIND + + fieldArrayInput(5)%field_type = 'Hy' + allocate(fieldArrayInput(5)%data(bounds%Hy%Nx, bounds%Hy%Ny, bounds%Hy%Nz)) + fieldArrayInput(5)%data = 0.0_RKIND + + fieldArrayInput(6)%field_type = 'Hz' + allocate(fieldArrayInput(6)%data(bounds%Hz%Nx, bounds%Hz%Ny, bounds%Hz%Nz)) + fieldArrayInput(6)%data = 0.0_RKIND + + ! Putting a non zero value in Ex(2,2,2) + fieldArrayInput(1)%data(2,2,2) = 1.0_RKIND + + + call GenerateStateFromFields(fieldArrayInput, initialState) + call EvolveState(semba, solver, initialState, finalState) + call GenerateFieldArrayFromState(finalState, fieldArrayInput, fieldArrayOutput) + + ! Creating the results from the solver + call ResetSolverFields(solver) + + ! Putting a non zero value in Ex(2,2,2), remembering that the full solver starts arrays from 0 and not from 1 + call solver%set_field_value(iEx, [1,1], [1,1], [1,1], 1.0) + call solver%step(semba%sgg, semba%eps0, semba%mu0, semba%SINPML_FULLSIZE, semba%tag_numbers) + + ! Comparing the non zero values of both methods + if (abs(fieldArrayOutput(1)%data(2,2,2) - solver%get_field_value(iEx, 1,1,1)) > 1.0e-12_RKIND) err = err + 1 + if (abs(fieldArrayOutput(5)%data(2,2,2) - solver%get_field_value(iHy, 1,1,1)) > 1.0e-12_RKIND) err = err + 1 + if (abs(fieldArrayOutput(5)%data(2,2,1) - solver%get_field_value(iHy, 1,1,0)) > 1.0e-12_RKIND) err = err + 1 + if (abs(fieldArrayOutput(6)%data(2,2,2) - solver%get_field_value(iHz, 1,1,1)) > 1.0e-12_RKIND) err = err + 1 + if (abs(fieldArrayOutput(6)%data(2,1,2) - solver%get_field_value(iHz, 1,0,1)) > 1.0e-12_RKIND) err = err + 1 + + end function test_evolution_operator_comparison_with_solver \ No newline at end of file diff --git a/test/smbjson/smbjson_tests.h b/test/smbjson/smbjson_tests.h index f1d5a25f..9d763dec 100644 --- a/test/smbjson/smbjson_tests.h +++ b/test/smbjson/smbjson_tests.h @@ -29,6 +29,7 @@ extern "C" int test_read_large_airplane_mtln(); extern "C" int test_read_lumped_fixture(); extern "C" int test_read_unshielded_multiwires_multipolar_expansion(); + TEST(smbjson, idchildtable_fhash) {EXPECT_EQ(0, test_idchildtable_fhash()); } TEST(smbjson, idchildtable_add_get) {EXPECT_EQ(0, test_idchildtable()); } diff --git a/test/system/CMakeLists.txt b/test/system/CMakeLists.txt new file mode 100644 index 00000000..9b22bbc5 --- /dev/null +++ b/test/system/CMakeLists.txt @@ -0,0 +1,26 @@ + +message(STATUS "Creating build system for test/system") + +set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/mod) + +add_library( + system_test_fortran + "system_testingTools.F90" + "test_init_solver.F90" +) + +target_link_libraries(system_test_fortran + fhash + mtlnsolver + ngspice_interface + smbjson + ${JSONFORTRAN_LIB} + semba-main +) + +add_library(system_tests "system_tests.cpp") + +target_link_libraries(system_tests + system_test_fortran + GTest::gtest +) \ No newline at end of file diff --git a/test/system/init_solver.fdtd.json b/test/system/init_solver.fdtd.json new file mode 100644 index 00000000..50e790e1 --- /dev/null +++ b/test/system/init_solver.fdtd.json @@ -0,0 +1,52 @@ +{ + "format": "FDTD Input file", + "__comments": "1m linear antenna illuminated by a pulse : Holland, R. Finite-Difference Analysis of EMP Coupling to Thin Struts and Wires. 2000. IEEE-TEMC.", + + "general": { + "timeStep": 30e-12, + "numberOfSteps": 1000 + }, + + "boundary": { + "all": { + "type": "pml", + "layers": 6, + "order": 2.0, + "reflection": 0.001 + } + }, + + "materials": [ + { + "id": 1, + "type": "wire", + "radius": 0.02, + "resistancePerMeter": 0.0, + "inductancePerMeter": 0.0 + }, + { + "id": 2, + "type": "terminal", + "terminations": [{"type": "open"}] + } + ], + + "mesh": { + "grid": { + "numberOfCells": [20, 20, 22], + "steps": { "x": [0.1], "y": [0.1], "z": [0.1] } + }, + "coordinates": [ + {"id": 1, "relativePosition": [11, 11, 7]}, + {"id": 2, "relativePosition": [11, 11, 12]}, + {"id": 3, "relativePosition": [11, 11, 17]}, + {"id": 4, "relativePosition": [12, 11, 17]} + ], + "elements": [ + {"id": 1, "type": "node", "coordinateIds": [2]}, + {"id": 2, "type": "polyline", "coordinateIds": [1, 2, 3] }, + {"id": 3, "type": "cell", "intervals": [[[1, 1, 1], [19, 19, 21]]] }, + {"id": 4, "type": "node", "coordinateIds": [4]} + ] + } +} \ No newline at end of file diff --git a/test/system/system_testingTools.F90 b/test/system/system_testingTools.F90 new file mode 100644 index 00000000..e50b814a --- /dev/null +++ b/test/system/system_testingTools.F90 @@ -0,0 +1,10 @@ +module system_testingTools_mod + use iso_c_binding + + implicit none + + character(len=*), parameter :: PATH_TO_TEST_DATA = 'testData/' + character(len=*), parameter :: INPUT_EXAMPLES='input_examples/' + + + end module system_testingTools_mod \ No newline at end of file diff --git a/test/system/system_tests.cpp b/test/system/system_tests.cpp new file mode 100644 index 00000000..15743a74 --- /dev/null +++ b/test/system/system_tests.cpp @@ -0,0 +1 @@ +#include "system_tests.h" \ No newline at end of file diff --git a/test/system/system_tests.h b/test/system/system_tests.h new file mode 100644 index 00000000..f0d539c3 --- /dev/null +++ b/test/system/system_tests.h @@ -0,0 +1,6 @@ +#include + +extern "C" int test_init_solver(); + +TEST(system, init_solver) {EXPECT_EQ(0, test_init_solver()); } + diff --git a/test/system/test_init_solver.F90 b/test/system/test_init_solver.F90 new file mode 100644 index 00000000..ca438bd0 --- /dev/null +++ b/test/system/test_init_solver.F90 @@ -0,0 +1,23 @@ +integer function test_init_solver() bind (C) result(err) + use SEMBA_FDTD_mod + use system_testingTools_mod + implicit none + type(semba_fdtd_t) :: semba + type(solver_t) :: solver + + err = 0 + call chdir("./test/system/") + + call semba%init("-i init_solver.fdtd.json") + call solver%init_control(semba%l, semba%maxSourceValue, semba%time_desdelanzamiento) + call solver%init(semba%sgg,semba%eps0, semba%mu0, semba%sggMiNo,& + semba%sggMiEx,semba%sggMiEy,semba%sggMiEz,& + semba%sggMiHx,semba%sggMiHy,semba%sggMiHz, & + semba%sggMtag, semba%SINPML_fullsize, semba%fullsize, semba%tag_numbers) + call solver%set_field_value(iEx, [2,4], [2,2], [2,2], 1.0) + call solver%step(semba%sgg, semba%eps0, semba%mu0, semba%SINPML_FULLSIZE, semba%tag_numbers) + if (solver%get_field_value(iHy, 2,2,2) == 0) err = err + 1 + if (solver%get_field_value(iHz, 2,2,2) == 0) err = err + 1 + + call chdir("../../") +end function \ No newline at end of file diff --git a/test/system/test_json_to_solver_input_shielded_pair.F90 b/test/system/test_json_to_solver_input_shielded_pair.F90 deleted file mode 100644 index a4f134e9..00000000 --- a/test/system/test_json_to_solver_input_shielded_pair.F90 +++ /dev/null @@ -1,170 +0,0 @@ -integer function test_json_to_solver_input_shielded_pair() bind (C) result(err) - use smbjson - use system_testingTools_mod - use mtln_solver_mod, mtln_solver_t => mtln_t - - implicit none - - character(len=*),parameter :: filename = PATH_TO_TEST_DATA//'cases/shieldedPair.fdtd.json' - type(Parseador) :: problem - type(parser_t) :: parser - type(mtln_solver_t) :: solver - type(preprocess_t) :: pre, expected - logical :: areSame - integer :: i - err = 0 - - parser = parser_t(filename) - problem = parser%readProblemDescription() - - expected = expectedPreprocess() - pre = preprocess(problem%mtln) - - solver = mtlnCtor(problem%mtln) - call solver%runUntil(2e-12) - write(*,*) 'h' - ! call expect_eq(err, expected, problem) - ! if (.not. all(abs(pre%bundles(1)%lpul(:,1,1) - 5.362505362505362e-07) < & - ! 5.362505362505362e-07/100)) then - ! err = err + 1 - ! end if - ! do i = 1, 18 - ! if (.not. areMatricesClose(pre%bundles(1)%lpul(i,2:3,2:3), & - ! reshape(source=[3.13182309e-07, 7.45674981e-08, 7.45674981e-08, 3.13182309e-07], & - ! shape=[2,2], & - ! order =[2,1]), tolerance = 0.01)) then - ! err = err + 1 - ! end if - ! end do - - contains - - logical function areMatricesClose(a, b, tolerance) - real, dimension(:,:), intent(in) :: a - real, dimension(:,:), intent(in) :: b - real, intent(in) :: tolerance - real :: val_a, val_b - integer :: n, k, j - areMatricesClose = .true. - n = size(a,1) - do k = 1, n - do j = 1, n - val_a = a(k,j) - val_b = b(k,j) - areMatricesClose = areMatricesClose .and. abs(val_a - val_b) < tolerance*val_a - end do - end do - end function - - function expectedPreprocess() result (expected) - type(preprocess_t) :: expected - integer :: i - expected%final_time = 1e-9 - expected%dt = 1e-12 - - !BUNDLES - allocate(expected%bundles(1)) - expected%bundles(1)%name = "bundle_line_0" - allocate(expected%bundles(1)%lpul(3,3,18), source = 0.0) - allocate(expected%bundles(1)%cpul(3,3,19), source = 0.0) - allocate(expected%bundles(1)%rpul(3,3,18), source = 0.0) - allocate(expected%bundles(1)%gpul(3,3,19), source = 0.0) - - expected%bundles(1)%lpul(1,1,:) = 5.362505362505362e-07 - do i = 1, 18 - expected%bundles(1)%lpul(2:3,2:3,i) = & - reshape(source=[3.13182309e-07, 7.45674981e-08, 7.45674981e-08, 3.13182309e-07], shape=[2,2], order =[2,1]) - end do - - expected%bundles(1)%cpul(1,1,:) = 20.72e-12 - do i = 1, 19 - expected%bundles(1)%cpul(2:3,2:3,i) = & - reshape(source=[85.0e-12, -20.5e-12, -20.5e-12, 85.0e-12], shape=[2,2], order =[2,1]) - end do - - expected%bundles(1)%rpul(1,1,:) = 22.9e-3 - - expected%bundles(1)%number_of_conductors = 3 - expected%bundles(1)%number_of_divisions = 18 - expected%bundles(1)%step_size = [(0.03, i = 1, 18)] - allocate(expected%bundles(1)%v(3, 19)) - allocate(expected%bundles(1)%i(3, 18)) - allocate(expected%bundles(1)%du(3, 3, 18)) - expected%bundles(1)%dt = 1e-12 - allocate(expected%bundles(1)%probes(0)) - - expected%bundles(1)%transfer_impedance%dt = 1e-12 - expected%bundles(1)%transfer_impedance%number_of_conductors = 3 - expected%bundles(1)%transfer_impedance%number_of_divisions = 18 - expected%bundles(1)%transfer_impedance%number_of_poles = 0 - block - complex :: zero - integer :: ndiv, ncond, npoles - ndiv = 18 - ncond = 3 - npoles = 0 - zero%re = 0.0 - zero%im = 0.0 - allocate(expected%bundles(1)%transfer_impedance%phi(ndiv, ncond,npoles), source = zero) - allocate(expected%bundles(1)%transfer_impedance%q1 (ndiv, ncond,ncond, npoles), source = zero) - allocate(expected%bundles(1)%transfer_impedance%q2 (ndiv, ncond,ncond, npoles), source = zero) - allocate(expected%bundles(1)%transfer_impedance%q3 (ndiv, ncond,ncond, npoles), source = zero) - allocate(expected%bundles(1)%transfer_impedance%d (ndiv, ncond,ncond), source = 0.0) - allocate(expected%bundles(1)%transfer_impedance%e (ndiv, ncond,ncond), source = 0.0) - allocate(expected%bundles(1)%transfer_impedance%q1_sum (ndiv, ncond,ncond), source = zero) - allocate(expected%bundles(1)%transfer_impedance%q2_sum (ndiv, ncond,ncond), source = zero) - allocate(expected%bundles(1)%transfer_impedance%q3_phi (ndiv, ncond), source = zero) - end block - - expected%bundles(1)%conductors_in_level = (/1,2/) - - !NETWORKS - allocate(expected%network_manager%networks(2)) - expected%network_manager%dt = 1e-12 - expected%network_manager%networks(1)%number_of_nodes = 3 - allocate(expected%network_manager%networks(1)%nodes(3)) - expected%network_manager%networks(1)%nodes(1)%bundle_number = 1 - expected%network_manager%networks(1)%nodes(1)%conductor_number = 1 - expected%network_manager%networks(1)%nodes(1)%v_index = 1 - expected%network_manager%networks(1)%nodes(1)%i_index = 1 - expected%network_manager%networks(1)%nodes(1)%line_c_per_meter = 20.72e-12 - expected%network_manager%networks(1)%nodes(2)%bundle_number = 1 - expected%network_manager%networks(1)%nodes(2)%conductor_number = 2 - expected%network_manager%networks(1)%nodes(2)%v_index = 1 - expected%network_manager%networks(1)%nodes(2)%i_index = 1 - expected%network_manager%networks(1)%nodes(2)%line_c_per_meter = 85.0e-12 - expected%network_manager%networks(1)%nodes(3)%bundle_number = 1 - expected%network_manager%networks(1)%nodes(3)%conductor_number = 3 - expected%network_manager%networks(1)%nodes(3)%v_index = 1 - expected%network_manager%networks(1)%nodes(3)%i_index = 1 - expected%network_manager%networks(1)%nodes(3)%line_c_per_meter = 85.0e-12 - allocate(expected%network_manager%networks(2)%nodes(3)) - expected%network_manager%networks(2)%nodes(1)%bundle_number = 1 - expected%network_manager%networks(2)%nodes(1)%conductor_number = 1 - expected%network_manager%networks(2)%nodes(1)%v_index = 18 - expected%network_manager%networks(2)%nodes(1)%i_index = 19 - expected%network_manager%networks(2)%nodes(1)%line_c_per_meter = 20.72e-12 - expected%network_manager%networks(2)%nodes(2)%bundle_number = 1 - expected%network_manager%networks(2)%nodes(2)%conductor_number = 2 - expected%network_manager%networks(2)%nodes(2)%v_index = 18 - expected%network_manager%networks(2)%nodes(2)%i_index = 19 - expected%network_manager%networks(2)%nodes(2)%line_c_per_meter = 85.0e-12 - expected%network_manager%networks(2)%nodes(3)%bundle_number = 1 - expected%network_manager%networks(2)%nodes(3)%conductor_number = 3 - expected%network_manager%networks(2)%nodes(3)%v_index = 18 - expected%network_manager%networks(2)%nodes(3)%i_index = 19 - expected%network_manager%networks(2)%nodes(3)%line_c_per_meter = 85.0e-12 - - !PROBES - allocate(expected%probes(2)) - expected%probes(1) = expected%bundles(1)%addProbe(index = 19, probe_type = PROBE_TYPE_VOLTAGE, layer_indices=[1,18]) - expected%probes(2) = expected%bundles(1)%addProbe(index = 19, probe_type = PROBE_TYPE_CURRENT, layer_indices=[1,18]) - !MAPS - call expected%conductors_before_cable%set(key('line_1'), value = 1) - call expected%cable_name_to_bundle_id%set(key('line_0'), value = 1) - call expected%cable_name_to_bundle_id%set(key('line_1'), value = 1) - end function - - -end function - diff --git a/testData/cases/planewave/pw-with-pec.fdtd.json b/testData/cases/planewave/pw-with-pec.fdtd.json new file mode 100644 index 00000000..20a2214e --- /dev/null +++ b/testData/cases/planewave/pw-with-pec.fdtd.json @@ -0,0 +1,58 @@ +{ + "format": "FDTD Input file", + "__comments": "Planewave passing through an empty box.", + + "general": { + "timeStep": 0.05e-9, + "numberOfSteps": 400 + }, + + "boundary": { + "xLower": {"type": "pec"}, + "xUpper": {"type": "pec"}, + "yLower": {"type": "pec"}, + "yUpper": {"type": "pec"}, + "zLower": {"type": "pec"}, + "zUpper": {"type": "pec"} + }, + + "mesh": { + "grid": { + "numberOfCells": [6, 6, 6], + "steps": { "x": [0.01], "y": [0.01], "z": [0.01] } + }, + "coordinates": [ + {"id": 1, "relativePosition": [3, 3, 1]}, + {"id": 2, "relativePosition": [3, 3, 3]}, + {"id": 3, "relativePosition": [3, 3, 5]} + ], + "elements": [ + {"id": 1, "type": "node", "coordinateIds": [1]}, + {"id": 2, "type": "node", "coordinateIds": [2]}, + {"id": 3, "type": "node", "coordinateIds": [3]}, + {"id": 4, "type": "cell", "name": "pw-box", "intervals": [ [ [-1, -1, 2], [7, 7, 4] ] ]} + ] + }, + + "sources": [ + { + "type": "planewave", + "magnitudeFile": "gauss_1GHz.exc", + "elementIds": [4], + "direction": { + "theta": 0.0, + "phi": 0.0 + }, + "polarization": { + "theta": 1.5708, + "phi": 0.0 + } + } + ], + + "probes": [ + {"name": "before", "type": "point", "elementIds": [1], "directions": ["x"]}, + {"name": "inbox", "type": "point", "elementIds": [2], "directions": ["x"]}, + {"name": "after", "type": "point", "elementIds": [3], "directions": ["x"]} + ] +} \ No newline at end of file diff --git a/testData/input_examples/grid_3x3x3.fdtd.json b/testData/input_examples/grid_3x3x3.fdtd.json new file mode 100644 index 00000000..839fa62c --- /dev/null +++ b/testData/input_examples/grid_3x3x3.fdtd.json @@ -0,0 +1,33 @@ +{ + "format": "FDTD Input file", + "__comments": "JSON input file for a 3x3x3 grid to test the evolution operator generation and comparison with full solver.", + + "general": { + "timeStep": 10e-12, + "numberOfSteps": 5 + }, + + "boundary": { + "xLower": {"type": "pec"}, + "xUpper": {"type": "pec"}, + "yLower": {"type": "pec"}, + "yUpper": {"type": "pec"}, + "zLower": {"type": "pec"}, + "zUpper": {"type": "pec"} + }, + + "mesh": { + "grid": { + "numberOfCells": [3, 3, 3], + "steps": { "x": [0.1], "y": [0.1], "z": [0.1] } + }, + "coordinates": [ + {"id": 1, "relativePosition": [1, 1, 1]}, + {"id": 2, "relativePosition": [1, 3, 3]} + ], + "elements": [ + {"id": 1, "type": "node", "coordinateIds": [1]}, + {"id": 2, "type": "node", "coordinateIds": [2]} + ] + } +} \ No newline at end of file diff --git a/testData/input_examples/grid_50x3x3.fdtd.json b/testData/input_examples/grid_50x3x3.fdtd.json new file mode 100644 index 00000000..99de6984 --- /dev/null +++ b/testData/input_examples/grid_50x3x3.fdtd.json @@ -0,0 +1,33 @@ +{ + "format": "FDTD Input file", + "__comments": "JSON input file for a 50x3x3 grid to test the evolution operator generation and comparison with full solver.", + + "general": { + "timeStep": 10e-12, + "numberOfSteps": 5 + }, + + "boundary": { + "xLower": {"type": "pec"}, + "xUpper": {"type": "pec"}, + "yLower": {"type": "pec"}, + "yUpper": {"type": "pec"}, + "zLower": {"type": "pmc"}, + "zUpper": {"type": "pmc"} + }, + + "mesh": { + "grid": { + "numberOfCells": [50, 3, 3], + "steps": { "x": [0.1], "y": [0.1], "z": [0.1] } + }, + "coordinates": [ + {"id": 1, "relativePosition": [40, 2, 2]}, + {"id": 2, "relativePosition": [20, 2, 2]} + ], + "elements": [ + {"id": 1, "type": "node", "coordinateIds": [1]}, + {"id": 2, "type": "node", "coordinateIds": [2]} + ] + } +} \ No newline at end of file