From 8434f3e18406771d9365d3642afad676f4ca4d32 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Thu, 3 Jul 2025 10:01:11 +0200 Subject: [PATCH 01/56] Created sketches tests for evolution operator functionality --- test/smbjson/test_evolution_operator.F90 | 38 ++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 test/smbjson/test_evolution_operator.F90 diff --git a/test/smbjson/test_evolution_operator.F90 b/test/smbjson/test_evolution_operator.F90 new file mode 100644 index 00000000..bce0264e --- /dev/null +++ b/test/smbjson/test_evolution_operator.F90 @@ -0,0 +1,38 @@ +integer function test_evolution_operator_numberOfField_basis() bind (C) result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + + implicit none + + type(evolution_operator) :: evolOp + + err = 0 + + call evolOp%GenerateInputFieldsBasis() + if (evolOp%numberOfField_basis /= 66) err = err + 1 + + +integer function test_evolution_operator_oneStep() bind (C) result(err) + use smbjson + use smbjson_testingTools + use evolution_operator + + implicit none + + type(evolution_operator) :: evolOp + + err = 0 + + call evolOp%GenerateOperator() + + ExternalField_t :: field + + expected_field = smbjson%step(field) + result_field = evolOp%step(field, 1) + + if (any(expected_field%field /= result_field%field)) then + err = err + 1 + end if + +end function test_evolution_operator_oneStep From e8bbfd335bc5458e8a4f108993e6ef9eed3f0640 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Thu, 3 Jul 2025 11:47:02 +0200 Subject: [PATCH 02/56] Add evolution operator module with basis generation subroutines --- src_main_pub/evolution_operator.F90 | 154 ++++++++++++++++++++++++++++ 1 file changed, 154 insertions(+) create mode 100644 src_main_pub/evolution_operator.F90 diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 new file mode 100644 index 00000000..890115d6 --- /dev/null +++ b/src_main_pub/evolution_operator.F90 @@ -0,0 +1,154 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Module to handle the creation of the evolution operator +! Date : July, 3, 2025 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +module evolution_operator + + use Resuming + use Solver_mod + use fdetypes + use Report + + type :: field_array_t + real(RKIND), pointer, dimension(:,:,:) :: data + end type + + implicit none + private + + public :: evolution_operator + +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 :: 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 + v1 = [i, j, k](dim1) + v2 = [i, j, k](dim2) + + select case (2*mod(v1,2) + mod(v2,2)) + case (0); M_ee(i,j,k) = 1.0_RKIND + case (1); M_eo(i,j,k) = 1.0_RKIND + case (2); M_oe(i,j,k) = 1.0_RKIND + case (3); M_oo(i,j,k) = 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, j, k) = 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 + + real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) :: Ex + real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) :: Ey + real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) :: Ez + + Ex = 0.0_RKIND + Ey = 0.0_RKIND + Ez = 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) + + real (kind = RKIND), dimension ( 0 : b%HX%NX-1 , 0 : b%HX%NY-1 , 0 : b%HX%NZ-1 ) :: Hx + real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) :: Hy + real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) :: Hz + + Hx = 0.0_RKIND + Hy = 0.0_RKIND + Hz = 0.0_RKIND + + call GenerateMagneticalInputBasis(Hx, 2, 3, 3, Hx_m) + call GenerateMagneticalInputBasis(Hy, 3, 2, 3, Hy_m) + call GenerateMagneticalInputBasis(Hz, 3, 3, 2, Hz_m) + + type(field_array_t), allocatable, intent(OUT) :: FieldList(:) + allocate(FieldList(66)) + + 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 + + ! Hx_m + do i = 1, 18 + FieldList(12 + i)%data => Hx_m(i,:,:,:) + end do + + ! Hy_m + do i = 1, 18 + FieldList(30 + i)%data => Hy_m(i,:,:,:) + end do + + ! Hz_m + do i = 1, 18 + FieldList(48 + i)%data => Hz_m(i,:,:,:) + end do + + end subroutine \ No newline at end of file From 4827e0979907476f1cd46f358466a0f5daa9e6c9 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Thu, 3 Jul 2025 12:12:04 +0200 Subject: [PATCH 03/56] Refactor GenerateInputFieldsBasis to streamline basis generation for electrical and magnetical fields --- src_main_pub/evolution_operator.F90 | 66 ++++++++++++++++++----------- 1 file changed, 42 insertions(+), 24 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 890115d6..de7e7251 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -93,7 +93,10 @@ subroutine GenerateMagneticalInputBasis(A, M1, M2, M3, M) subroutine GenerateInputFieldsBasis(b, FieldList) type (bounds_t), intent( IN) :: b + type(field_array_t), allocatable, intent(OUT) :: FieldList(:) + allocate(FieldList(66)) + ! Generating the basis for the electical fields real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) :: Ex real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) :: Ey real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) :: Ez @@ -106,21 +109,7 @@ subroutine GenerateInputFieldsBasis(b, FieldList) 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) - real (kind = RKIND), dimension ( 0 : b%HX%NX-1 , 0 : b%HX%NY-1 , 0 : b%HX%NZ-1 ) :: Hx - real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) :: Hy - real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) :: Hz - - Hx = 0.0_RKIND - Hy = 0.0_RKIND - Hz = 0.0_RKIND - - call GenerateMagneticalInputBasis(Hx, 2, 3, 3, Hx_m) - call GenerateMagneticalInputBasis(Hy, 3, 2, 3, Hy_m) - call GenerateMagneticalInputBasis(Hz, 3, 3, 2, Hz_m) - - type(field_array_t), allocatable, intent(OUT) :: FieldList(:) - allocate(FieldList(66)) - + ! Storing the electrical fields in the FieldList FieldList(1)%data => Ex_ee FieldList(2)%data => Ex_eo FieldList(3)%data => Ex_oe @@ -136,19 +125,48 @@ subroutine GenerateInputFieldsBasis(b, FieldList) FieldList(11)%data => Ez_oe FieldList(12)%data => Ez_oo - ! Hx_m - do i = 1, 18 - FieldList(12 + i)%data => Hx_m(i,:,:,:) + ! Generating the basis for the magnetical fields + real (kind = RKIND), dimension ( 0 : b%HX%NX-1 , 0 : b%HX%NY-1 , 0 : b%HX%NZ-1 ) :: Hx + real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) :: Hy + real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) :: Hz + + Hx = 0.0_RKIND + Hy = 0.0_RKIND + Hz = 0.0_RKIND + + 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 + integer :: idx, i1, i2, i3 + + idx = 12 + do i1 = 1, 2 + do i2 = 1, 3 + do i3 = 1, 3 + idx = idx + 1 + FieldList(idx)%data => Hx_m(i1, i2, i3, :, :, :) + end do + end do end do - ! Hy_m - do i = 1, 18 - FieldList(30 + i)%data => Hy_m(i,:,:,:) + do i1 = 1, 3 + do i2 = 1, 2 + do i3 = 1, 3 + idx = idx + 1 + FieldList(idx)%data => Hy_m(i1, i2, i3, :, :, :) + end do + end do end do - ! Hz_m - do i = 1, 18 - FieldList(48 + i)%data => Hz_m(i,:,:,:) + do i1 = 1, 3 + do i2 = 1, 3 + do i3 = 1, 2 + idx = idx + 1 + FieldList(idx)%data => Hz_m(i1, i2, i3, :, :, :) + end do + end do end do end subroutine \ No newline at end of file From a6e14b63326756c0d79f0e9250981620a55cd5e1 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 4 Jul 2025 12:59:12 +0200 Subject: [PATCH 04/56] First commit. Trying to make solver a callable class --- src_main_pub/launcher.F90 | 10 + src_main_pub/semba_fdtd.F90 | 2022 +++++++++-------- test/CMakeLists.txt | 2 + test/fdtd_tests.cpp | 1 + test/system/CMakeLists.txt | 4 +- test/system/system_tests.h | 5 +- test/system/test_init_solver.F90 | 9 + ...est_json_to_solver_input_shielded_pair.F90 | 170 -- test/system/test_map_wires_to_bundles.F90 | 22 - 9 files changed, 1043 insertions(+), 1202 deletions(-) create mode 100644 src_main_pub/launcher.F90 create mode 100644 test/system/test_init_solver.F90 delete mode 100644 test/system/test_json_to_solver_input_shielded_pair.F90 delete mode 100644 test/system/test_map_wires_to_bundles.F90 diff --git a/src_main_pub/launcher.F90 b/src_main_pub/launcher.F90 new file mode 100644 index 00000000..dd7c8707 --- /dev/null +++ b/src_main_pub/launcher.F90 @@ -0,0 +1,10 @@ +program SEMBA_FDTD_launcher + use SEMBA_FDTD_mod + implicit none + + type(semba_fdtd_t) :: semba + call semba%init() + write(*,*) 'solver' +end program SEMBA_FDTD_launcher + + diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index b205d2a6..49f728c1 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,18 +40,20 @@ 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 + + type, public :: semba_fdtd_t + contains + procedure, public :: init => semba_init + procedure, public :: launch => semba_launch + end type semba_fdtd_t + + 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 @@ -117,1150 +116,1205 @@ PROGRAM SEMBA_FDTD_launcher 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() +contains + + subroutine semba_init(this) + class(semba_fdtd_t) :: this + write(*,*) '1' + end subroutine semba_init + + + subroutine semba_launch(this) + class(semba_fdtd_t) :: this + + 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() + #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 (l%layoutnumber, l%size) + SUBCOMM_MPI=MPI_COMM_WORLD !default el 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, ') ' - + 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, ') ' + #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) + call MPI_Barrier(SUBCOMM_MPI,l%ierr) #endif - call get_secnds(l%time_out2) - time_desdelanzamiento= l%time_out2%segundos + call get_secnds(l%time_out2) + time_desdelanzamiento= 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 (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 (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 #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, 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(l%layoutnumber,l%size,dummylog,.false.,.false.) !aqui ya no se tiene en cuenta el l%fatalerror - WRITE (l%opcionespararesumeo, '(a,i4,a)') 'mpirun -n ', l%size,' ' - call default_flags(l) !set all default flags + WRITE (l%opcionespararesumeo, '(a,i4,a)') 'mpirun -n ', l%size,' ' + call default_flags(l) !set all default flags #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) + 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 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 + ! #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) #endif - !see if there is semaphore to pause continuing - INQUIRE (file='pause', EXIST=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) -#endif + !see if there is semaphore to pause continuing + INQUIRE (file='pause', EXIST=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) #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) #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) + call MPI_Barrier(SUBCOMM_MPI,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) + 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) #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 + l%time_end = l%time_out2%segundos + IF (l%time_end-l%time_begin > 10.0_RKIND) THEN + INQUIRE (file='pause', EXIST=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 #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=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 #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - CALL MPI_FINALIZE (l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_FINALIZE (l%ierr) #endif - STOP - endif + STOP + endif #endif #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) + call MPI_Barrier(SUBCOMM_MPI,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 (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 - 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 + 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 #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) #endif - l%chain2=trim(adjustl(l%chain2))//' '//trim(adjustl(chain3)) + l%chain2=trim(adjustl(l%chain2))//' '//trim(adjustl(chain3)) - call buscaswitchficheroinput(l) - + call buscaswitchficheroinput(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 (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 #ifdef CompilePrivateVersion - call cargaNFDE(l%filefde,parser) + call cargaNFDE(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(l%extension))=='.json') then + call cargaFDTDJSON(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) + !!!!!!!!!!!!!!!!!!!!!!! + sgg%extraswitches=parser%switches + !!!da preferencia a los switches por linea de comando + CALL getcommandargument (l%chain2, 1, chaindummy, l%length, statuse) - 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)) -!!!! - + 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)) + !!!! + - call interpreta(l,status ) - sgg%nEntradaRoot=trim (adjustl(l%nEntradaRoot)) + call interpreta(l,status ) + sgg%nEntradaRoot=trim (adjustl(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, l%nEntradaRoot, l%layoutnumber) + STOP + end if #endif #ifdef CompileWithHDF -!!!!tunel a lo bestia para crear el .h5 a 021219 - 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 (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 #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, 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(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 + !!!!!!!!!!!!!!!!!!!!! #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, 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 (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 - !************************************************************************* - !***[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 (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) #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, 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) #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(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) #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(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 + !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 - !...................................................................... + !...................................................................... #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, 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 (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 + #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 (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.) + end if + write(dubuf,*) '----> l%input_conformal_flag True and exit'; call print11(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, l%ierr) #endif - !************************************************************************* - !************************************************************************* - !************************************************************************* + !************************************************************************* + !************************************************************************* + !************************************************************************* #endif - if (allocated(sggMiEx)) then !para el l%skindepthpre no se allocatea nada + if (allocated(sggMiEx)) then !para el l%skindepthpre no se allocatea nada #ifdef CompileWithConformal - call AssigLossyOrPECtoNodes(sgg,sggMiNo,sggMiEx,sggMiEy,sggMiEz,& - &conf_conflicts,l%input_conformal_flag) + call AssigLossyOrPECtoNodes(sgg,sggMiNo,sggMiEx,sggMiEy,sggMiEz,& + &conf_conflicts,l%input_conformal_flag) #else - call AssigLossyOrPECtoNodes(sgg,sggMiNo,sggMiEx,sggMiEy,sggMiEz) + call AssigLossyOrPECtoNodes(sgg,sggMiNo,sggMiEx,sggMiEy,sggMiEz) #endif - IF (l%createmap) CALL store_geomData (sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, l%geomfile) - endif - ! + IF (l%createmap) CALL store_geomData (sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, 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, 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(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) #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( 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 #ifndef CompileWithBerengerWires - if ((l%wiresflavor=='berenger')) then - CALL stoponerror (l%layoutnumber, l%size, 'Berenger Wires without support. Recompile!') - endif + if ((l%wiresflavor=='berenger')) then + CALL stoponerror (l%layoutnumber, 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 ((l%wiresflavor=='slanted').or.(l%wiresflavor=='semistructured')) then + CALL stoponerror (l%layoutnumber, l%size, 'slanted Wires without support. Recompile!') + endif #endif - CONTINUE - END IF - ! - IF ((sgg%Med(i)%Is%AnisMultiport) .OR. (sgg%Med(i)%Is%multiport).OR. (sgg%Med(i)%Is%SGBC)) THEN + CONTINUE + END IF + ! + IF ((sgg%Med(i)%Is%AnisMultiport) .OR. (sgg%Med(i)%Is%multiport).OR. (sgg%Med(i)%Is%SGBC)) THEN #ifndef CompileWithNIBC - if (l%mibc) CALL stoponerror (l%layoutnumber, l%size, 'l%mibc Multiports without support. Recompile!') + if (l%mibc) CALL stoponerror (l%layoutnumber, l%size, '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 (sgg%Med(i)%Is%sgbc .and. l%input_conformal_flag) THEN + CALL stoponerror (l%layoutnumber, 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 (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 #ifndef CompileWithSlantedWires - IF (l%hay_slanted_wires) THEN - CALL stoponerror (l%layoutnumber, l%size, 'slanted wires without slanted support. Recompile ()') - END IF + IF (l%hay_slanted_wires) THEN + CALL stoponerror (l%layoutnumber, 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 (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 - - !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 + + !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 + 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 #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) #endif - finishedwithsuccess=.false. + finishedwithsuccess=.false. - call solver%init(l) + call solver%init(l) - if ((l%finaltimestep >= 0).and.(.not.l%skindepthpre)) then + if ((l%finaltimestep >= 0).and.(.not.l%skindepthpre)) then #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,& + 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) + 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) #endif - deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,sggMtag) - else + deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,sggMtag) + else #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,l%ierr) + 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 + 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 #ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) #endif #ifdef CompileWithMPI - CALL MPI_FINALIZE (l%ierr) + CALL MPI_FINALIZE (l%ierr) #endif - stop - endif - END IF - ! + stop + endif + 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, 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) + ! + 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 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, 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 (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') + 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 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(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) + 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 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) #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) #endif - ! Error reading check + ! Error reading check #ifdef keeppause - if (l%fatalerror) then - fatalerror_aux=.true. + if (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, l%ierr) + call MPI_AllReduce(fatalerror_aux, l%fatalerror, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, l%ierr) #else - l%fatalerror = fatalerror_aux + l%fatalerror = fatalerror_aux #endif - if (l%fatalerror) l%relaunching=.true. + if (l%fatalerror) l%relaunching=.true. #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) #endif - 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 (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 + !!!!! #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) #endif - IF (l%layoutnumber == 0) THEN - CALL CloseReportingFiles + 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 - 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 #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) #endif - IF (l%layoutnumber == 0) THEN - CALL CloseReportingFiles - endif - !************************************************************************************************** + IF (l%layoutnumber == 0) THEN + CALL CloseReportingFiles + endif + !************************************************************************************************** #ifdef CompileWithMPI - CALL MPI_FINALIZE (l%ierr) + CALL MPI_FINALIZE (l%ierr) #endif - STOP - ! + STOP + ! -contains -!END PROGRAM SEMBA_FDTD_launcher -!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!! + contains + !END PROGRAM SEMBA_FDTD_launcher + !!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!! #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) -!!!!!!!!!!!!!!!!!!!!!!! + 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) - !!!!!! + 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) + 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) + 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 + 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) + 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) + 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_Barrier (SUBCOMM_MPI, l%ierr) #endif - return + return -end subroutine cargaNFDE + end subroutine cargaNFDE #endif #ifdef CompileWithSMBJSON - subroutine cargaFDTDJSON(filename, parsed) - character(len=1024), intent(in) :: filename - type(Parseador), pointer :: parsed - - character(len=:), allocatable :: usedFilename - type(fdtdjson_parser_t) :: parser - - usedFilename = adjustl(trim(filename)) // ".json" - parser = fdtdjson_parser_t(usedFilename) - - allocate(parsed) - parsed = parser%readProblemDescription() - end subroutine cargaFDTDJSON -#endif - -!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -subroutine NFDE2sgg -!!!!!!!!! - real (kind=rkind) :: dt,finaldt - logical fatalerror - ! parser now holds all the .nfde info - !first read the limits + subroutine cargaFDTDJSON(filename, parsed) + character(len=1024), intent(in) :: filename + type(Parseador), pointer :: parsed + + character(len=:), allocatable :: usedFilename + type(fdtdjson_parser_t) :: parser + + usedFilename = adjustl(trim(filename)) // ".json" + parser = fdtdjson_parser_t(usedFilename) + + allocate(parsed) + parsed = parser%readProblemDescription() + 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) + 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 + 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(dtlay,dt) + call MPIupdateMin(real(sgg%dt,RKIND),finaldt) #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 + !!!!!!!!!!!!!! + l%cfl=sgg%dt/dtlay write(dubuf,*) SEPARADOR//separador//separador call print11(l%layoutnumber,dubuf) - write(dubuf,*) 'Correcting sgg%dt with -l%cfl switch. New time step: ',sgg%dt + write(dubuf,*) 'CFLN= ',l%cfl 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) + + 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) + 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 + 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) + 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 + !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)%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) + 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))) + 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) + 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 + 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 + ELSE !del l%size==1 #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) #ifdef CompileWithStochastic - if (l%stochastic) then - call HalvesStochasticMPI(l%layoutnumber,l%size,l%simu_devia) - endif + if (l%stochastic) then + call HalvesStochasticMPI(l%layoutnumber,l%size,l%simu_devia) + 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 + 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) #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) +#ifdef CompileWithMTLN + if (trim(adjustl(l%extension))=='.json') then + mtln_parsed = parser%mtln + mtln_parsed%time_step = sgg%dt + end if +#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 + CONTINUE + END IF !del l%size==1 ! - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - if (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 = 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 +#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) @@ -1269,53 +1323,11 @@ subroutine NFDE2sgg 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) -#endif -#ifdef CompileWithMTLN - if (trim(adjustl(l%extension))=='.json') then - mtln_parsed = parser%mtln - mtln_parsed%time_step = sgg%dt - end if -#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 - CONTINUE - END IF !del l%size==1 + return + end subroutine ! -#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 subroutine semba_launch - END PROGRAM SEMBA_FDTD_launcher +end module SEMBA_FDTD_mod ! diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 1495d1bd..c3295458 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) @@ -23,6 +24,7 @@ add_executable(fdtd_tests target_link_libraries(fdtd_tests ${MTLN_TESTS_LIBRARY} ${SMBJSON_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..77e77ec7 100644 --- a/test/fdtd_tests.cpp +++ b/test/fdtd_tests.cpp @@ -2,6 +2,7 @@ #ifdef CompileWithMTLN #include "mtln/mtln_tests.h" + #include "system/system_tests.h" #endif #ifdef CompileWithSMBJSON #include "smbjson/smbjson_tests.h" diff --git a/test/system/CMakeLists.txt b/test/system/CMakeLists.txt index 25ea17eb..2e4c2aef 100644 --- a/test/system/CMakeLists.txt +++ b/test/system/CMakeLists.txt @@ -6,8 +6,7 @@ set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/mod) add_library( system_test_fortran "system_testingTools.F90" - "test_map_wires_to_bundles.F90" - "test_json_to_solver_input_shielded_pair.F90" + "test_init_solver.F90" ) target_link_libraries(system_test_fortran @@ -21,6 +20,7 @@ target_link_libraries(system_test_fortran add_library(system_tests "system_tests.cpp") target_link_libraries(system_tests + semba-main system_test_fortran GTest::gtest ) \ No newline at end of file diff --git a/test/system/system_tests.h b/test/system/system_tests.h index 8537f105..f0d539c3 100644 --- a/test/system/system_tests.h +++ b/test/system/system_tests.h @@ -1,7 +1,6 @@ #include -extern "C" int test_map_wires_to_bundles(); -extern "C" int test_json_to_solver_input_shielded_pair(); +extern "C" int test_init_solver(); -// TEST(system, json_to_solver_shielded) {EXPECT_EQ(0, test_json_to_solver_input_shielded_pair()); } +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..bd1c1a70 --- /dev/null +++ b/test/system/test_init_solver.F90 @@ -0,0 +1,9 @@ +integer function test_init_solver() bind (C) result(err) + use SEMBA_FDTD_mod + + implicit none + type(semba_fdtd_t) :: semba + write(*,*) 'solver' + call semba%init() +end function + 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/test/system/test_map_wires_to_bundles.F90 b/test/system/test_map_wires_to_bundles.F90 deleted file mode 100644 index ed36dba3..00000000 --- a/test/system/test_map_wires_to_bundles.F90 +++ /dev/null @@ -1,22 +0,0 @@ -integer function test_map_wires_to_bundles() 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//'system/mtln.fdtd.json' - type(Parseador) :: problem, expected - type(parser_t) :: parser - type(mtln_solver_t) :: solver - logical :: areSame - err = 0 - - ! expected = expectedProblemDescription() - parser = parser_t(filename) - problem = parser%readProblemDescription() - solver = mtlnCtor(problem%mtln) - ! solver = mtlnCtor(problem%mtln) - ! call expect_eq(err, expected, problem) -end function - From da274d6e60cbf44c63d30cc1d595c818a9490331 Mon Sep 17 00:00:00 2001 From: Luis Manuel Diaz Angulo Date: Fri, 4 Jul 2025 13:22:25 +0200 Subject: [PATCH 05/56] Behold! I am the master compiler!!! --- CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 461a7bda..b66383f9 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -262,6 +262,7 @@ endif() if (SEMBA_FDTD_EXECUTABLE) add_executable(semba-fdtd + "src_main_pub/launcher.F90" "src_main_pub/semba_fdtd.F90" ) target_link_libraries(semba-fdtd semba-main semba-reports) From 19318e4b2cc0146e0f9d9862b9dba84c7638181d Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 4 Jul 2025 13:26:25 +0200 Subject: [PATCH 06/56] minor --- CMakeLists.txt | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 461a7bda..c44521de 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -199,11 +199,6 @@ if (SEMBA_FDTD_ENABLE_MTLN) endif() endif() -if (SEMBA_FDTD_ENABLE_TEST) - add_subdirectory(external/googletest/) - add_subdirectory(test) -endif() - if(SEMBA_FDTD_COMPONENTS_LIB) add_library(semba-components "src_main_pub/anisotropic.F90" @@ -241,6 +236,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,12 +258,18 @@ endif() if (SEMBA_FDTD_EXECUTABLE) add_executable(semba-fdtd + "src_main_pub/launcher.F90" "src_main_pub/semba_fdtd.F90" ) target_link_libraries(semba-fdtd semba-main semba-reports) target_link_libraries(semba-fdtd ${MPI_Fortran_LIBRARIES}) endif() +if (SEMBA_FDTD_ENABLE_TEST) + add_subdirectory(external/googletest/) + add_subdirectory(test) +endif() + include_directories(${CMAKE_BINARY_DIR}/mod) include_directories(${HDF5_INCLUDE_DIRS}) From 14eaf049895d3b496c7be9f6ae3071ad8f43bb2a Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 4 Jul 2025 13:31:28 +0200 Subject: [PATCH 07/56] Fixes CMakeLists --- CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index c44521de..f377281d 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -259,7 +259,6 @@ endif() if (SEMBA_FDTD_EXECUTABLE) add_executable(semba-fdtd "src_main_pub/launcher.F90" - "src_main_pub/semba_fdtd.F90" ) target_link_libraries(semba-fdtd semba-main semba-reports) target_link_libraries(semba-fdtd ${MPI_Fortran_LIBRARIES}) From 38425226da43f038ea20b7519b6540a00eae0240 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 4 Jul 2025 15:58:43 +0200 Subject: [PATCH 08/56] [WIP] Reactoring semba_fdtd to use it as a class --- src_main_pub/launcher.F90 | 6 +- src_main_pub/semba_fdtd.F90 | 844 +++++++++++++++---------------- test/system/CMakeLists.txt | 2 +- test/system/test_init_solver.F90 | 3 +- 4 files changed, 415 insertions(+), 440 deletions(-) diff --git a/src_main_pub/launcher.F90 b/src_main_pub/launcher.F90 index dd7c8707..34831617 100644 --- a/src_main_pub/launcher.F90 +++ b/src_main_pub/launcher.F90 @@ -3,8 +3,12 @@ program SEMBA_FDTD_launcher implicit none type(semba_fdtd_t) :: semba + call semba%init() - write(*,*) 'solver' + ! 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 49f728c1..c2ea1d29 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -48,110 +48,77 @@ module SEMBA_FDTD_mod type, public :: semba_fdtd_t contains - procedure, public :: init => semba_init - procedure, public :: launch => semba_launch + procedure :: init => semba_init + procedure :: launch => semba_launch end type semba_fdtd_t - - REAL (KIND=RKIND) :: eps0,mu0,cluz - 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 +contains - LOGICAL :: hayinput - ! - TYPE (t_NFDE_FILE), POINTER :: NFDE_FILE + subroutine semba_init(this) + class(semba_fdtd_t) :: this + type(entrada_t) :: l - type (tagtype_t) :: tagtype - REAL (KIND=RKIND) :: dxmin,dymin,dzmin,dtlay + real (KIND=RKIND) :: eps0,mu0,cluz + real (KIND=RKIND) :: maxSourceValue + real (KIND=RKIND) :: dtantesdecorregir + real (KIND=RKIND) :: dxmin,dymin,dzmin,dtlay + real (KIND=8) time_desdelanzamiento + logical :: dummylog,finishedwithsuccess,l_auxinput, l_auxoutput, ThereArethinslots + logical :: existe + logical :: hayinput + logical :: lexis + logical :: newrotate !300124 tiramos con el rotador antiguo + + character (LEN=BUFSIZE) :: f= ' ', chain = ' ', chain3 = ' ',chain4 = ' ', chaindummy= ' ', filenombre= ' ' + character (LEN=BUFSIZE_LONG) :: slices = ' ' + character (LEN=BUFSIZE) :: whoami, whoamishort + 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 + + integer (KIND=IKINDMTAG) , allocatable , dimension(:,:,:) :: sggMtag + integer (KIND=INTEGERSIZEOFMEDIAMATRICES) , allocatable , dimension(:,:,:) :: sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz + + type (taglist_t) :: tag_numbers + type (Parseador), POINTER :: parser + type (SGGFDTDINFO) :: sgg + type (limit_t), DIMENSION (1:6) :: fullsize, SINPML_fullsize + type (t_NFDE_FILE), POINTER :: NFDE_FILE + type (tagtype_t) :: tagtype + TYPE (tiempo_t) :: time_comienzo + 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 + type (conf_conflicts_t), pointer :: conf_conflicts #endif - !**************************************************************************** - !**************************************************************************** - !**************************************************************************** - - type (entrada_t) :: l #ifdef CompileWithMTLN - type(mtln_t) :: mtln_parsed + 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 - - -contains - - subroutine semba_init(this) - class(semba_fdtd_t) :: this - write(*,*) '1' - end subroutine semba_init - - - subroutine semba_launch(this) - class(semba_fdtd_t) :: this + call initEntrada(l) 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() + CALL OnPrint #ifdef CompileWithMPI CALL InitGeneralMPI (l%layoutnumber, l%size) @@ -345,7 +312,6 @@ subroutine semba_launch(this) - !!!!!!!!!!!!!!!!!!!!!!! sgg%extraswitches=parser%switches !!!da preferencia a los switches por linea de comando CALL getcommandargument (l%chain2, 1, chaindummy, l%length, statuse) @@ -397,8 +363,6 @@ subroutine semba_launch(this) 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 @@ -743,355 +707,7 @@ subroutine semba_launch(this) close(thefileno) endif - ! call each simulation !ojo que los layoutnumbers empiezan en 0 - IF (l%finaltimestep /= 0) THEN -#ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - finishedwithsuccess=.false. - - call solver%init(l) - - if ((l%finaltimestep >= 0).and.(.not.l%skindepthpre)) then -#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) -#endif - deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,sggMtag) - else -#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 -#ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif -#ifdef CompileWithMPI - CALL MPI_FINALIZE (l%ierr) -#endif - stop - endif - END IF - ! -#ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, 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 - -#ifdef CompileWithMPI - !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, 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') - 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## -#ifdef CompileWithConformal - if(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) -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - ! Error reading check - -#ifdef keeppause - if (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) -#else - 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 - !!!!! -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, 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 - -#ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -#endif - - IF (l%layoutnumber == 0) THEN - CALL CloseReportingFiles - endif - !************************************************************************************************** - -#ifdef CompileWithMPI - CALL MPI_FINALIZE (l%ierr) -#endif - STOP - ! - - contains - !END PROGRAM SEMBA_FDTD_launcher - !!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!! - - -#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) -#endif - return - - end subroutine cargaNFDE -#endif - -#ifdef CompileWithSMBJSON - subroutine cargaFDTDJSON(filename, parsed) - character(len=1024), intent(in) :: filename - type(Parseador), pointer :: parsed - - character(len=:), allocatable :: usedFilename - type(fdtdjson_parser_t) :: parser - - usedFilename = adjustl(trim(filename)) // ".json" - parser = fdtdjson_parser_t(usedFilename) - - allocate(parsed) - parsed = parser%readProblemDescription() - end subroutine cargaFDTDJSON -#endif - - !!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +contains subroutine NFDE2sgg !!!!!!!!! real (kind=rkind) :: dt,finaldt @@ -1325,9 +941,365 @@ subroutine NFDE2sgg END DO return end subroutine + + end subroutine semba_init + + + subroutine semba_launch(this) + class(semba_fdtd_t) :: this + + +! ! call each simulation !ojo que los layoutnumbers empiezan en 0 +! IF (l%finaltimestep /= 0) THEN +! #ifdef CompileWithMPI +! !wait until everything comes out +! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +! #endif +! finishedwithsuccess=.false. + +! call solver%init(l) + +! if ((l%finaltimestep >= 0).and.(.not.l%skindepthpre)) then +! #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) +! #endif +! deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,sggMtag) +! else +! #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 +! #ifdef CompileWithMPI +! !wait until everything comes out +! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +! #endif +! #ifdef CompileWithMPI +! CALL MPI_FINALIZE (l%ierr) +! #endif +! stop +! endif +! END IF +! ! +! #ifdef CompileWithMPI +! !wait until everything comes out +! CALL MPI_Barrier (SUBCOMM_MPI, 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 + +! #ifdef CompileWithMPI +! !wait until everything comes out +! CALL MPI_Barrier (SUBCOMM_MPI, 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') +! 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## +! #ifdef CompileWithConformal +! if(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) +! #ifdef CompileWithMPI +! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +! #endif +! ! Error reading check + +! #ifdef keeppause +! if (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) +! #else +! 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 +! !!!!! +! #ifdef CompileWithMPI +! CALL MPI_Barrier (SUBCOMM_MPI, 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 + +! #ifdef CompileWithMPI +! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +! #endif + +! IF (l%layoutnumber == 0) THEN +! CALL CloseReportingFiles +! endif +! !************************************************************************************************** + +! #ifdef CompileWithMPI +! CALL MPI_FINALIZE (l%ierr) +! #endif +! STOP +! ! + +! contains +! !END PROGRAM SEMBA_FDTD_launcher +! !!!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!! + + + + +! !!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! + end subroutine semba_launch - + 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) + character(len=1024), intent(in) :: filename + type(Parseador), pointer :: parsed + + character(len=:), allocatable :: usedFilename + type(fdtdjson_parser_t) :: parser + + usedFilename = adjustl(trim(filename)) // ".json" + parser = fdtdjson_parser_t(usedFilename) + + allocate(parsed) + parsed = parser%readProblemDescription() + end subroutine cargaFDTDJSON +#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) + 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) + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + end do +#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 + endif + local_parser => newparser (NFDE_FILE) +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +#endif + if(newrotate) then + NFDE_FILE%mpidir=verdadero_mpidir + call nfde_rotate (local_parser,NFDE_FILE%mpidir) +#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] '//trim(adjustl(whoami))//' newparser (NFDE_FILE)'; call print11(l%layoutnumber,dubuf) +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +#endif + return + + end subroutine cargaNFDE +#endif + + end module SEMBA_FDTD_mod ! diff --git a/test/system/CMakeLists.txt b/test/system/CMakeLists.txt index 2e4c2aef..9b22bbc5 100644 --- a/test/system/CMakeLists.txt +++ b/test/system/CMakeLists.txt @@ -15,12 +15,12 @@ target_link_libraries(system_test_fortran ngspice_interface smbjson ${JSONFORTRAN_LIB} + semba-main ) add_library(system_tests "system_tests.cpp") target_link_libraries(system_tests - semba-main system_test_fortran GTest::gtest ) \ No newline at end of file diff --git a/test/system/test_init_solver.F90 b/test/system/test_init_solver.F90 index bd1c1a70..fc9adc6e 100644 --- a/test/system/test_init_solver.F90 +++ b/test/system/test_init_solver.F90 @@ -3,7 +3,6 @@ integer function test_init_solver() bind (C) result(err) implicit none type(semba_fdtd_t) :: semba - write(*,*) 'solver' - call semba%init() + ! call semba%init() end function From f881e8f0596133175fcb9e5568710bf64cdcdff6 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 4 Jul 2025 16:07:41 +0200 Subject: [PATCH 09/56] [WIP] Makes entrada_t part of the solver class --- CMakeLists.txt | 9 +- src_main_pub/semba_fdtd.F90 | 757 ++++++++++++++++++------------------ 2 files changed, 377 insertions(+), 389 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index f377281d..e483fd1b 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -199,6 +199,11 @@ if (SEMBA_FDTD_ENABLE_MTLN) endif() endif() +if (SEMBA_FDTD_ENABLE_TEST) + add_subdirectory(external/googletest/) + add_subdirectory(test) +endif() + if(SEMBA_FDTD_COMPONENTS_LIB) add_library(semba-components "src_main_pub/anisotropic.F90" @@ -264,10 +269,6 @@ if (SEMBA_FDTD_EXECUTABLE) target_link_libraries(semba-fdtd ${MPI_Fortran_LIBRARIES}) endif() -if (SEMBA_FDTD_ENABLE_TEST) - add_subdirectory(external/googletest/) - add_subdirectory(test) -endif() include_directories(${CMAKE_BINARY_DIR}/mod) diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index c2ea1d29..eb5ab0b4 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -47,6 +47,7 @@ module SEMBA_FDTD_mod IMPLICIT NONE type, public :: semba_fdtd_t + type (entrada_t) :: l contains procedure :: init => semba_init procedure :: launch => semba_launch @@ -57,7 +58,6 @@ module SEMBA_FDTD_mod subroutine semba_init(this) class(semba_fdtd_t) :: this - type(entrada_t) :: l real (KIND=RKIND) :: eps0,mu0,cluz real (KIND=RKIND) :: maxSourceValue @@ -111,7 +111,7 @@ subroutine semba_init(this) type(mtln_t) :: mtln_parsed #endif - call initEntrada(l) + call initEntrada(this%l) newrotate=.false. !!ojo tocar luego !!200918 !!!si se lanza con -pscal se overridea esto Eps0= 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 @@ -121,24 +121,24 @@ subroutine semba_init(this) 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 + this%l%size = 1 + this%l%layoutnumber = 0 #endif - call setglobal(l%layoutnumber,l%size) !para crear variables globales con info MPI + call setglobal(this%l%layoutnumber,this%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, ') ' + WRITE (whoamishort, '(i5)') this%l%layoutnumber + 1 + WRITE (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) + time_desdelanzamiento= this%l%time_out2%segundos #ifndef keeppause - if (l%layoutnumber==0) then + if (this%l%layoutnumber==0) then OPEN (38, file='running') write (38,*) '!END' CLOSE (38,status='delete') @@ -154,88 +154,88 @@ subroutine semba_init(this) endif #endif - if (l%layoutnumber==0) then + 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,'.',l%layoutnumber,'SEMBA_FDTD_temp.log' + 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(l) + 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 - 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) + call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) #endif call get_secnds(time_comienzo) !temporarily until later - IF (l%layoutnumber == 0) THEN + IF (this%l%layoutnumber == 0) THEN OPEN (11, file='SEMBA_FDTD_temp.log',position='append') - l%file11isopen=.true. + this%l%file11isopen=.true. END IF ! #ifdef CompileWithMPI !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif !see if there is semaphore to pause continuing - INQUIRE (file='pause', EXIST=l%pausar) + 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) + call MPI_Barrier(SUBCOMM_MPI,this%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 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) + 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 (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) + 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 + 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') @@ -250,25 +250,25 @@ subroutine semba_init(this) 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 #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) + CALL get_secnds (this%l%time_out2) ! ! mira el command_line y el fichero launch 251022 - CALL get_command (l%chain2, l%length, status) + CALL get_command (this%l%chain2, this%l%length, status) IF (status /= 0) then - CALL stoponerror (l%layoutnumber, l%size, 'General error',.true.); goto 652 + CALL stoponerror (this%l%layoutnumber, this%l%size, 'General error',.true.); goto 652 endif - l%chain2=trim(adjustl(l%chain2)) + this%l%chain2=trim(adjustl(this%l%chain2)) !concatena con lo que haya en launch INQUIRE (file='launch', EXIST=hayinput) if (hayinput) then @@ -279,31 +279,31 @@ subroutine semba_init(this) 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 + 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(l) - if (trim(adjustl(l%extension))=='.nfde') then + 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 #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' @@ -314,75 +314,75 @@ subroutine semba_init(this) sgg%extraswitches=parser%switches !!!da preferencia a los switches por linea de comando - CALL getcommandargument (l%chain2, 1, chaindummy, l%length, statuse) + CALL getcommandargument (this%l%chain2, 1, chaindummy, this%l%length, statuse) - l%chain2=trim(adjustl(l%chain2)) + this%l%chain2=trim(adjustl(this%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%length=len(trim(adjustl(chaindummy))) + this%l%chain2=trim(adjustl(chaindummy))//' '//trim(adjustl(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 ) + 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) + call solver%launch_mtln_simulation(parser%mtln, this%l%nEntradaRoot, this%l%layoutnumber) STOP end if #endif #ifdef CompileWithHDF !!!!tunel a lo bestia para crear el .h5 a 021219 - if (l%createh5filefromsinglebin) then - if (l%layoutnumber==0) then + if (this%l%createh5filefromsinglebin) then + if (this%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) + call createh5filefromsinglebin(filename_h5bin,this%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 + 9083 CALL stoponerror (0, this%l%size, 'Invalid _h5bin.txt file',.true.); statuse=-1; !return endif #ifdef CompileWithMPI !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #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 + 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(l%prioritizeCOMPOoverPEC,l%prioritizeISOTROPICBODYoverall,l%prioritizeTHINWIRE) !!! asigna las prioridades - if (l%finaltimestep /= -2) then + 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 (l%layoutnumber, 'INIT conversion internal ASCII => Binary') - CALL print11 (l%layoutnumber, SEPARADOR//SEPARADOR//SEPARADOR) + CALL print11 (this%l%layoutnumber, 'INIT conversion internal ASCII => Binary') + CALL print11 (this%l%layoutnumber, SEPARADOR//SEPARADOR//SEPARADOR) - CALL print11 (l%layoutnumber, SEPARADOR//SEPARADOR//SEPARADOR) + CALL print11 (this%l%layoutnumber, SEPARADOR//SEPARADOR//SEPARADOR) !!!!!!!!!!!!!!!!!!!!!! call NFDE2sgg - l%fatalerror=l%fatalerror.or.l%fatalerrornfde2sgg + 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') + CALL print11 (this%l%layoutnumber, '[OK] Ended conversion internal ASCII => Binary') !release memory created by newPARSER - if (l%fatalerror) then + if (this%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 + 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 !************************************************************************* @@ -390,7 +390,7 @@ subroutine semba_init(this) !************************************************************************* !conformal conformal ini ref: ##Confini## #ifdef CompileWithConformal - if (l%input_conformal_flag) then + if (this%l%input_conformal_flag) then !md notes: ![1] Todos los procesos parsean el archivo -conf completo. @@ -401,26 +401,26 @@ subroutine semba_init(this) conf_parameter%output_file_report_id = 47; !...................................................................... - write(dubuf,*) 'Init Searching for Conformal Mesh ...'; call print11(l%layoutnumber,dubuf) + 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,& + &sgg, sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,this%l%run_with_abrezanjas,& + &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,& + !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,& &sgg, sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,& - &l%run_with_abrezanjas,fullsize,0,l%mpidir,l%input_conformal_flag,conf_err,l%verbose) + &this%l%run_with_abrezanjas,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 #ifdef CompilePrivateVersion - if (trim(adjustl(l%extension))=='.nfde') then + if (trim(adjustl(this%l%extension))=='.nfde') then CALL Destroy_Parser (parser) DEALLOCATE (NFDE_FILE%lineas) DEALLOCATE (NFDE_FILE) @@ -431,25 +431,25 @@ subroutine semba_init(this) !!!!!!!!!!!!!!!!!!!!!!!!!!!!! #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 + 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 + 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 (l%input_conformal_flag.and.l%flag_conf_sgg) then - write(dubuf,*) '----> Conformal Mesh found'; call print11(l%layoutnumber,dubuf) + 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(l%layoutnumber,dubuf) + write(dubuf,*) '----> No Conformal Mesh found'; call print11(this%l%layoutnumber,dubuf) endif - end if !FIN DEL: if (l%input_conformal_flag) then + end if !FIN DEL: if (this%l%input_conformal_flag) then #endif @@ -465,79 +465,79 @@ subroutine semba_init(this) !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) + 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, & &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 + &fullsize, SINPML_fullsize,this%l%layoutnumber,conf_err,this%l%verbose); + !call conf_geometry_mapped_for_UGRDTD (sgg, fullsize, 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,*) '----> l%input_conformal_flag True and exit'; call print11(l%layoutnumber,dubuf) + write(dubuf,*) '----> this%l%input_conformal_flag True and exit'; call print11(this%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(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) + &conf_conflicts,this%l%input_conformal_flag) #else call AssigLossyOrPECtoNodes(sgg,sggMiNo,sggMiEx,sggMiEy,sggMiEz) #endif - IF (l%createmap) CALL store_geomData (sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, l%geomfile) + IF (this%l%createmap) CALL store_geomData (sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, this%l%geomfile) endif ! #ifdef CompileWithMPI !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + 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 + write(dubuf,*) '[OK] Ended Conformal Mesh'; call print11(this%l%layoutnumber,dubuf) + if (this%l%finaltimestep==0) this%l%finaltimestep=sgg%TimeSteps !no quitar + IF (this%l%forcesteps) then + sgg%TimeSteps = this%l%finaltimestep else - l%finaltimestep = sgg%TimeSteps + this%l%finaltimestep = sgg%TimeSteps endif - IF (.not.l%forcesteps) then - finaltimestepantesdecorregir=l%finaltimestep - l%finaltimestep=int(dtantesdecorregir/sgg%dt*finaltimestepantesdecorregir) + IF (.not.this%l%forcesteps) then + finaltimestepantesdecorregir=this%l%finaltimestep + this%l%finaltimestep=int(dtantesdecorregir/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 + 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/=l%finaltimestep) then + if (finaltimestepantesdecorregir/=this%l%finaltimestep) then write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) + call print11(this%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) + 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, sgg%nummedia IF (sgg%Med(i)%Is%ThinWire) THEN #ifndef CompileWithBerengerWires - if ((l%wiresflavor=='berenger')) then - CALL stoponerror (l%layoutnumber, l%size, 'Berenger Wires without support. Recompile!') + 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!') + 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 @@ -545,105 +545,105 @@ subroutine semba_init(this) ! IF ((sgg%Med(i)%Is%AnisMultiport) .OR. (sgg%Med(i)%Is%multiport).OR. (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 #ifdef NoConformalSGBC - IF (sgg%Med(i)%Is%sgbc .and. l%input_conformal_flag) THEN - CALL stoponerror (l%layoutnumber, l%size, 'Conformal sgbc not allowed. ') + IF (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') + 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 ()') + 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') + 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 + !Error abrezanjas y no this%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 + 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 (l%layoutnumber==0) then + if (this%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))) + 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,*) 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))) + 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(l%wiresflavor))=='holland') then - write(dubuf,*) l%stableradholland - CALL print11 (l%layoutnumber, '---> Holland -l%stableradholland automatic correction switch: '//trim(adjustl(dubuf))) + 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,*) 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,*) 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 (l%layoutnumber, dubuf) + CALL print11 (this%l%layoutnumber, dubuf) endif - IF (l%layoutnumber == 0) THEN - call erasesignalingfiles(l%simu_devia) + IF (this%l%layoutnumber == 0) THEN + call erasesignalingfiles(this%l%simu_devia) endif - if (l%layoutnumber==0) then + if (this%l%layoutnumber==0) then - open(newunit=thefileno,FILE = trim(adjustl(l%nEntradaRoot))//'_tag_paraviewfilters.txt') + 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')) @@ -688,8 +688,8 @@ subroutine semba_init(this) 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)') '# ( 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)')) @@ -715,9 +715,9 @@ subroutine NFDE2sgg ! parser now holds all the .nfde info !first read the limits #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - CALL read_limits_nogeom (l%layoutnumber,l%size, sgg, fullsize, SINPML_fullsize, parser,l%MurAfterPML,l%mur_exist) + CALL read_limits_nogeom (this%l%layoutnumber,this%l%size, sgg, fullsize, SINPML_fullsize, parser,this%l%MurAfterPML,this%l%mur_exist) dtantesdecorregir=sgg%dt !!!!!corrige el delta de t si es necesario !sgg15 310715 bug distintos sgg%dt !!!!!!!!!! @@ -733,33 +733,33 @@ subroutine NFDE2sgg #endif !!!write(dubuf,*) SEPARADOR//separador//separador - !!!call print11(l%layoutnumber,dubuf) + !!!call print11(this%l%layoutnumber,dubuf) !!!write(dubuf,*) '--->dt,dxmin,dymin,dzmin,sgg%dt ',dt,dxmin,dymin,dzmin,sgg%dt - !!!call print11(l%layoutnumber,dubuf) + !!!call print11(this%l%layoutnumber,dubuf) !!!write(dubuf,*) SEPARADOR//separador//separador - !!!call print11(l%layoutnumber,dubuf) + !!!call print11(this%l%layoutnumber,dubuf) - if (l%forcecfl) then - sgg%dt=dt*l%cfl + if (this%l%forcecfl) then + sgg%dt=dt*this%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) + call print11(this%l%layoutnumber,dubuf) + write(dubuf,*) 'Correcting sgg%dt with -this%l%cfl switch. New time step: ',sgg%dt + call print11(this%l%layoutnumber,dubuf) write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) + call print11(this%l%layoutnumber,dubuf) else if (sgg%dt > dt*heurCFL) then write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) + call print11(this%l%layoutnumber,dubuf) write(dubuf,*) 'Automatically correcting dt for stability reasons: ' - call print11(l%layoutnumber,dubuf) + call print11(this%l%layoutnumber,dubuf) write(dubuf,*) 'Original dt: ',sgg%dt - call print11(l%layoutnumber,dubuf) + call print11(this%l%layoutnumber,dubuf) sgg%dt=dt*heurCFL write(dubuf,*) 'New dt: ',sgg%dt - call print11(l%layoutnumber,dubuf) + call print11(this%l%layoutnumber,dubuf) write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) + call print11(this%l%layoutnumber,dubuf) endif endif !!!!!!!!!!!!No es preciso re-sincronizar pero lo hago !!!!!!!!!!!!!!!!!!!!!!!!!! @@ -768,31 +768,31 @@ subroutine NFDE2sgg call MPIupdateMin(real(sgg%dt,RKIND),finaldt) #endif !!!!!!!!!!!!!! - l%cfl=sgg%dt/dtlay + this%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) + 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(l%layoutnumber,dubuf) + call print11(this%l%layoutnumber,dubuf) write(dubuf,*) SEPARADOR//separador//separador - call print11(l%layoutnumber,dubuf) + call print11(this%l%layoutnumber,dubuf) write(dubuf,*) 'Deltat= ',sgg%dt - if (l%layoutnumber==0) call print11(l%layoutnumber,dubuf) + if (this%l%layoutnumber==0) call print11(this%l%layoutnumber,dubuf) #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%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. + call print11(this%l%layoutnumber,dubuf) + if (this%l%mur_exist.and.this%l%mur_first) then + this%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 + 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, l%ierr) + 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 @@ -806,7 +806,7 @@ subroutine NFDE2sgg sgg%Sweep(1:6)%YI = fullsize(1:6)%YI sgg%Sweep(1:6)%YE = fullsize(1:6)%YE ! - IF (l%size == 1) THEN + IF (this%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 @@ -823,56 +823,56 @@ subroutine NFDE2sgg 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) + CALL print11 (this%l%layoutnumber, dubuf) + CALL read_geomData (sgg,sggMtag,tag_numbers, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, this%l%fichin, this%l%layoutnumber, this%l%size, SINPML_fullsize, fullsize, parser, & + this%l%groundwires,this%l%attfactorc,this%l%mibc,this%l%sgbc,this%l%sgbcDispersive,this%l%MEDIOEXTRA,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, & + eps0,mu0,.false.,this%l%hay_slanted_wires,this%l%verbose,this%l%ignoresamplingerrors,tagtype,this%l%wiresflavor) #ifdef CompileWithMTLN - if (trim(adjustl(l%extension))=='.json') then + if (trim(adjustl(this%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) + ! if (trim(adjustl(this%l%extension))=='.json') mtln_solver = mtlnCtor(parser%mtln) #endif WRITE (dubuf,*) '[OK] ENDED NFDE --------> GEOM' - CALL print11 (l%layoutnumber, dubuf) + CALL print11 (this%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 + IF (this%l%resume .AND. (slices /= this%l%slicesoriginales)) THEN buff='Different resumed/original MPI slices: '//trim(adjustl(slices))//' '//& - & trim(adjustl(l%slicesoriginales)) - CALL stoponerror (l%layoutnumber, l%size, buff) + & trim(adjustl(this%l%slicesoriginales)) + CALL stoponerror (this%l%layoutnumber, this%l%size, buff) END IF - CALL print11 (l%layoutnumber, trim(adjustl(slices))) + CALL print11 (this%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))) + CALL print11 (this%l%layoutnumber, trim(adjustl(buff))) #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%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) + 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 #endif - ELSE !del l%size==1 + ELSE !del this%l%size==1 #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #ifdef CompileWithStochastic - if (l%stochastic) then - call HalvesStochasticMPI(l%layoutnumber,l%size,l%simu_devia) + if (this%l%stochastic) then + call HalvesStochasticMPI(this%l%layoutnumber,this%l%size,this%l%simu_devia) endif #endif - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%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 MPIdivide (sgg, fullsize, 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, l%ierr) - if (l%fatalerror) then + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) + if (this%l%fatalerror) then !intenta recuperarte return endif @@ -886,7 +886,7 @@ subroutine NFDE2sgg sgg%Alloc(field)%ZI = Min (sgg%Alloc(field)%ZI, SINPML_fullsize(field)%ZE-1) END DO ! - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%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) @@ -898,25 +898,25 @@ subroutine NFDE2sgg END DO !!fin 16/07/15 WRITE (dubuf,*) 'INIT NFDE --------> GEOM' - CALL print11 (l%layoutnumber, dubuf) + CALL print11 (this%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) + CALL read_geomData (sgg,sggMtag,tag_numbers, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, this%l%fichin, this%l%layoutnumber, this%l%size, SINPML_fullsize, fullsize, parser, & + this%l%groundwires,this%l%attfactorc,this%l%mibc,this%l%sgbc,this%l%sgbcDispersive,this%l%MEDIOEXTRA,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, & + eps0,mu0,this%l%simu_devia,this%l%hay_slanted_wires,this%l%verbose,this%l%ignoresamplingerrors,tagtype,this%l%wiresflavor) #ifdef CompileWithMPI !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif #ifdef CompileWithMTLN - if (trim(adjustl(l%extension))=='.json') then + if (trim(adjustl(this%l%extension))=='.json') then mtln_parsed = parser%mtln mtln_parsed%time_step = sgg%dt end if #endif WRITE (dubuf,*) '[OK] ENDED NFDE --------> GEOM' - CALL print11 (l%layoutnumber, dubuf) + CALL print11 (this%l%layoutnumber, dubuf) !restore back the indexes DO field = iEx, iHz sgg%Alloc(field)%ZE = tempalloc(field)%ZE @@ -924,11 +924,11 @@ subroutine NFDE2sgg END DO #endif CONTINUE - END IF !del l%size==1 + END IF !del this%l%size==1 ! #ifdef CompileWithMPI !wait until everything comes out - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + 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 @@ -949,95 +949,95 @@ subroutine semba_launch(this) class(semba_fdtd_t) :: this -! ! call each simulation !ojo que los layoutnumbers empiezan en 0 -! IF (l%finaltimestep /= 0) THEN -! #ifdef CompileWithMPI -! !wait until everything comes out -! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) -! #endif -! finishedwithsuccess=.false. + ! 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, this%l%ierr) +#endif + ! finishedwithsuccess=.false. ! call solver%init(l) -! if ((l%finaltimestep >= 0).and.(.not.l%skindepthpre)) then +! if ((this%l%finaltimestep >= 0).and.(.not.this%l%skindepthpre)) then ! #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) +! time_desdelanzamiento, maxSourceValue, this%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) +! time_desdelanzamiento, maxSourceValue, this%l%EpsMuTimeScale_input_parameters) ! #endif ! deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,sggMtag) ! else ! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,l%ierr) +! call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) ! #endif -! CALL get_secnds (l%time_out2) -! IF (l%layoutnumber == 0) THEN +! CALL get_secnds (this%l%time_out2) +! IF (this%l%layoutnumber == 0) THEN ! call print_credits(l) -! WRITE (dubuf,*) 'BEGUN '//trim (adjustl(l%nEntradaRoot)),' at ', time_comienzo%fecha(7:8), & +! WRITE (dubuf,*) 'BEGUN '//trim (adjustl(this%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) +! 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 (l%layoutnumber, dubuf) -! CALL print11 (l%layoutnumber, dubuf) +! CALL print11 (this%l%layoutnumber, dubuf) +! CALL print11 (this%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 +! !!!!!!! 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 ! !wait until everything comes out -! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +! CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) ! #endif ! #ifdef CompileWithMPI -! CALL MPI_FINALIZE (l%ierr) +! CALL MPI_FINALIZE (this%l%ierr) ! #endif ! stop ! endif -! END IF -! ! + END IF + ! ! #ifdef CompileWithMPI ! !wait until everything comes out -! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +! CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) ! #endif ! ! -! IF (l%layoutnumber == 0) THEN -! if (l%run) then +! 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 (l%layoutnumber, dubuf) -! WRITE (dubuf,*) 'DONE : ', trim (adjustl(l%nEntradaRoot)), ' UNTIL n=', l%finaltimestep -! CALL print11 (l%layoutnumber, dubuf) +! 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 (l%layoutnumber, dubuf) -! call erasesignalingfiles(l%simu_devia) +! 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) +! CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) ! #endif ! ! -! IF (l%deleteintermediates) THEN +! IF (this%l%deleteintermediates) THEN ! WRITE (dubuf,*) SEPARADOR // SEPARADOR // SEPARADOR -! CALL print11 (l%layoutnumber, dubuf) +! CALL print11 (this%l%layoutnumber, dubuf) ! WRITE (dubuf,*) 'Attempting to delete all intermediate data files' -! CALL print11 (l%layoutnumber, dubuf) +! CALL print11 (this%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) +! CALL print11 (this%l%layoutnumber, dubuf) +! INQUIRE (file=trim(adjustl(this%l%nEntradaRoot))//'_Outputrequests_'//trim(adjustl(whoamishort))//'.txt', EXIST=existe) ! IF (existe) THEN -! OPEN (19, file=trim(adjustl(l%nEntradaRoot))//'_Outputrequests_'//trim(adjustl(whoamishort))//'.txt') +! OPEN (19, file=trim(adjustl(this%l%nEntradaRoot))//'_Outputrequests_'//trim(adjustl(whoamishort))//'.txt') ! buscafile: DO ! READ (19, '(a)', end=76) filenombre ! IF (trim(adjustl(filenombre)) == '!END') THEN @@ -1050,8 +1050,8 @@ subroutine semba_launch(this) ! END DO buscafile ! 76 CONTINUE ! CLOSE (19, STATUS='delete') -! IF (l%layoutnumber == 0) THEN -! OPEN (33, file=trim(adjustl(l%nEntradaRoot))//'_Outputlists.dat') +! 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 @@ -1064,7 +1064,7 @@ subroutine semba_launch(this) ! !************************************************************************************************** ! !delete conformal memory reff: ##Conf_end## ! #ifdef CompileWithConformal -! if(l%input_conformal_flag)then +! if(this%l%input_conformal_flag)then ! call conf_sMesh%delete ! call conf_timeSteps%delete; ! call delete_conf_tools(); @@ -1075,50 +1075,50 @@ subroutine semba_launch(this) ! !************************************************************************************************** ! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,l%ierr) +! call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) ! #endif -! CALL get_secnds (l%time_out2) -! IF (l%layoutnumber == 0) THEN +! CALL get_secnds (this%l%time_out2) +! IF (this%l%layoutnumber == 0) THEN ! call print_credits(l) -! WRITE (dubuf,*) 'BEGUN '//trim (adjustl(l%nEntradaRoot)),' at ', time_comienzo%fecha(7:8), & +! WRITE (dubuf,*) 'BEGUN '//trim (adjustl(this%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) +! 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 (l%layoutnumber, dubuf) -! CALL print11 (l%layoutnumber, dubuf) +! CALL print11 (this%l%layoutnumber, dubuf) +! CALL print11 (this%l%layoutnumber, dubuf) ! ENDIF -! INQUIRE (file='relaunch', EXIST=l%relaunching) +! 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 ! #ifdef keeppause -! if (l%fatalerror) then +! 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. +! 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 ! 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) +! IF (this%l%relaunching.and.(.not.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) @@ -1128,16 +1128,16 @@ subroutine semba_launch(this) ! endif ! !!!!! ! #ifdef CompileWithMPI -! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +! CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) ! #endif -! IF (l%layoutnumber == 0) THEN +! IF (this%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 +! IF (this%l%layoutnumber == 0) THEN ! OPEN (9, file='pause', FORM='formatted') ! write (9, '(a)') ' ' ! CLOSE (9,status='delete') @@ -1151,33 +1151,20 @@ subroutine semba_launch(this) ! endif ! #ifdef CompileWithMPI -! CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) +! CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) ! #endif -! IF (l%layoutnumber == 0) THEN +! IF (this%l%layoutnumber == 0) THEN ! CALL CloseReportingFiles ! endif ! !************************************************************************************************** ! #ifdef CompileWithMPI -! CALL MPI_FINALIZE (l%ierr) +! CALL MPI_FINALIZE (this%l%ierr) ! #endif ! STOP ! ! -! contains -! !END PROGRAM SEMBA_FDTD_launcher -! !!!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!! - - - - -! !!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - end subroutine semba_launch subroutine initEntrada(input) @@ -1219,33 +1206,33 @@ subroutine cargaNFDE(local_nfde,local_parser) TYPE (Parseador), POINTER :: local_parser INTEGER (KIND=8) :: numero,i8,troncho,longitud integer (kind=4) :: mpi_t_linea_t,longitud4 - IF (l%existeNFDE) THEN + IF (this%l%existeNFDE) THEN WRITE (dubuf,*) 'INIT Reading file '//trim (adjustl(whoami))//' ', trim (adjustl(local_nfde)) - CALL print11 (l%layoutnumber, dubuf) + CALL print11 (this%l%layoutnumber, dubuf) !!!!!!!!!!!!!!!!!!!!!!! #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - if (l%layoutnumber==0) then + 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 ! - write(dubuf,*) '[OK]'; call print11(l%layoutnumber,dubuf) + write(dubuf,*) '[OK]'; call print11(this%l%layoutnumber,dubuf) !---> - WRITE (dubuf,*) 'INIT Sharing file through MPI'; CALL print11 (l%layoutnumber, dubuf) + WRITE (dubuf,*) 'INIT Sharing file through MPI'; CALL print11 (this%l%layoutnumber, dubuf) ! - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%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 + 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 - 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) @@ -1254,46 +1241,46 @@ subroutine cargaNFDE(local_nfde,local_parser) 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, l%ierr) + 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,l%ierr) - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + 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(l%layoutnumber,dubuf) + write(dubuf,*) '[OK]'; call print11(this%l%layoutnumber,dubuf) !---> END IF - NFDE_FILE%mpidir=l%mpidir + NFDE_FILE%mpidir=this%l%mpidir WRITE (dubuf,*) 'INIT interpreting geometrical data from ', trim (adjustl(local_nfde)) - CALL print11 (l%layoutnumber, dubuf) + 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, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif if(newrotate) then NFDE_FILE%mpidir=verdadero_mpidir call nfde_rotate (local_parser,NFDE_FILE%mpidir) #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif endif - l%thereare_stoch=NFDE_FILE%thereare_stoch - l%mpidir=NFDE_FILE%mpidir !bug 100419 - write(dubuf,*) '[OK] '//trim(adjustl(whoami))//' newparser (NFDE_FILE)'; call print11(l%layoutnumber,dubuf) + this%l%thereare_stoch=NFDE_FILE%thereare_stoch + this%l%mpidir=NFDE_FILE%mpidir !bug 100419 + write(dubuf,*) '[OK] '//trim(adjustl(whoami))//' newparser (NFDE_FILE)'; call print11(this%l%layoutnumber,dubuf) #ifdef CompileWithMPI - CALL MPI_Barrier (SUBCOMM_MPI, l%ierr) + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif return From 24a120317eefa7952c63aafc2ceef1fab9c0b53b Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Mon, 7 Jul 2025 09:34:26 +0200 Subject: [PATCH 10/56] checkpoint --- src_main_pub/semba_fdtd.F90 | 92 ++++++++++++++++++------------------- 1 file changed, 46 insertions(+), 46 deletions(-) diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index eb5ab0b4..6fec0884 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -65,7 +65,7 @@ subroutine semba_init(this) real (KIND=RKIND) :: dxmin,dymin,dzmin,dtlay real (KIND=8) time_desdelanzamiento - logical :: dummylog,finishedwithsuccess,l_auxinput, l_auxoutput, ThereArethinslots + logical :: dummylog,l_auxinput, l_auxoutput, ThereArethinslots logical :: existe logical :: hayinput logical :: lexis @@ -947,59 +947,59 @@ end subroutine semba_init subroutine semba_launch(this) class(semba_fdtd_t) :: this - - + type(solver_t) :: solver + logical :: finishedwithsuccess ! 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, this%l%ierr) #endif - ! finishedwithsuccess=.false. + finishedwithsuccess=.false. -! call solver%init(l) + call solver%init(this%l) -! if ((this%l%finaltimestep >= 0).and.(.not.this%l%skindepthpre)) then -! #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, this%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, this%l%EpsMuTimeScale_input_parameters) -! #endif -! deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,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(l) -! WRITE (dubuf,*) 'BEGUN '//trim (adjustl(this%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 (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 -! !wait until everything comes out -! CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) -! #endif -! #ifdef CompileWithMPI -! CALL MPI_FINALIZE (this%l%ierr) -! #endif -! stop -! endif + if ((this%l%finaltimestep >= 0).and.(.not.this%l%skindepthpre)) then +#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, this%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, this%l%EpsMuTimeScale_input_parameters) +#endif + deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,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(l) + WRITE (dubuf,*) 'BEGUN '//trim (adjustl(this%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 (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 + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#endif +#ifdef CompileWithMPI + CALL MPI_FINALIZE (this%l%ierr) +#endif + stop + endif END IF ! ! #ifdef CompileWithMPI From 6bbc9cc4a00bdc1fafdc5708ae5bb2e9f5564653 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Mon, 7 Jul 2025 14:13:36 +0200 Subject: [PATCH 11/56] added construction to the electric part of the row map for the evolution operator --- src_main_pub/evolution_operator.F90 | 150 ++++++++++++++++++++++++++-- 1 file changed, 143 insertions(+), 7 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index de7e7251..23ae42fe 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -1,8 +1,3 @@ -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Module to handle the creation of the evolution operator -! Date : July, 3, 2025 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - module evolution_operator use Resuming @@ -10,8 +5,11 @@ module evolution_operator use fdetypes use Report + use fhash, only: fhash_tbl, key => fhash_key + type :: field_array_t real(RKIND), pointer, dimension(:,:,:) :: data + character(len=2) :: field_type ! 'Ex', 'Ey', 'Ez', 'Hx', etc. end type implicit none @@ -141,12 +139,24 @@ subroutine GenerateInputFieldsBasis(b, FieldList) ! Storing the magnetical fields in the FieldList integer :: idx, i1, i2, i3 - idx = 12 + 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 idx = idx + 1 FieldList(idx)%data => Hx_m(i1, i2, i3, :, :, :) + FieldList(idx)%field_type = 'Hx' end do end do end do @@ -156,6 +166,7 @@ subroutine GenerateInputFieldsBasis(b, FieldList) do i3 = 1, 3 idx = idx + 1 FieldList(idx)%data => Hy_m(i1, i2, i3, :, :, :) + FieldList(idx)%field_type = 'Hy' end do end do end do @@ -165,8 +176,133 @@ subroutine GenerateInputFieldsBasis(b, FieldList) do i3 = 1, 2 idx = idx + 1 FieldList(idx)%data => Hz_m(i1, i2, i3, :, :, :) + + end do + end do + end do + + end subroutine + + subroutine GenerateOutputFields(b, FieldList) + + type (bounds_t), intent( IN) :: b + type(field_array_t), allocatable, intent(OUT) :: FieldListOutput(:) ! Aquí necesito cambiar el tipo de variable de los outputs para tener en cuenta que con el input i, se generan varios outputs + allocate(FieldListOutput(66)) + + call GenerateInputFieldsBasis(b, FieldListInput) + + integer :: i + + do i = 1, size(FieldListInput) + ! Acá es necesario realizar el paso temporal y extraer los campos usando el timestepping/resuming, en todo caso si la función es general, se llama fuera del case y se almacena dependiendo + ! del caso. + select case (trim(FieldListInput(i)%field_type)) + case ("Ex") + call Advance_Ex() + call Advance_Hy() + call Advance_Hz() + case ("Ey") + call Advance_Ey() + call Advance_Hx() + call Advance_Hz() + case ("Ez") + call Advance_Ez() + call Advance_Hx() + call Advance_Hy() + case ("Hx") + call Advance_Ex() + call Advance_Ey() + Call Advance_Ez() + call Advance_Hx() + case ("Hy") + call Advance_Hy() + case ("Hz") + call Advance_Hz() + end select + end do + + end subroutine + + subroutine GenerateRowIndexMap(b, RowIndexMap) + + type(bounds_t), intent(IN) :: b + type(fhash_tbl), intent(OUT) :: RowIndexMap + integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz + integer :: i, j, k, m + integer, allocatable :: indexList(:) + + shiftEx = 0 + shiftEy = b%Ex%Nx * b%Ex%Ny * b%Ex%Nz + shiftEz = shiftEy + b%Ey%Nx * b%Ey%Ny * b%Ey%Nz + shiftHx = shiftEz + b%Ez%Nx * b%Ez%Ny * b%Ez%Nz + shiftHy = shiftHx + b%Hx%Nx * b%Hx%Ny * b%Hx%Nz + shiftHz = shiftHy + b%Hy%Nx * b%Hy%Ny * b%Hy%Nz + + do i = 1, b%Ex%Nx-2 + do j = 1, b%Ex%Ny-2 + do k = 1, b%Ex%Nz-2 + m = (i*(b%Ex%Ny - 1) + j)*(b%Ex%Nz - 1) + k + m_shift_j = (i*(b%Ex%Ny - 1) + (j - 1))*(b%Ex%Nz - 1) + k + m_shift_k = (i*(b%Ex%Ny - 1) + j)*(b%Ex%Nz - 1) + (k - 1) + + allocate(indexList(5)) + indexList(1) = m + indexList(2) = shiftHy + m + indexList(3) = shiftHy + m_shift_k + indexList(4) = shiftHz + m + indexList(5) = shiftHz + m_shift_j + + call fhash_insert(RowIndexMap, m, indexList) + + deallocate(indexList) + + end do + end do + end do + + do i = 1, b%Ey%Nx-2 + do j = 1, b%Ey%Ny-2 + do k = 1, b%Ey%Nz-2 + m = (i*(b%Ey%Ny - 1) + j)*(b%Ey%Nz - 1) + k + m_shift_i = ((i - 1)*(b%Ey%Ny - 1) + j)*(b%Ey%Nz - 1) + k + m_shift_k = (i*(b%Ey%Ny - 1) + j)*(b%Ey%Nz - 1) + (k - 1) + + allocate(indexList(5)) + indexList(1) = shiftEy + m + indexList(2) = shiftHx + m + indexList(3) = shiftHx + m_shift_k + indexList(4) = shiftHz + m + indexList(5) = shiftHz + m_shift_i + + call fhash_insert(RowIndexMap, shiftEy + m, indexList) + + deallocate(indexList) + + end do + end do + end do + + do i = 1, b%Ez%Nx-2 + do j = 1, b%Ez%Ny-2 + do k = 1, b%Ez%Nz-2 + m = (i*(b%Ez%Ny - 1) + j)*(b%Ez%Nz - 1) + k + m_shift_i = ((i - 1)*(b%Ez%Ny - 1) + j)*(b%Ez%Nz - 1) + k + m_shift_j = (i*(b%Ez%Ny - 1) + (j - 1))*(b%Ez%Nz - 1) + k + + allocate(indexList(5)) + indexList(1) = shiftEz + m + indexList(2) = shiftHx + m + indexList(3) = shiftHx + m_shift_j + indexList(4) = shiftHy + m + indexList(5) = shiftHy + m_shift_i + + call fhash_insert(RowIndexMap, shiftEz + m, indexList) + + deallocate(indexList) + end do end do end do - end subroutine \ No newline at end of file + end subroutine + From cf73a8302aeaee42084a65430c302385cf7fcceb Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Mon, 7 Jul 2025 15:25:38 +0200 Subject: [PATCH 12/56] semba a as class and init/launch/end methods --- src_main_pub/launcher.F90 | 4 +- src_main_pub/semba_fdtd.F90 | 628 ++++++++++++++++--------------- test/system/test_init_solver.F90 | 4 +- 3 files changed, 326 insertions(+), 310 deletions(-) diff --git a/src_main_pub/launcher.F90 b/src_main_pub/launcher.F90 index 34831617..99d431df 100644 --- a/src_main_pub/launcher.F90 +++ b/src_main_pub/launcher.F90 @@ -5,8 +5,8 @@ program SEMBA_FDTD_launcher type(semba_fdtd_t) :: semba call semba%init() - ! call semba%launch() - ! call semba%end() + 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 6fec0884..bb35e1e4 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -46,11 +46,30 @@ module SEMBA_FDTD_mod IMPLICIT NONE + ! 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 + contains procedure :: init => semba_init procedure :: launch => semba_launch + procedure :: end => semba_end end type semba_fdtd_t @@ -59,21 +78,16 @@ module SEMBA_FDTD_mod subroutine semba_init(this) class(semba_fdtd_t) :: this - real (KIND=RKIND) :: eps0,mu0,cluz - real (KIND=RKIND) :: maxSourceValue real (KIND=RKIND) :: dtantesdecorregir real (KIND=RKIND) :: dxmin,dymin,dzmin,dtlay - real (KIND=8) time_desdelanzamiento logical :: dummylog,l_auxinput, l_auxoutput, ThereArethinslots - logical :: existe logical :: hayinput logical :: lexis logical :: newrotate !300124 tiramos con el rotador antiguo - character (LEN=BUFSIZE) :: f= ' ', chain = ' ', chain3 = ' ',chain4 = ' ', chaindummy= ' ', filenombre= ' ' + character (LEN=BUFSIZE) :: f= ' ', chain = ' ', chain3 = ' ',chain4 = ' ', chaindummy= ' ' character (LEN=BUFSIZE_LONG) :: slices = ' ' - character (LEN=BUFSIZE) :: whoami, whoamishort character (LEN=BUFSIZE) :: dubuf character (LEN=BUFSIZE) :: buff character (LEN=BUFSIZE) :: filename_h5bin ! File name @@ -85,16 +99,9 @@ subroutine semba_init(this) INTEGER (KIND=4) :: verdadero_mpidir integer (kind=4) :: my_iostat - integer (KIND=IKINDMTAG) , allocatable , dimension(:,:,:) :: sggMtag - integer (KIND=INTEGERSIZEOFMEDIAMATRICES) , allocatable , dimension(:,:,:) :: sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz - type (taglist_t) :: tag_numbers type (Parseador), POINTER :: parser - type (SGGFDTDINFO) :: sgg - type (limit_t), DIMENSION (1:6) :: fullsize, SINPML_fullsize type (t_NFDE_FILE), POINTER :: NFDE_FILE - type (tagtype_t) :: tagtype - TYPE (tiempo_t) :: time_comienzo type(solver_t) :: solver #ifdef CompileWithMPI @@ -107,16 +114,13 @@ subroutine semba_init(this) type (conf_conflicts_t), pointer :: conf_conflicts #endif -#ifdef CompileWithMTLN - type(mtln_t) :: mtln_parsed -#endif call initEntrada(this%l) 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) + this%eps0= 8.8541878176203898505365630317107502606083701665994498081024171524053950954599821142852891607182008932e-12 + this%mu0 = 1.2566370614359172953850573533118011536788677597500423283899778369231265625144835994512139301368468271e-6 + this%cluz=1.0_RKIND/sqrt(this%eps0*this%mu0) CALL OnPrint @@ -129,14 +133,14 @@ subroutine semba_init(this) #endif call setglobal(this%l%layoutnumber,this%l%size) !para crear variables globales con info MPI - WRITE (whoamishort, '(i5)') this%l%layoutnumber + 1 - WRITE (whoami, '(a,i5,a,i5,a)') '(', this%l%layoutnumber + 1, '/', this%l%size, ') ' + 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,this%l%ierr) #endif call get_secnds(this%l%time_out2) - time_desdelanzamiento= this%l%time_out2%segundos + this%time_desdelanzamiento= this%l%time_out2%segundos #ifndef keeppause if (this%l%layoutnumber==0) then OPEN (38, file='running') @@ -182,7 +186,7 @@ subroutine semba_init(this) #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) #endif - call get_secnds(time_comienzo) + call get_secnds(this%time_comienzo) !temporarily until later IF (this%l%layoutnumber == 0) THEN OPEN (11, file='SEMBA_FDTD_temp.log',position='append') @@ -312,20 +316,20 @@ subroutine semba_init(this) - sgg%extraswitches=parser%switches + 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) 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(sgg%extraswitches))//' '//trim(adjustl(this%l%chain2(this%l%length+1:))) + 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(this%l,status ) - sgg%nEntradaRoot=trim (adjustl(this%l%nEntradaRoot)) + this%sgg%nEntradaRoot=trim (adjustl(this%l%nEntradaRoot)) #ifdef CompileWithMTLN if (parser%general%mtlnProblem) then @@ -338,16 +342,16 @@ subroutine semba_init(this) !!!!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(sgg%nEntradaRoot))//'_h5bin.txt',exist=lexis) + inquire(file=trim(adjustl(this%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 + 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(sgg%nEntradaRoot))//'_h5bin.txt' + 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 @@ -381,7 +385,7 @@ subroutine semba_init(this) CALL print11 (this%l%layoutnumber, '[OK] Ended conversion internal ASCII => Binary') !release memory created by newPARSER if (this%l%fatalerror) then - if (allocated(sggMiEx)) deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,sggMtag) + 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 @@ -405,15 +409,15 @@ subroutine semba_init(this) #ifdef CompileWithMPI CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) CALL conformal_ini (TRIM(this%l%conformal_file_input_name),trim(this%l%fileFDE),parser,& - &sgg, sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,this%l%run_with_abrezanjas,& - &fullsize,this%l%layoutnumber,this%l%mpidir, this%l%input_conformal_flag,conf_err,this%l%verbose) + &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(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,& - &sgg, sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,& - &this%l%run_with_abrezanjas,fullsize,0,this%l%mpidir,this%l%input_conformal_flag,conf_err,this%l%verbose) + &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.) @@ -469,9 +473,9 @@ subroutine semba_init(this) write(dubuf,*) '----> this%l%input_conformal_flag True and init'; call print11(this%l%layoutnumber,dubuf) call conf_geometry_mapped_for_UGRDTD (& &conf_conflicts, & - &sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & - &fullsize, SINPML_fullsize,this%l%layoutnumber,conf_err,this%l%verbose); - !call conf_geometry_mapped_for_UGRDTD (sgg, fullsize, SINPML_fullsize,this%l%layoutnumber,conf_err,this%l%verbose); //refactor JUL15 + &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.'; @@ -488,14 +492,14 @@ subroutine semba_init(this) !************************************************************************* #endif - if (allocated(sggMiEx)) then !para el this%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,& + 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 (this%l%createmap) CALL store_geomData (sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, this%l%geomfile) + 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 @@ -504,15 +508,15 @@ subroutine semba_init(this) #endif endif write(dubuf,*) '[OK] Ended Conformal Mesh'; call print11(this%l%layoutnumber,dubuf) - if (this%l%finaltimestep==0) this%l%finaltimestep=sgg%TimeSteps !no quitar + if (this%l%finaltimestep==0) this%l%finaltimestep=this%sgg%TimeSteps !no quitar IF (this%l%forcesteps) then - sgg%TimeSteps = this%l%finaltimestep + this%sgg%TimeSteps = this%l%finaltimestep else - this%l%finaltimestep = sgg%TimeSteps + this%l%finaltimestep = this%sgg%TimeSteps endif IF (.not.this%l%forcesteps) then finaltimestepantesdecorregir=this%l%finaltimestep - this%l%finaltimestep=int(dtantesdecorregir/sgg%dt*finaltimestepantesdecorregir) + this%l%finaltimestep=int(dtantesdecorregir/this%sgg%dt*finaltimestepantesdecorregir) #ifdef CompileWithMPI 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) @@ -528,8 +532,8 @@ subroutine semba_init(this) 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 + DO i = 1, this%sgg%nummedia + IF (this%sgg%Med(i)%Is%ThinWire) THEN #ifndef CompileWithBerengerWires if ((this%l%wiresflavor=='berenger')) then CALL stoponerror (this%l%layoutnumber, this%l%size, 'Berenger Wires without support. Recompile!') @@ -543,7 +547,7 @@ subroutine semba_init(this) CONTINUE END IF ! - IF ((sgg%Med(i)%Is%AnisMultiport) .OR. (sgg%Med(i)%Is%multiport).OR. (sgg%Med(i)%Is%SGBC)) THEN + 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 (this%l%mibc) CALL stoponerror (this%l%layoutnumber, this%l%size, 'this%l%mibc Multiports without support. Recompile!') #endif @@ -551,7 +555,7 @@ subroutine semba_init(this) END IF !altair no conformal sgbc 201119 #ifdef NoConformalSGBC - IF (sgg%Med(i)%Is%sgbc .and. this%l%input_conformal_flag) THEN + 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 @@ -574,8 +578,8 @@ subroutine semba_init(this) !Error abrezanjas y no this%l%resume conformal ThereArethinslots=.FALSE. - do jmed=1,sgg%NumMedia - if (sgg%Med(jmed)%Is%ThinSlot) ThereArethinslots=.true. + 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 @@ -661,8 +665,8 @@ subroutine semba_init(this) 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 + 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( '### ')) @@ -717,16 +721,16 @@ subroutine NFDE2sgg #ifdef CompileWithMPI CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) #endif - CALL read_limits_nogeom (this%l%layoutnumber,this%l%size, sgg, fullsize, SINPML_fullsize, parser,this%l%MurAfterPML,this%l%mur_exist) + 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=sgg%dt + dtantesdecorregir=this%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) + dxmin=minval(this%sgg%DX) + dymin=minval(this%sgg%DY) + dzmin=minval(this%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 )))) + 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) @@ -740,35 +744,35 @@ subroutine NFDE2sgg !!!call print11(this%l%layoutnumber,dubuf) if (this%l%forcecfl) then - sgg%dt=dt*this%l%cfl + 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: ',sgg%dt + 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 (sgg%dt > dt*heurCFL) then + 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: ',sgg%dt + write(dubuf,*) 'Original dt: ',this%sgg%dt call print11(this%l%layoutnumber,dubuf) - sgg%dt=dt*heurCFL - write(dubuf,*) 'New dt: ',sgg%dt + 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=sgg%dt + finaldt=this%sgg%dt #ifdef CompileWithMPI - call MPIupdateMin(real(sgg%dt,RKIND),finaldt) + call MPIupdateMin(real(this%sgg%dt,RKIND),finaldt) #endif !!!!!!!!!!!!!! - this%l%cfl=sgg%dt/dtlay + this%l%cfl=this%sgg%dt/dtlay write(dubuf,*) SEPARADOR//separador//separador call print11(this%l%layoutnumber,dubuf) write(dubuf,*) 'CFLN= ',this%l%cfl @@ -778,7 +782,7 @@ subroutine NFDE2sgg write(dubuf,*) SEPARADOR//separador//separador call print11(this%l%layoutnumber,dubuf) - write(dubuf,*) 'Deltat= ',sgg%dt + 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) @@ -796,41 +800,41 @@ subroutine NFDE2sgg #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 + 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 - 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 + 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 - sgg%Alloc(1:6)%ZI = fullsize(1:6)%ZI - 1 - sgg%Alloc(1:6)%ZE = fullsize(1:6)%ZE + 1 + 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 - sgg%Sweep(1:6)%ZI = fullsize(1:6)%ZI - sgg%Sweep(1:6)%ZE = fullsize(1:6)%ZE + 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 - 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) + 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 (sgg,sggMtag,tag_numbers, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, this%l%fichin, this%l%layoutnumber, this%l%size, SINPML_fullsize, fullsize, parser, & - this%l%groundwires,this%l%attfactorc,this%l%mibc,this%l%sgbc,this%l%sgbcDispersive,this%l%MEDIOEXTRA,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, & - eps0,mu0,.false.,this%l%hay_slanted_wires,this%l%verbose,this%l%ignoresamplingerrors,tagtype,this%l%wiresflavor) + 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 if (trim(adjustl(this%l%extension))=='.json') then - mtln_parsed = parser%mtln - mtln_parsed%time_step = sgg%dt + 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 @@ -838,7 +842,7 @@ subroutine NFDE2sgg CALL print11 (this%l%layoutnumber, dubuf) !writing slices = '!SLICES' - WRITE (buff, '(i7)') sgg%Sweep(iHz)%ZE - sgg%Sweep(iHz)%ZI + 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))//' '//& @@ -847,7 +851,7 @@ subroutine NFDE2sgg END IF CALL print11 (this%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 + 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) @@ -869,7 +873,7 @@ subroutine NFDE2sgg CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) !!!ahora divide el espacio computacional - CALL MPIdivide (sgg, fullsize, SINPML_fullsize, this%l%layoutnumber, this%l%size, this%l%forcing, this%l%forced, this%l%slicesoriginales, this%l%resume,this%l%fatalerror) + 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 @@ -880,29 +884,29 @@ subroutine NFDE2sgg ! 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) + 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 - 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) + 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 (sgg,sggMtag,tag_numbers, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, this%l%fichin, this%l%layoutnumber, this%l%size, SINPML_fullsize, fullsize, parser, & - this%l%groundwires,this%l%attfactorc,this%l%mibc,this%l%sgbc,this%l%sgbcDispersive,this%l%MEDIOEXTRA,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, & - eps0,mu0,this%l%simu_devia,this%l%hay_slanted_wires,this%l%verbose,this%l%ignoresamplingerrors,tagtype,this%l%wiresflavor) + 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 @@ -911,16 +915,16 @@ subroutine NFDE2sgg #endif #ifdef CompileWithMTLN if (trim(adjustl(this%l%extension))=='.json') then - mtln_parsed = parser%mtln - mtln_parsed%time_step = sgg%dt + 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 - sgg%Alloc(field)%ZE = tempalloc(field)%ZE - sgg%Alloc(field)%ZI = tempalloc(field)%ZI + this%sgg%Alloc(field)%ZE = tempalloc(field)%ZE + this%sgg%Alloc(field)%ZI = tempalloc(field)%ZI END DO #endif CONTINUE @@ -932,12 +936,12 @@ subroutine NFDE2sgg #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) + 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 @@ -948,47 +952,49 @@ end subroutine semba_init subroutine semba_launch(this) class(semba_fdtd_t) :: this type(solver_t) :: solver - logical :: finishedwithsuccess + 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, this%l%ierr) #endif - finishedwithsuccess=.false. + this%finishedwithsuccess=.false. call solver%init(this%l) if ((this%l%finaltimestep >= 0).and.(.not.this%l%skindepthpre)) then #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, this%l%EpsMuTimeScale_input_parameters, mtln_parsed) + 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%time_desdelanzamiento, this%maxSourceValue, this%l%EpsMuTimeScale_input_parameters, this%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, this%l%EpsMuTimeScale_input_parameters) + 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%time_desdelanzamiento, this%maxSourceValue, this%l%EpsMuTimeScale_input_parameters) #endif - deallocate (sggMiEx, sggMiEy, sggMiEz,sggMiHx, sggMiHy, sggMiHz,sggMiNo,sggMtag) + 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) + 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(l) - WRITE (dubuf,*) 'BEGUN '//trim (adjustl(this%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 (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 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 @@ -1002,171 +1008,179 @@ subroutine semba_launch(this) endif END IF ! -! #ifdef CompileWithMPI -! !wait until everything comes out -! CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) -! #endif -! ! -! 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, this%l%ierr) -! #endif -! ! -! 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(whoamishort))//'.txt', EXIST=existe) -! IF (existe) THEN -! OPEN (19, file=trim(adjustl(this%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') -! 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 IF -! END IF -! ! - -! !************************************************************************************************** -! !***[conformal] ******************************************************************* -! !************************************************************************************************** -! !delete conformal memory reff: ##Conf_end## -! #ifdef CompileWithConformal -! 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,this%l%ierr) -! #endif -! CALL get_secnds (this%l%time_out2) -! IF (this%l%layoutnumber == 0) THEN -! call print_credits(l) -! WRITE (dubuf,*) 'BEGUN '//trim (adjustl(this%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 (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, this%l%ierr) -! #endif -! ! Error reading check - -! #ifdef keeppause -! if (this%l%fatalerror) then -! fatalerror_aux=.true. -! #ifdef CompileWithMPI -! 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 -! this%l%fatalerror = fatalerror_aux -! #endif -! if (this%l%fatalerror) this%l%relaunching=.true. -! #ifdef CompileWithMPI -! CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) -! #endif -! endif -! #endif - -! IF (this%l%relaunching.and.(.not.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, this%l%ierr) -! #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 (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_Barrier (SUBCOMM_MPI, this%l%ierr) -! #endif - -! IF (this%l%layoutnumber == 0) THEN -! CALL CloseReportingFiles -! endif -! !************************************************************************************************** - -! #ifdef CompileWithMPI -! CALL MPI_FINALIZE (this%l%ierr) -! #endif -! STOP -! ! +#ifdef CompileWithMPI + !wait until everything comes out + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#endif 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, this%l%ierr) +#endif + ! + 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 IF + END IF + ! + + !************************************************************************************************** + !***[conformal] ******************************************************************* + !************************************************************************************************** + !delete conformal memory reff: ##Conf_end## +#ifdef CompileWithConformal + 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,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, this%l%ierr) +#endif + ! Error reading check + +#ifdef keeppause + if (this%l%fatalerror) then + fatalerror_aux=.true. +#ifdef CompileWithMPI + 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 + this%l%fatalerror = fatalerror_aux +#endif + if (this%l%fatalerror) this%l%relaunching=.true. +#ifdef CompileWithMPI + CALL MPI_Barrier (SUBCOMM_MPI, this%l%ierr) +#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, this%l%ierr) +#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_Barrier (SUBCOMM_MPI, this%l%ierr) +#endif + + IF (this%l%layoutnumber == 0) THEN + CALL CloseReportingFiles + endif + !************************************************************************************************** + +#ifdef CompileWithMPI + CALL MPI_FINALIZE (this%l%ierr) +#endif + STOP + ! + + end subroutine semba_end + subroutine initEntrada(input) type(entrada_t), intent(inout) :: input #ifdef CompileWithConformal @@ -1207,7 +1221,7 @@ subroutine cargaNFDE(local_nfde,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(whoami))//' ', trim (adjustl(local_nfde)) + WRITE (dubuf,*) 'INIT Reading file '//trim (adjustl(this%whoami))//' ', trim (adjustl(local_nfde)) CALL print11 (this%l%layoutnumber, dubuf) !!!!!!!!!!!!!!!!!!!!!!! #ifdef CompileWithMPI @@ -1278,7 +1292,7 @@ subroutine cargaNFDE(local_nfde,local_parser) endif this%l%thereare_stoch=NFDE_FILE%thereare_stoch this%l%mpidir=NFDE_FILE%mpidir !bug 100419 - write(dubuf,*) '[OK] '//trim(adjustl(whoami))//' newparser (NFDE_FILE)'; call print11(this%l%layoutnumber,dubuf) + 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 diff --git a/test/system/test_init_solver.F90 b/test/system/test_init_solver.F90 index fc9adc6e..44cf7a30 100644 --- a/test/system/test_init_solver.F90 +++ b/test/system/test_init_solver.F90 @@ -3,6 +3,8 @@ integer function test_init_solver() bind (C) result(err) implicit none type(semba_fdtd_t) :: semba - ! call semba%init() + call semba%init() + call semba%launch() + call semba%end() end function From 041fc13123e47429c562a73fb4359ebc1379b01f Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Mon, 7 Jul 2025 15:52:11 +0200 Subject: [PATCH 13/56] Missing deletes files --- test/system/system_testingTools.F90 | 9 +++++++++ test/system/system_tests.cpp | 1 + 2 files changed, 10 insertions(+) create mode 100644 test/system/system_testingTools.F90 create mode 100644 test/system/system_tests.cpp diff --git a/test/system/system_testingTools.F90 b/test/system/system_testingTools.F90 new file mode 100644 index 00000000..29c1268d --- /dev/null +++ b/test/system/system_testingTools.F90 @@ -0,0 +1,9 @@ +module system_testingTools_mod + use iso_c_binding + + implicit none + + character(len=*, kind=c_char), parameter :: PATH_TO_TEST_DATA = c_char_'testData/' + + + 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 From 45f76d02103da854c0bbdccb7bfaa411a97972f2 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Tue, 8 Jul 2025 09:48:48 +0200 Subject: [PATCH 14/56] Makes fields part of the solver in timeStepping --- src_main_pub/interpreta_switches.F90 | 4 +- src_main_pub/semba_fdtd.F90 | 15 +- src_main_pub/timestepping.F90 | 511 ++++++++++----------------- test/system/system_testingTools.F90 | 3 +- test/system/test_init_solver.F90 | 9 +- 5 files changed, 216 insertions(+), 326 deletions(-) diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index 1232670b..65abe739 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 ,& @@ -2028,6 +2029,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. diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index bb35e1e4..3462f0ff 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -75,8 +75,9 @@ module SEMBA_FDTD_mod contains - subroutine semba_init(this) + subroutine semba_init(this, input_flags) class(semba_fdtd_t) :: this + character (len=*), optional :: input_flags real (KIND=RKIND) :: dtantesdecorregir real (KIND=RKIND) :: dxmin,dymin,dzmin,dtlay @@ -265,9 +266,15 @@ subroutine semba_init(this) call MPI_Barrier(SUBCOMM_MPI,this%l%ierr) #endif CALL get_secnds (this%l%time_out2) - ! - ! mira el command_line y el fichero launch 251022 - CALL get_command (this%l%chain2, this%l%length, status) + + 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) + end if IF (status /= 0) then CALL stoponerror (this%l%layoutnumber, this%l%size, 'General error',.true.); goto 652 endif diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 2ef2c333..5dcec511 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -91,8 +91,10 @@ module Solver_mod type, public :: solver_t type(sim_control_t) :: control type(Logic_control) :: thereAre + REAL (kind=rkind), pointer, dimension ( : , : , : ) :: Ex,Ey,Ez,Hx,Hy,Hz contains procedure :: init => solver_init + procedure :: allocate_fields => solver_allocate_fields procedure :: launch_simulation #ifdef CompileWithMTLN procedure :: launch_mtln_simulation @@ -205,6 +207,18 @@ subroutine launch_mtln_simulation(this, mtln_parsed, nEntradaRoot, layoutnumber) end subroutine #endif + subroutine solver_allocate_fields(this, sgg) + class(solver_t) :: this + 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)) + end subroutine + #ifdef CompileWithMTLN subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & SINPML_Fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & @@ -402,13 +416,22 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !!! 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%allocate_fields(sgg) + Ex => this%Ex + Ey => this%Ey + Ez => this%Ez + Hx => this%Hx + Hy => this%Hy + Hz => this%Hz + ! 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)) + !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! Init the local variables and observation stuff needed by each module, taking into account resume status @@ -1265,319 +1288,16 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi 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) -#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) - 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) - - - !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 - endif - - - - !!!!!!!!!!!!!!!!!! - !!!!!!!!!!end e field updating - !!!!!!!!!!!!!!!!!! - -#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 -#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") -#endif - call Advance_Hz (Hz, Ex, Ey, Idxe, Idye, sggMiHz, b,gm1,gm2) -#ifdef CompileWithProfiling - call nvtxEndRange -#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) - 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 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) -#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 - 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 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 -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) - endif -#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) - endif -#endif -#endif - -!!!no se si el orden wires - sgbcs del sync importa 150519 -#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 - -#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 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + call step() - !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 -#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 -#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) endif endif - ! - !Reporting,Timing, Partial flushing + if(n >= n_info) then call_timing=.true. else @@ -1594,10 +1314,6 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi 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) - -!!!!!! -!!!!!!!!! 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 @@ -2024,6 +1740,169 @@ subroutine flushPlanewaveOff(pw_switched_off, pw_still_time, pw_thereAre) endif end subroutine + subroutine step() + call flushPlanewaveOff(planewave_switched_off, 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 + call advanceConformalE() +#endif + 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)) then + call AdvancesgbcE(real(sgg%dt,RKIND),this%control%sgbcDispersive,this%control%simu_devia,this%control%stochastic) + endif + if (this%thereAre%Lumpeds) call AdvanceLumpedE(sgg,n,this%control%simu_devia,this%control%stochastic) + IF (this%thereAre%Edispersives) call AdvanceEDispersiveE(sgg) + 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 + If (this%thereAre%NodalE) then + call AdvanceNodalE(sgg,sggMiEx,sggMiEy,sggMiEz,sgg%NumMedia,n, b,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,this%control%simu_devia) + endif + +#ifdef CompileWithMPI + if (this%control%size>1) then + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_E_Cray + endif +#endif + IF (this%thereAre%Anisotropic) call AdvanceAnisotropicH(sgg%alloc,ex,ey,ez,hx,hy,hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh) +#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") +#endif + call Advance_Hz (Hz, Ex, Ey, Idxe, Idye, sggMiHz, b,gm1,gm2) +#ifdef CompileWithProfiling + call nvtxEndRange +#endif + + If (this%thereAre%PMLbodies) then !waveport absorbers + call AdvancePMLbodyH + endif + If (this%thereAre%PMLBorders) then + call AdvanceMagneticCPML ( sgg%NumMedia, b, sggMiHx, sggMiHy, sggMiHz, gm2, Hx, Hy, Hz, Ex, Ey, Ez) + endif + + If (this%thereAre%PMCBorders) then + call MinusCloneMagneticPMC(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) + endif + If (this%thereAre%PeriodicBorders) then + call CloneMagneticPeriodic(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) + endif + IF (this%thereAre%sgbcs.and.(this%control%sgbc)) then + call AdvancesgbcH() + endif + 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,sggMiHx,sggMiHy,sggMiHz,gm2,sgg%nummedia,this%control%conformalskin) +#endif + 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 + If (this%thereAre%NodalH) then + call AdvanceNodalH(sgg,sggMiHx,sggMiHy,sggMiHz,sgg%NumMedia,n, b ,GM2,Idxe,Idye,Idze,Hx,Hy,Hz,this%control%simu_devia) + endif + + 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 + 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) then + call CloneMagneticPeriodic(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) + endif + +#ifdef CompileWithConformal + if(input_conformal_flag)then + call conformal_advance_H() + endif +#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)) then + call newFlushWiresMPI(this%control%layoutnumber,this%control%size) + endif +#ifdef CompileWithStochastic + if (this%control%stochastic) then + call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) + endif +#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) + endif +#endif +#endif + +!!!no se si el orden wires - sgbcs del sync importa 150519 +#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 + +#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%thereAre%MURBorders) then + call AdvanceMagneticMUR (b, sgg,sggMiHx, sggMiHy, 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 +#endif + ENDIF + + + end subroutine + + + subroutine advanceE() #ifdef CompileWithProfiling call nvtxStartRange("Antes del bucle EX") diff --git a/test/system/system_testingTools.F90 b/test/system/system_testingTools.F90 index 29c1268d..e50b814a 100644 --- a/test/system/system_testingTools.F90 +++ b/test/system/system_testingTools.F90 @@ -3,7 +3,8 @@ module system_testingTools_mod implicit none - character(len=*, kind=c_char), parameter :: PATH_TO_TEST_DATA = c_char_'testData/' + 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/test_init_solver.F90 b/test/system/test_init_solver.F90 index 44cf7a30..d4a7d32b 100644 --- a/test/system/test_init_solver.F90 +++ b/test/system/test_init_solver.F90 @@ -1,10 +1,11 @@ integer function test_init_solver() bind (C) result(err) use SEMBA_FDTD_mod - + use system_testingTools_mod implicit none type(semba_fdtd_t) :: semba - call semba%init() + character(len=*), parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'holland1981.fdtd.json' + + call semba%init("-i "//filename) call semba%launch() call semba%end() -end function - +end function \ No newline at end of file From 581dc19c209167b6d271a742847e217dcf47681d Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Tue, 8 Jul 2025 09:57:11 +0200 Subject: [PATCH 15/56] Refactors some code into updateSigmaM and updateThinwiresSigma --- src_main_pub/timestepping.F90 | 116 ++++++++++++++++++---------------- 1 file changed, 60 insertions(+), 56 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 5dcec511..aa85ebe5 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -528,62 +528,8 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!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 - + call updateSigmaM() + call updateThinWiresSigma() !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1717,6 +1663,64 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi contains + subroutine updateSigmaM() + 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 + end subroutine updateSigmaM + + subroutine updateThinWiresSigma + !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 + end subroutine updateThinWiresSigma + 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 From 40d8c5fd92861d04f8c002d2156e2764e072362b Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Tue, 8 Jul 2025 10:03:29 +0200 Subject: [PATCH 16/56] Some code into small subroutine revertThinWiresSigma --- src_main_pub/timestepping.F90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index aa85ebe5..e9833d61 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -530,21 +530,8 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !debe ir aqui pq los gm1 y gm2 se obtienen aqui call updateSigmaM() call updateThinWiresSigma() - - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!usa el modulo p_rescale para encontrar el g1, g2 etc con los parametros resumeados correctos 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 @@ -1721,6 +1708,17 @@ subroutine updateThinWiresSigma endif end subroutine updateThinWiresSigma + subroutine revertThinWiresSigma() + 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 + end subroutine + 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 From a0d21198888343deb65c42e6a70ca17ade18f36b Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Tue, 8 Jul 2025 10:06:09 +0200 Subject: [PATCH 17/56] Adds reportSimulationOptions for option printing --- src_main_pub/timestepping.F90 | 64 +++++++++++++++++------------------ 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index e9833d61..867fc537 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -523,11 +523,6 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !fin lo cambio aqui - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! Updating Ca, Cbfficients calculation - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!correct possible paddings of Composites - !debe ir aqui pq los gm1 y gm2 se obtienen aqui call updateSigmaM() call updateThinWiresSigma() call calc_G1G2Gm1Gm2(sgg,G1,G2,Gm1,Gm2,eps0,mu0) @@ -539,33 +534,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) @@ -1719,6 +1688,37 @@ subroutine revertThinWiresSigma() endif end subroutine + subroutine reportSimulationOptions() + 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 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 From d8932e0227025fcca58f949e45ef75229152b559 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Tue, 8 Jul 2025 10:29:20 +0200 Subject: [PATCH 18/56] removes unused variables --- src_main_pub/timestepping.F90 | 165 ++++++++++++++++++---------------- 1 file changed, 88 insertions(+), 77 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 867fc537..118e6cdd 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -271,9 +271,9 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !!!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) :: Sigma,Epsilon,Mu,rdummy REAL (KIND=RKIND_tiempo) :: at,rdummydt - logical :: hayattmedia = .false.,attinformado = .false., somethingdone,newsomethingdone,call_timing,l_auxoutput,l_auxinput + logical :: attinformado = .false. ,somethingdone,newsomethingdone,call_timing,l_auxoutput,l_auxinput character(len=BUFSIZE) :: buff integer (kind=4) :: group_conformalprobes_dummy ! @@ -523,8 +523,8 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !fin lo cambio aqui - call updateSigmaM() - call updateThinWiresSigma() + call updateSigmaM(attinformado) + call updateThinWiresSigma(attinformado) call calc_G1G2Gm1Gm2(sgg,G1,G2,Gm1,Gm2,eps0,mu0) call revertThinWiresSigma() @@ -544,71 +544,9 @@ 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 initBorders() -#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) -#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 @@ -1619,17 +1557,22 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi contains - subroutine updateSigmaM() + 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 - hayattmedia=.false. - attinformado=.false. + 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. attinformado) then + if (hayattmedia.and. .not. att) then !!!!info on stabilization epr =1.0_RKIND mur =1.0_RKIND @@ -1654,23 +1597,23 @@ subroutine updateSigmaM() (1.124121310242e12 + 1.124121310242e12*this%control%attfactorc))*min(deltaespmax,skin_depth))) if (this%control%layoutnumber == 0) call WarnErrReport(buff) endif - attinformado=.true. + att=.true. endif end do endif end subroutine updateSigmaM - subroutine updateThinWiresSigma - !thin wires ! + subroutine updateThinWiresSigma(att) + logical, intent(inout) :: att if (abs(this%control%attfactorw-1.0_RKIND) > 1.0e-12_RKIND) then - attinformado=.false. + 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.attinformado) then + 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) - attinformado=.true. + att=.true. endif endif end do @@ -1718,6 +1661,74 @@ subroutine reportSimulationOptions() endif end subroutine + subroutine initBorders() + 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 + +#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) +#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 + + end subroutine subroutine flushPlanewaveOff(pw_switched_off, pw_still_time, pw_thereAre) logical, intent(inout) :: pw_switched_off, pw_still_time, pw_thereAre From 6e8f62dedb579732d4d688bca733130161e7bcfb Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Tue, 8 Jul 2025 11:20:07 +0200 Subject: [PATCH 19/56] Refactor evolution operator to add electric and magnetic field index handling subroutines --- src_main_pub/evolution_operator.F90 | 213 +++++++++++++++++++--------- 1 file changed, 149 insertions(+), 64 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 23ae42fe..1046cca1 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -223,86 +223,171 @@ subroutine GenerateOutputFields(b, FieldList) end subroutine - subroutine GenerateRowIndexMap(b, RowIndexMap) + subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, dirM1, dirM2) + type(fhash_tbl), intent(inout) :: RowIndexMap + type(limit_t), intent(in) :: field + integer, intent(in) :: shiftE, shiftM1, shiftM2 + character(len=1), intent(in) :: dirM1, dirM2 - type(bounds_t), intent(IN) :: b - type(fhash_tbl), intent(OUT) :: RowIndexMap - integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz - integer :: i, j, k, m + integer :: i, j, k, m, m_shift1, m_shift2 integer, allocatable :: indexList(:) - - shiftEx = 0 - shiftEy = b%Ex%Nx * b%Ex%Ny * b%Ex%Nz - shiftEz = shiftEy + b%Ey%Nx * b%Ey%Ny * b%Ey%Nz - shiftHx = shiftEz + b%Ez%Nx * b%Ez%Ny * b%Ez%Nz - shiftHy = shiftHx + b%Hx%Nx * b%Hx%Ny * b%Hx%Nz - shiftHz = shiftHy + b%Hy%Nx * b%Hy%Ny * b%Hy%Nz - - do i = 1, b%Ex%Nx-2 - do j = 1, b%Ex%Ny-2 - do k = 1, b%Ex%Nz-2 - m = (i*(b%Ex%Ny - 1) + j)*(b%Ex%Nz - 1) + k - m_shift_j = (i*(b%Ex%Ny - 1) + (j - 1))*(b%Ex%Nz - 1) + k - m_shift_k = (i*(b%Ex%Ny - 1) + j)*(b%Ex%Nz - 1) + (k - 1) + integer :: Nx, Ny, Nz + + Nx = field%Nx + Ny = field%Ny + Nz = field%Nz + + do i = 1, Nx - 2 + do j = 1, Ny - 2 + do k = 1, Nz - 2 + m = (i * (Ny - 1) + j) * (Nz - 1) + k + + select case (dirM1) + case ('i') + m_shift1 = ((i - 1)*(Ny - 1) + j)*(Nz - 1) + k + case ('j') + m_shift1 = (i*(Ny - 1) + (j - 1))*(Nz - 1) + k + case ('k') + m_shift1 = (i*(Ny - 1) + j)*(Nz - 1) + (k - 1) + end select + + select case (dirM2) + case ('i') + m_shift2 = ((i - 1)*(Ny - 1) + j)*(Nz - 1) + k + case ('j') + m_shift2 = (i*(Ny - 1) + (j - 1))*(Nz - 1) + k + case ('k') + m_shift2 = (i*(Ny - 1) + j)*(Nz - 1) + (k - 1) + end select allocate(indexList(5)) - indexList(1) = m - indexList(2) = shiftHy + m - indexList(3) = shiftHy + m_shift_k - indexList(4) = shiftHz + m - indexList(5) = shiftHz + m_shift_j + indexList(1) = shiftE + m + indexList(2) = shiftM1 + m + indexList(3) = shiftM1 + m_shift2 + indexList(4) = shiftM2 + m + indexList(5) = shiftM2 + m_shift1 - call fhash_insert(RowIndexMap, m, indexList) + call RowIndexMap%set(key(shiftE + m), value=indexList) deallocate(indexList) - end do end do end do + end subroutine - do i = 1, b%Ey%Nx-2 - do j = 1, b%Ey%Ny-2 - do k = 1, b%Ey%Nz-2 - m = (i*(b%Ey%Ny - 1) + j)*(b%Ey%Nz - 1) + k - m_shift_i = ((i - 1)*(b%Ey%Ny - 1) + j)*(b%Ey%Nz - 1) + k - m_shift_k = (i*(b%Ey%Ny - 1) + j)*(b%Ey%Nz - 1) + (k - 1) - - allocate(indexList(5)) - indexList(1) = shiftEy + m - indexList(2) = shiftHx + m - indexList(3) = shiftHx + m_shift_k - indexList(4) = shiftHz + m - indexList(5) = shiftHz + m_shift_i - - call fhash_insert(RowIndexMap, shiftEy + m, indexList) - - deallocate(indexList) - + subroutine AddMagneticFieldIndices(RowIndexMap, field, shiftH, shiftE1, shiftE2, dir1, dir2) + type(fhash_tbl), intent(inout) :: RowIndexMap + type(limit_t), intent(in) :: field + integer, intent(in) :: shiftH, shiftE1, shiftE2 + character(len=1), intent(in) :: dir1, dir2 + + integer :: i, j, k, m, m_shift1, m_shift2 + integer :: Nx, Ny, Nz + integer, allocatable :: temp(:), indexList(:) + integer, allocatable :: aux1(:), aux2(:), aux3(:), aux4(:) + + Nx = field%Nx + Ny = field%Ny + Nz = field%Nz + + do i = 0, Nx - 1 + do j = 0, Ny - 1 + do k = 0, Nz - 1 + m = (i*(Ny - 1) + j)*(Nz - 1) + k + + select case (dir1) + case ('i') + m_shift1 = ((i + 1)*(Ny - 1) + j)*(Nz - 1) + k + case ('j') + m_shift1 = (i*(Ny - 1) + (j + 1))*(Nz - 1) + k + case ('k') + m_shift1 = (i*(Ny - 1) + j)*(Nz - 1) + (k + 1) + end select + + select case (dir2) + case ('i') + m_shift2 = ((i + 1)*(Ny - 1) + j)*(Nz - 1) + k + case ('j') + m_shift2 = (i*(Ny - 1) + (j + 1))*(Nz - 1) + k + case ('k') + m_shift2 = (i*(Ny - 1) + j)*(Nz - 1) + (k + 1) + end select + + call RowIndexMap%get(key(shiftE1 + m), aux1) + call RowIndexMap%get(key(shiftE1 + m_shift1), aux2) + call RowIndexMap%get(key(shiftE2 + m), aux3) + call RowIndexMap%get(key(shiftE2 + m_shift2), aux4) + + integer :: totalSize + totalSize = size(aux1) + size(aux2) + size(aux3) + size(aux4) + allocate(temp(totalSize)) + temp(1:size(aux1)) = aux1 + temp(size(aux1)+1:size(aux1)+size(aux2)) = aux2 + temp(size(aux1)+size(aux2)+1:size(aux1)+size(aux2)+size(aux3)) = aux3 + temp(size(aux1)+size(aux2)+size(aux3)+1:) = aux4 + + call RemoveDuplicates(temp, indexList) + + + call RowIndexMap%set(key(shiftH + m), value=indexList) + + deallocate(temp, indexList, aux1, aux2, aux3, aux4) 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 :: temp(:) + + allocate(temp(size(inputArray))) + n = 0 + + do i = 1, size(inputArray) + found = .false. + do j = 1, n + if (temp(j) == inputArray(i)) then + found = .true. + exit + end if + end do + if (.not. found) then + n = n + 1 + temp(n) = inputArray(i) + end if + end do - do i = 1, b%Ez%Nx-2 - do j = 1, b%Ez%Ny-2 - do k = 1, b%Ez%Nz-2 - m = (i*(b%Ez%Ny - 1) + j)*(b%Ez%Nz - 1) + k - m_shift_i = ((i - 1)*(b%Ez%Ny - 1) + j)*(b%Ez%Nz - 1) + k - m_shift_j = (i*(b%Ez%Ny - 1) + (j - 1))*(b%Ez%Nz - 1) + k + allocate(outputArray(n)) + outputArray = temp(1:n) + deallocate(temp) + end subroutine - allocate(indexList(5)) - indexList(1) = shiftEz + m - indexList(2) = shiftHx + m - indexList(3) = shiftHx + m_shift_j - indexList(4) = shiftHy + m - indexList(5) = shiftHy + m_shift_i + subroutine GenerateRowIndexMap(b, RowIndexMap) - call fhash_insert(RowIndexMap, shiftEz + m, indexList) + type(bounds_t), intent(IN) :: b + type(fhash_tbl), intent(OUT) :: RowIndexMap + integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz - deallocate(indexList) - - end do - end do - end do + shiftEx = 0 + shiftEy = b%Ex%Nx * b%Ex%Ny * b%Ex%Nz + shiftEz = shiftEy + b%Ey%Nx * b%Ey%Ny * b%Ey%Nz + shiftHx = shiftEz + b%Ez%Nx * b%Ez%Ny * b%Ez%Nz + shiftHy = shiftHx + b%Hx%Nx * b%Hx%Ny * b%Hx%Nz + shiftHz = shiftHy + b%Hy%Nx * b%Hy%Ny * b%Hy%Nz - end subroutine - + call AddElectricFieldIndices(RowIndexMap, b%Ex, shiftEx, shiftHy, shiftHz, 'k', 'j') + call AddElectricFieldIndices(RowIndexMap, b%Ey, shiftEy, shiftHx, shiftHz, 'k', 'i') + call AddElectricFieldIndices(RowIndexMap, b%Ez, shiftEz, shiftHx, shiftHy, 'j', 'i') + + ! Before the magnetic fields, it is necessary to create the map of indices related to the boundary conditions + + call AddMagneticFieldIndices(RowIndexMap, b%Hx, shiftHx, shiftEy, shiftEz, 'k', 'j') + call AddMagneticFieldIndices(RowIndexMap, b%Hy, shiftHy, shiftEx, shiftEz, 'k', 'i') + call AddMagneticFieldIndices(RowIndexMap, b%Hz, shiftHz, shiftEx, shiftEy, 'j', 'i') + + + end subroutine \ No newline at end of file From 4871b4e71aea2474731bb5525863bcf7413d5637 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Tue, 8 Jul 2025 12:28:27 +0200 Subject: [PATCH 20/56] Many functions wrapping code with a clear goal --- src_main_pub/timestepping.F90 | 1329 +++++++++++++++++---------------- 1 file changed, 681 insertions(+), 648 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 118e6cdd..d43ee467 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -253,7 +253,6 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi REAL (KIND=RKIND), intent(inout) :: eps0,mu0 real (kind=RKIND_tiempo) :: tiempoinicial,lastexecutedtime,ultimodt type (SGGFDTDINFO), intent(INOUT) :: sgg - REAL (KIND=RKIND) :: dtcritico,newdtcritico REAL (KIND=RKIND) , pointer, dimension ( : , : , : ) :: Ex,Ey,Ez,Hx,Hy,Hz !!!! integer (KIND=IKINDMTAG) :: & @@ -275,7 +274,6 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi REAL (KIND=RKIND_tiempo) :: at,rdummydt logical :: attinformado = .false. ,somethingdone,newsomethingdone,call_timing,l_auxoutput,l_auxinput character(len=BUFSIZE) :: buff - integer (kind=4) :: group_conformalprobes_dummy ! !!!!!!!PML params!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -287,7 +285,7 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize ! character (LEN=BUFSIZE) :: chari,layoutcharID,dubuf - integer (kind=4) :: ini_save,mindum + integer (kind=4) :: ini_save !Generic type (Logic_control) :: thereare integer (kind=4) :: ierr,ndummy @@ -300,7 +298,6 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi ! character (LEN=BUFSIZE) :: whoami ! - TYPE (tiempo_t) :: time_out2 real (kind=RKIND) :: pscale_alpha integer :: rank !******************************************************************************* @@ -545,439 +542,28 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - call initBorders() - - - !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 - - !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 - -#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 - -#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 - 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.' -#endif - endif - - - !Anisotropic -#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 + call initializeBorders() + call initializeLumped() + call initializeWires() + call initializeAnisotropic() + call initializeSGBC() + call initializeMultiports() + call initializeConformalElements() - 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 + call initializeEDispersives() + call initializeMDispersives() + call initializePlanewave() + call initializeNodalSources() - !!!!!!!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 + call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) + call initializeObservation() -#ifdef CompileWithMPI + !!!!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 - 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) - 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 - -#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 +#ifdef CompileWithMPI + call initializeMPI() #endif - - + #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) #endif @@ -987,121 +573,42 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi n=initialtimestep ini_save = initialtimestep n_info = 5 + initialtimestep - ! -! if (verbose) call ReportExistence(sgg,this%control%layoutnumber,size, thereare,mur_second,MurAfterPML) - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! For Timing - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) call InitTiming(sgg, this%control, time_desdelanzamiento, Initialtimestep,maxSourceValue) - !!!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 - 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 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 - - -#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) - endif -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) - endif -#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) - endif -#endif -#endif -!!!no se si el orden wires - sgbcs del sync importa 150519 -#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 - -#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 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 #ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) + call flushMPIdata() #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 + +!!!no se si el orden wires - sgbcs del sync importa 150519 +#ifdef CompileWithMPI +#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 + + call printSimulationStart() + 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") @@ -1109,34 +616,13 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !240424 sgg creo el comunicador mpi de las sondas conformal aqui. debe irse con el nuevo conformal #ifdef CompileWithConformal #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) + call initMPIConformalProbes() #endif #endif - ciclo_temporal : DO while (N <= this%control%finaltimestep) call step() - - IF (this%thereAre%Observation) then - 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) - 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 - endif - endif + call updateAndFlush() if(n >= n_info) then call_timing=.true. @@ -1306,34 +792,16 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi #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 + + + if (this%control%singlefilewrite.and.perform%Unpack) call singleUnpack() + 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 @@ -1605,6 +1073,8 @@ 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 @@ -1618,117 +1088,647 @@ subroutine updateThinWiresSigma(att) endif end do endif - end subroutine updateThinWiresSigma + 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 + + 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 + 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 + +#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) +#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 + + end subroutine initializeBorders + + subroutine initializeLumped() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput + !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 + end subroutine initializeLumped + + subroutine initializeWires() + real (kind=rkind) :: dtcritico, newdtcritico + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput + 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 + +#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 + +#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 + 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 + 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.' +#endif + endif + + end subroutine initializeWires + + subroutine initializeAnisotropic() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput + +#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 + end subroutine initializeAnisotropic - subroutine revertThinWiresSigma() - 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 - end subroutine + subroutine initializeSGBC() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput - subroutine reportSimulationOptions() - 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) + 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 - 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 + end subroutine initializeSGBC + + subroutine initializeMultiports() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput - subroutine initBorders() - 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 +#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 PEC, PMC or periodic Borders'; call print11(this%control%layoutnumber,dubuf) + if (l_auxoutput) then + write (dubuf,*) '----> there are Structured multiport elements'; call print11(this%control%layoutnumber,dubuf) else - write(dubuf,*) '----> no PEC, PMC or periodic Borders found'; call print11(this%control%layoutnumber,dubuf) - endif - + write(dubuf,*) '----> no Structured multiport elements found'; call print11(this%control%layoutnumber,dubuf) + endif + endif +#endif + 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_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) + 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 - l_auxinput=this%thereAre%PMLBorders + !!!!!!!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) +#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 CPML Borders'; call print11(this%control%layoutnumber,dubuf) + write (dubuf,*) '----> there are Structured Electric dispersive elements'; call print11(this%control%layoutnumber,dubuf) else - write(dubuf,*) '----> no CPML Borders found'; call print11(this%control%layoutnumber,dubuf) + 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 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 + 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 PML Bodies'; call print11(this%control%layoutnumber,dubuf) - else - write(dubuf,*) '----> no PML Bodies found'; call print11(this%control%layoutnumber,dubuf) + 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) #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 + 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 Mur Borders'; call print11(this%control%layoutnumber,dubuf) + if ( l_auxoutput) then + write (dubuf,*) '----> there are Plane Wave'; call print11(this%control%layoutnumber,dubuf) else - write(dubuf,*) '----> no Mur Borders found'; call print11(this%control%layoutnumber,dubuf) + write(dubuf,*) '----> no Plane waves are found'; call print11(this%control%layoutnumber,dubuf) endif + end subroutine initializePlanewave - end subroutine + subroutine initializeNodalSources() + character (len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput + +#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 + + end subroutine initializeNodalSources + + subroutine initializeObservation() + character(len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput +#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 + end subroutine initializeObservation + + subroutine initializeMPI() + character(len=bufsize) :: dubuf + 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) + call InitExtraFlushMPI(this%control%layoutnumber,sgg%sweep,sgg%alloc,sgg%med,sgg%nummedia,sggmiEz,sggMiHz) + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_H(sgg%alloc,this%control%layoutnumber,this%control%size, sggmiHx,sggmiHy,sggmiHz) + call MPI_Barrier(SUBCOMM_MPI,ierr) + 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 + +!!!!!!!!!!!!!!!!!!!!!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,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) + 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 + +#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 + + subroutine flushMPIdata() + 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 +#ifdef CompileWithStochastic + if (this%control%stochastic) then + call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) + endif +#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) + endif +#endif + end subroutine flushMPIdata + + subroutine printSimulationStart() + character(len=bufsize) :: dubuf + TYPE (tiempo_t) :: time_out2 + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + 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) +#ifdef CompileWithMPI + 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 + end subroutine printSimulationStart + + subroutine initMPIConformalProbes() + integer (kind=4) :: group_conformalprobes_dummy +!!!!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 subroutine flushPlanewaveOff(pw_switched_off, pw_still_time, pw_thereAre) logical, intent(inout) :: pw_switched_off, pw_still_time, pw_thereAre @@ -1912,9 +1912,42 @@ subroutine step() ENDIF + end subroutine step + + subroutine updateAndFlush() + integer(kind=4) :: mindum + IF (this%thereAre%Observation) then + 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) + 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 + endif + endif end subroutine + subroutine singleUnpack() + character (LEN=BUFSIZE) :: dubuf + 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) + end subroutine subroutine advanceE() #ifdef CompileWithProfiling From eb10c6c6748cda88925d4f61959e0de31bf3e615 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Tue, 8 Jul 2025 14:27:34 +0200 Subject: [PATCH 21/56] [WIP] major reorganization of timestepping incoming --- src_main_pub/semba_fdtd.F90 | 2 +- src_main_pub/timestepping.F90 | 1005 ++++++++++++++++++++++++++++----- 2 files changed, 864 insertions(+), 143 deletions(-) diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index 3462f0ff..d35fca4b 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -970,7 +970,7 @@ subroutine semba_launch(this) #endif this%finishedwithsuccess=.false. - call solver%init(this%l) + call solver%init_control(this%l) if ((this%l%finaltimestep >= 0).and.(.not.this%l%skindepthpre)) then #ifdef CompileWithMTLN diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index d43ee467..cdbab2f7 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -91,9 +91,13 @@ module Solver_mod type, public :: solver_t type(sim_control_t) :: control type(Logic_control) :: thereAre - REAL (kind=rkind), pointer, dimension ( : , : , : ) :: Ex,Ey,Ez,Hx,Hy,Hz + type(perform_t) :: perform, d_perform + real (kind=rkind), pointer, dimension ( : , : , : ) :: Ex,Ey,Ez,Hx,Hy,Hz contains procedure :: init => solver_init + procedure :: run => solver_run + procedure :: end => solver_end + procedure :: init_control => solver_init_control procedure :: allocate_fields => solver_allocate_fields procedure :: launch_simulation #ifdef CompileWithMTLN @@ -110,7 +114,7 @@ module Solver_mod contains - subroutine solver_init(this, input) + subroutine solver_init_control(this, input) class(solver_t) :: this type(entrada_t) :: input this%control%simu_devia = input%simu_devia @@ -219,98 +223,20 @@ subroutine solver_allocate_fields(this, sgg) 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)) end subroutine -#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 - !!! - class(solver_t) :: this -#ifdef CompileWithMTLN - type (mtln_t) :: mtln_parsed -#endif - - - logical :: dummylog - type (tagtype_t) :: tagtype - - !!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 - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !! SIMULATION VARIABLES - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real (kind=rkind) :: maxSourceValue - REAL (kind=8) :: time_desdelanzamiento - type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters - - REAL (KIND=RKIND), intent(inout) :: eps0,mu0 - real (kind=RKIND_tiempo) :: tiempoinicial,lastexecutedtime,ultimodt - type (SGGFDTDINFO), intent(INOUT) :: sgg - 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 - 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), & - 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) - 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) :: Sigma,Epsilon,Mu,rdummy - REAL (KIND=RKIND_tiempo) :: at,rdummydt - logical :: attinformado = .false. ,somethingdone,newsomethingdone,call_timing,l_auxoutput,l_auxinput - character(len=BUFSIZE) :: buff - ! - !!!!!!!PML params!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - logical :: finishedwithsuccess - !!!!!!! - !Input - type (bounds_t) :: b - - type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize - ! - character (LEN=BUFSIZE) :: chari,layoutcharID,dubuf - integer (kind=4) :: ini_save - !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 - integer (kind=4) :: i,J,K,r,n,initialtimestep,lastexecutedtimestep,n_info,FIELD,dummyMin,dummyMax - ! + subroutine solver_init(this, sgg) + class(solver_t) :: this + type(sggfdtdinfo), intent(in) :: sgg + integer(kind=4) :: i, j, k, field character (LEN=BUFSIZE) :: whoami - ! - 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. + call this%perform%reset() + call this%d_perform%reset() + ! flushFF=.false. + ! everflushed=.false. call this%thereAre%reset() this%thereAre%MagneticMedia = sgg%thereareMagneticMedia this%thereAre%PMLMagneticMedia = sgg%therearePMLMagneticMedia @@ -606,10 +532,10 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !!!aqui no. bug resume pscale 131020 ! dt0=sgg%dt !entrada pscale pscale_alpha=1.0 !se le entra con 1.0 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! TIME STEPPING - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - + end subroutine solver_init + + subroutine solver_run(this) + class(solver_t) :: this #ifdef CompileWithProfiling call nvtxStartRange("Antes del bucle N") #endif @@ -619,6 +545,8 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi call initMPIConformalProbes() #endif #endif + + ciclo_temporal : DO while (N <= this%control%finaltimestep) call step() @@ -638,35 +566,35 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !!! 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., & + this%control%finaltimestep,this%perform,parar,.FALSE., & Ex,Ey,Ez,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) 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. + this%perform%flushXdmf=.true. + this%perform%flushVTK=.true. endif end do #ifdef CompileWithMPI - l_aux=perform%flushVTK - call MPI_AllReduce( l_aux, perform%flushVTK, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + l_aux=this%perform%flushVTK + call MPI_AllReduce( l_aux, this%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=this%perform%flushXdmf + call MPI_AllReduce( l_aux, this%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=this%perform%flushDATA + call MPI_AllReduce( l_aux, this%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=this%perform%flushFIELDS + call MPI_AllReduce( l_aux, this%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) + l_aux=this%perform%postprocess + call MPI_AllReduce( l_aux, this%perform%postprocess, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) #endif !!!!!!!!!!!! - if (perform%flushFIELDS) then + 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=',N @@ -683,9 +611,9 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi write(dubuf,*) SEPARADOR//separador//separador call print11(this%control%layoutnumber,dubuf) endif - if (perform%isFlush()) then + if (this%perform%isFlush()) then ! - flushFF=perform%postprocess + 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= ',n else @@ -709,7 +637,7 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi call print11(this%control%layoutnumber,dubuf) call print11(this%control%layoutnumber,SEPARADOR//separador//separador) ! - if (perform%postprocess) then + if (this%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 @@ -735,7 +663,7 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi endif endif !! - if (perform%flushvtk) then + if (this%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) @@ -759,7 +687,7 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi call print11(this%control%layoutnumber,dubuf) endif endif - if (perform%flushXdmf) then + if (this%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) @@ -790,12 +718,12 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi #ifdef CompileWithMPI call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - endif !del if (performflushDATA.or.... + endif !del if (this%performflushDATA.or.... ! - if (this%control%singlefilewrite.and.perform%Unpack) call singleUnpack() - if ((this%control%singlefilewrite.and.perform%Unpack).or.perform%isFlush()) then + 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= ',n call print11(this%control%layoutnumber,SEPARADOR//separador//separador) call print11(this%control%layoutnumber,dubuf) @@ -840,8 +768,11 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi ! write(*write(*,*) 'timestepping: ', n n=n+1 !sube de iteracion end do ciclo_temporal ! End of the time-stepping loop - - + + end subroutine + + subroutine solver_end(this) + class(solver_t) :: this #ifdef CompileWithProfiling call nvtxEndRange @@ -864,13 +795,13 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi 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., & + this%control%finaltimestep,this%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) - if ((this%control%flushsecondsFields/=0).or.perform%flushFIELDS) then + if ((this%control%flushsecondsFields/=0).or.this%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, & @@ -993,35 +924,824 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi call MPI_Barrier(SUBCOMM_MPI,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., & + this%control%finaltimestep,this%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 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + end subroutine + +#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 + !!! + class(solver_t) :: this +#ifdef CompileWithMTLN + type (mtln_t) :: mtln_parsed +#endif + + + logical :: dummylog + type (tagtype_t) :: tagtype + + !!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 + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! SIMULATION VARIABLES + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real (kind=rkind) :: maxSourceValue + REAL (kind=8) :: time_desdelanzamiento + type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters + + REAL (KIND=RKIND), intent(inout) :: eps0,mu0 + real (kind=RKIND_tiempo) :: tiempoinicial,lastexecutedtime,ultimodt + type (SGGFDTDINFO), intent(INOUT) :: sgg + 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 + 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), & + 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) + 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) :: Sigma,Epsilon,Mu,rdummy + REAL (KIND=RKIND_tiempo) :: at,rdummydt + logical :: attinformado = .false. ,somethingdone,newsomethingdone,call_timing,l_auxoutput,l_auxinput + character(len=BUFSIZE) :: buff + ! + !!!!!!!PML params!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical :: finishedwithsuccess + !!!!!!! + !Input + type (bounds_t) :: b + + type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize + ! + character (LEN=BUFSIZE) :: chari,layoutcharID,dubuf + integer (kind=4) :: ini_save + !Generic + type (Logic_control) :: thereare + integer (kind=4) :: ierr,ndummy + + Logical :: parar,flushFF, & + everflushed,still_planewave_time,thereareplanewave,l_aux + + integer (kind=4) :: i,J,K,r,n,initialtimestep,lastexecutedtimestep,n_info,FIELD,dummyMin,dummyMax + ! + ! + real (kind=RKIND) :: pscale_alpha + integer :: rank + !******************************************************************************* + !******************************************************************************* + !******************************************************************************* + + call this%solver_init() + call this%solver_run() + call this%solver_end() + +! planewave_switched_off=.false. +! this%control%fatalerror=.false. +! parar=.false. +! call perform%reset() +! call d_perform%reset() +! flushFF=.false. +! everflushed=.false. +! call this%thereAre%reset() +! this%thereAre%MagneticMedia = sgg%thereareMagneticMedia +! this%thereAre%PMLMagneticMedia = sgg%therearePMLMagneticMedia + +! !prechecking of no offsetting to prevent errors in case of modifications +! I=sgg%Alloc(iEx)%XI +! J=sgg%Alloc(iEx)%YI +! K=sgg%Alloc(iEx)%ZI +! do field=iEy,6 +! if (sgg%Alloc(field)%XI /= I) call stoponerror(this%control%layoutnumber,this%control%size,'OFFSETS IN INITIAL COORD NOT ALLOWED') +! 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,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; + + +! !!!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)) +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!! 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 + +! call this%allocate_fields(sgg) +! Ex => this%Ex +! Ey => this%Ey +! Ez => this%Ez +! Hx => this%Hx +! Hy => this%Hy +! Hz => this%Hz +! ! 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)) + +! !!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!! Init the local variables and observation stuff needed by each module, taking into account resume status +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! 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 +! 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) +! sgg%dt=ultimodt !para permit scaling +! !!!!!!!!!!!!No es preciso re-sincronizar pero lo hago !!!!!!!!!!!!!!!!!!!!!!!!!! +! #ifdef CompileWithMPI +! rdummy=sgg%dt +! call MPIupdateMin(real(sgg%dt,RKIND),rdummy) +! rdummy=eps0 +! call MPIupdateMin(eps0,rdummy) +! rdummy=mu0 +! 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 +! #ifdef CompileWithOldSaving +! if (this%control%resume_fromold) then +! close (14) +! write(DUbuf,*) 'Incoherence between MPI saved steps for resuming.', dummyMin,dummyMax,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 ) +! return +! else +! write(dubuf,*) 'Incoherence between MPI saved steps for resuming. Retrying with -old....' +! call print11(this%control%layoutnumber,dubuf) +! 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) +! 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 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 +! call print11(this%control%layoutnumber,dubuf) +! endif +! endif +! #else +! close (14) + +! write(dubuf,*) 'Incoherence between MPI saved steps for resuming.',dummyMin,dummyMax,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 +! call print11(this%control%layoutnumber,dubuf) +! endif +! if (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) +! !!!!!!!!!!!!!!!!!!!!! + +! !fin lo cambio aqui + +! call updateSigmaM(attinformado) +! call updateThinWiresSigma(attinformado) +! call calc_G1G2Gm1Gm2(sgg,G1,G2,Gm1,Gm2,eps0,mu0) +! call revertThinWiresSigma() + +! ! +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! write(dubuf,*) 'Init Reporting...'; call print11(this%control%layoutnumber,dubuf) +! call InitReporting(sgg,this%control) +! call reportSimulationOptions() + +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) +! !!!OJO SI SE CAMBIA EL ORDEN DE ESTAS INICIALIZACIONES HAY QUE CAMBIAR EL ORDEN DE STOREADO EN EL RESUMING +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #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, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, 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 initializeMPI() +! #endif + +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif + +! if (this%control%resume) close (14) +! ! +! n=initialtimestep +! ini_save = initialtimestep +! n_info = 5 + initialtimestep + +! write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) +! call InitTiming(sgg, this%control, time_desdelanzamiento, Initialtimestep,maxSourceValue) + + +! 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 + +! 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 +! #ifdef CompileWithMPI +! call flushMPIdata() +! #endif + +! !!!no se si el orden wires - sgbcs del sync importa 150519 +! #ifdef CompileWithMPI +! #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 + +! call printSimulationStart() + +! 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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!! 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 ) - ! -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif - !----------------------------------------------------> + + ! logical flushFF = .false., everFlushed = .false. +! #ifdef CompileWithProfiling +! call nvtxStartRange("Antes del bucle N") +! #endif +! !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 + + +! ciclo_temporal : DO while (N <= this%control%finaltimestep) + +! call step() +! call updateAndFlush() + +! 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,this%perform,parar,.FALSE., & +! Ex,Ey,Ez,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) + +! 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 +! 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 +! !!!!!!!!!!!! +! 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=',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) +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,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 (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= ',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) +! #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 (this%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) +! #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= ',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) +! #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= ',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 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 + +! #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 .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 (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= ',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 +! #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 & +! #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 +! 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 +! #endif + +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,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,this%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) + +! if ((this%control%flushsecondsFields/=0).or.this%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 +! #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) + +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,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 +! #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,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,b, n,ndummy,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,initialtimestep, & +! this%control%finaltimestep,this%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 ) +! ! +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! !----------------------------------------------------> contains @@ -1754,6 +2474,7 @@ subroutine flushPlanewaveOff(pw_switched_off, pw_still_time, pw_thereAre) end subroutine subroutine step() + logical :: planewave_switched_off = .false. call flushPlanewaveOff(planewave_switched_off, 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() @@ -1933,7 +2654,7 @@ subroutine singleUnpack() 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 + if (this%control%singlefilewrite.and.this%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 From cb1f33abb704011851eca80fc9741c76ae2daa2d Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Tue, 8 Jul 2025 15:55:34 +0200 Subject: [PATCH 22/56] [WIP] implementing solver init, run and end --- src_main_pub/timestepping.F90 | 4158 +++++++++++++++++---------------- 1 file changed, 2099 insertions(+), 2059 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index cdbab2f7..f2fe4fd7 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -92,13 +92,22 @@ module Solver_mod 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 (:,:,:) :: 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_tiempo) :: lastexecutedtime + + integer (kind=4) :: initialtimestep, lastexecutedtimestep + type(bounds_t) :: bounds + + logical :: parar contains procedure :: init => solver_init - procedure :: run => solver_run - procedure :: end => solver_end + ! procedure :: run => solver_run + ! procedure :: end => solver_end procedure :: init_control => solver_init_control - procedure :: allocate_fields => solver_allocate_fields + procedure :: allocate_fields + procedure :: init_distances procedure :: launch_simulation #ifdef CompileWithMTLN procedure :: launch_mtln_simulation @@ -211,9 +220,9 @@ subroutine launch_mtln_simulation(this, mtln_parsed, nEntradaRoot, layoutnumber) end subroutine #endif - subroutine solver_allocate_fields(this, sgg) + subroutine allocate_fields(this, sgg) class(solver_t) :: this - type (sggfdtdinfo), intent(in) :: sgg + 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),& @@ -223,16 +232,81 @@ subroutine solver_allocate_fields(this, sgg) 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)) 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 + + 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 - subroutine solver_init(this, sgg) + subroutine solver_init(this, sgg, eps0, mu0) class(solver_t) :: this - type(sggfdtdinfo), intent(in) :: sgg + type(sggfdtdinfo), intent(inout) :: sgg integer(kind=4) :: i, j, k, field - character (LEN=BUFSIZE) :: whoami + 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), intent(inout) :: eps0,mu0 + + 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%control%fatalerror=.false. - parar=.false. + this%parar=.false. call this%perform%reset() call this%d_perform%reset() ! flushFF=.false. @@ -250,90 +324,17 @@ subroutine solver_init(this, sgg) 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) !!!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)) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! Field matrices creation (an extra cell is padded at each limit and direction to deal with PMC imaging with no index errors) @@ -341,21 +342,7 @@ subroutine solver_init(this, sgg) !ojo las dimesniones deben ser giuales a las utlizadas en reallocate para las matrices sggmiEx, etc call this%allocate_fields(sgg) - Ex => this%Ex - Ey => this%Ey - Ez => this%Ez - Hx => this%Hx - Hy => this%Hy - Hz => this%Hz - ! 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)) - - !!! + 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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -363,22 +350,18 @@ subroutine solver_init(this, sgg) 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 @@ -390,15 +373,17 @@ subroutine solver_init(this, sgg) 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....' @@ -406,45 +391,45 @@ subroutine solver_init(this, sgg) 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 +! !fin lo cambio aqui call updateSigmaM(attinformado) call updateThinWiresSigma(attinformado) @@ -468,866 +453,1090 @@ subroutine solver_init(this, sgg) call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - call initializeBorders() - call initializeLumped() - call initializeWires() - call initializeAnisotropic() - call initializeSGBC() - call initializeMultiports() - call initializeConformalElements() + ! call initializeBorders() +! call initializeLumped() +! call initializeWires() +! call initializeAnisotropic() +! call initializeSGBC() +! call initializeMultiports() +! call initializeConformalElements() - call initializeEDispersives() - call initializeMDispersives() - call initializePlanewave() - call initializeNodalSources() +! call initializeEDispersives() +! call initializeMDispersives() +! call initializePlanewave() +! call initializeNodalSources() - call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) - call initializeObservation() +! call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, 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 initializeMPI() -#endif +! !!!!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 initializeMPI() +! #endif -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif - if (this%control%resume) close (14) - ! - n=initialtimestep - ini_save = initialtimestep - n_info = 5 + initialtimestep +! if (this%control%resume) close (14) +! ! +! n=this%initialtimestep +! ini_save = this%initialtimestep +! n_info = 5 + this%initialtimestep - write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) - call InitTiming(sgg, this%control, time_desdelanzamiento, Initialtimestep,maxSourceValue) +! write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) +! call InitTiming(sgg, this%control, time_desdelanzamiento, this%initialtimestep,maxSourceValue) - 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 +! 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 - 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 -#ifdef CompileWithMPI - call flushMPIdata() -#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 +! #ifdef CompileWithMPI +! call flushMPIdata() +! #endif -!!!no se si el orden wires - sgbcs del sync importa 150519 -#ifdef CompileWithMPI -#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 +! !!!no se si el orden wires - sgbcs del sync importa 150519 +! #ifdef CompileWithMPI +! #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 - call printSimulationStart() +! call printSimulationStart() - 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 - - end subroutine solver_init - - subroutine solver_run(this) - class(solver_t) :: this -#ifdef CompileWithProfiling - call nvtxStartRange("Antes del bucle N") -#endif -!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 - - - ciclo_temporal : DO while (N <= this%control%finaltimestep) - - call step() - call updateAndFlush() - - 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,this%perform,parar,.FALSE., & - Ex,Ey,Ez,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) - - 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 - 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 -!!!!!!!!!!!! - 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=',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) -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,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 (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= ',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) -#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 (this%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) -#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= ',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) -#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= ',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 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 - -#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 .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 (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= ',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 -#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 & -#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 - n=n+1 !sube de iteracion - end do ciclo_temporal ! End of the time-stepping loop - - end subroutine - - subroutine solver_end(this) - class(solver_t) :: this - -#ifdef CompileWithProfiling - call nvtxEndRange -#endif - -#ifdef CompileWithConformal - if(input_conformal_flag)then - call conformal_final_simulation (conf_timeSteps, n) - endif -#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 -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,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,this%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) - - if ((this%control%flushsecondsFields/=0).or.this%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 -#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) +contains -#ifdef CompileWithMPI - call MPI_Barrier(SUBCOMM_MPI,ierr) -#endif + subroutine findbounds(sgg,b) + ! + type (SGGFDTDINFO), intent(IN) :: sgg + type (bounds_t), intent(out) :: b + ! - 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 -#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. + !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%thereAre%Observation) call createvtk(this%control%layoutnumber,this%control%size,sgg,this%control%vtkindex,somethingdone,this%control%mpidir,tagtype,sggMtag,this%control%dontwritevtk) + ! + !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 + ! + ! + ! -#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,b, n,ndummy,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,initialtimestep, & - this%control%finaltimestep,this%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 - - end subroutine - -#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 - !!! - class(solver_t) :: this -#ifdef CompileWithMTLN - type (mtln_t) :: mtln_parsed -#endif - - - logical :: dummylog - type (tagtype_t) :: tagtype - - !!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 - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !! SIMULATION VARIABLES - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real (kind=rkind) :: maxSourceValue - REAL (kind=8) :: time_desdelanzamiento - type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters - - REAL (KIND=RKIND), intent(inout) :: eps0,mu0 - real (kind=RKIND_tiempo) :: tiempoinicial,lastexecutedtime,ultimodt - type (SGGFDTDINFO), intent(INOUT) :: sgg - 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 - 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), & - 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) - 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) :: Sigma,Epsilon,Mu,rdummy - REAL (KIND=RKIND_tiempo) :: at,rdummydt - logical :: attinformado = .false. ,somethingdone,newsomethingdone,call_timing,l_auxoutput,l_auxinput - character(len=BUFSIZE) :: buff - ! - !!!!!!!PML params!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - logical :: finishedwithsuccess - !!!!!!! - !Input - type (bounds_t) :: b - - type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize - ! - character (LEN=BUFSIZE) :: chari,layoutcharID,dubuf - integer (kind=4) :: ini_save - !Generic - type (Logic_control) :: thereare - integer (kind=4) :: ierr,ndummy - - Logical :: parar,flushFF, & - everflushed,still_planewave_time,thereareplanewave,l_aux - - integer (kind=4) :: i,J,K,r,n,initialtimestep,lastexecutedtimestep,n_info,FIELD,dummyMin,dummyMax - ! - ! - real (kind=RKIND) :: pscale_alpha - integer :: rank - !******************************************************************************* - !******************************************************************************* - !******************************************************************************* + !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 - call this%solver_init() - call this%solver_run() - call this%solver_end() + ! -! planewave_switched_off=.false. -! this%control%fatalerror=.false. -! parar=.false. -! call perform%reset() -! call d_perform%reset() -! flushFF=.false. -! everflushed=.false. -! call this%thereAre%reset() -! this%thereAre%MagneticMedia = sgg%thereareMagneticMedia -! this%thereAre%PMLMagneticMedia = sgg%therearePMLMagneticMedia + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !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 -! !prechecking of no offsetting to prevent errors in case of modifications -! I=sgg%Alloc(iEx)%XI -! J=sgg%Alloc(iEx)%YI -! K=sgg%Alloc(iEx)%ZI -! do field=iEy,6 -! if (sgg%Alloc(field)%XI /= I) call stoponerror(this%control%layoutnumber,this%control%size,'OFFSETS IN INITIAL COORD NOT ALLOWED') -! 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 + 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 -! write(whoami,'(a,i5,a,i5,a)') '(',this%control%layoutnumber+1,'/',this%control%size,') ' + 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 -! !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)) + end subroutine -! ! -! call findbounds(sgg,b) + 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 + 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 + end subroutine updateThinWiresSigma -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!! 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 + 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 -! 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) + 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 +! 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) -! !original -! do i=sgg%ALLOC(iHx)%XI,sgg%ALLOC(iHx)%XE -! dxe(i)=sgg%DX(i) -! end do +! 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 -! do J=sgg%ALLOC(iHy)%YI,sgg%ALLOC(iHy)%YE -! dye(J)=sgg%DY(J) -! end do +! #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) +! #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 -! do K=sgg%ALLOC(iHz)%ZI,sgg%ALLOC(iHz)%ZE -! dze(K)=sgg%DZ(K) -! end do +! end subroutine initializeBorders -! 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 +! subroutine initializeLumped() +! character(len=BUFSIZE) :: dubuf +! logical :: l_auxinput, l_auxoutput +! #ifdef CompileWithMPI +! integer(kind=4) :: ierr +! #endif -! !!!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; +! !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 +! end subroutine initializeLumped +! subroutine initializeWires() +! real (kind=rkind) :: dtcritico, newdtcritico +! character(len=BUFSIZE) :: dubuf +! logical :: l_auxinput, l_auxoutput +! #ifdef CompileWithMPI +! integer(kind=4) :: ierr +! #endif -! !!!lo cambio aqui permit scaling a 211118 por problemas con resuming: debe leer el eps0, mu0, antes de hacer numeros +! 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 -! allocate (G1(0 : sgg%NumMedia),G2(0 : sgg%NumMedia),GM1(0 : sgg%NumMedia),GM2(0 : sgg%NumMedia)) -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!! 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 +! #ifdef CompileWithBerengerWires +! if (trim(adjustl(this%control%wiresflavor))=='berenger') then -! call this%allocate_fields(sgg) -! Ex => this%Ex -! Ey => this%Ey -! Ez => this%Ez -! Hx => this%Hx -! Hy => this%Hy -! Hz => this%Hz -! ! 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)) +! #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 +! #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 +! 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 +! endif ! !!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!! Init the local variables and observation stuff needed by each module, taking into account resume status -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !! +! 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.' +! #endif +! endif -! 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 -! 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') +! end subroutine initializeWires + +! subroutine initializeAnisotropic() +! character(len=BUFSIZE) :: dubuf +! logical :: l_auxinput, l_auxoutput +! #ifdef CompileWithMPI +! integer(kind=4) :: ierr +! #endif + +! #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 -! open (14,file=trim(adjustl(this%control%nresumeable2)),form='unformatted') +! write(dubuf,*) '----> no Structured anisotropic elements found'; call print11(this%control%layoutnumber,dubuf) ! endif -! call ReadFields(sgg%alloc,lastexecutedtimestep,lastexecutedtime,ultimodt,eps0,mu0,Ex,Ey,Ez,Hx,Hy,Hz) -! sgg%dt=ultimodt !para permit scaling -! !!!!!!!!!!!!No es preciso re-sincronizar pero lo hago !!!!!!!!!!!!!!!!!!!!!!!!!! +! end subroutine initializeAnisotropic + +! subroutine initializeSGBC() +! character(len=BUFSIZE) :: dubuf +! logical :: l_auxinput, l_auxoutput ! #ifdef CompileWithMPI -! rdummy=sgg%dt -! call MPIupdateMin(real(sgg%dt,RKIND),rdummy) -! rdummy=eps0 -! call MPIupdateMin(eps0,rdummy) -! rdummy=mu0 -! call MPIupdateMin(mu0,rdummy) +! integer(kind=4) :: ierr ! #endif + +! IF (this%control%sgbc) then ! #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 -! #ifdef CompileWithOldSaving -! if (this%control%resume_fromold) then -! close (14) -! write(DUbuf,*) 'Incoherence between MPI saved steps for resuming.', dummyMin,dummyMax,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 ) -! return +! 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,*) 'Incoherence between MPI saved steps for resuming. Retrying with -old....' -! call print11(this%control%layoutnumber,dubuf) -! 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) -! 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 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 -! call print11(this%control%layoutnumber,dubuf) -! endif +! write(dubuf,*) '----> no Structured sgbc elements found'; call print11(this%control%layoutnumber,dubuf) ! endif -! #else -! close (14) +! endif +! end subroutine initializeSGBC + +! subroutine initializeMultiports() +! character(len=BUFSIZE) :: dubuf +! logical :: l_auxinput, l_auxoutput -! write(dubuf,*) 'Incoherence between MPI saved steps for resuming.',dummyMin,dummyMax,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 +! #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 -! initialtimestep=lastexecutedtimestep+1 -! tiempoinicial = lastexecutedtime -! write(dubuf,*) '[OK] processing resuming data. Last executed time step ',lastexecutedtimestep -! call print11(this%control%layoutnumber,dubuf) -! endif -! if (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 +! 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) +! #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 -! !!!incializa el vector de tiempos para permit scaling 191118 -! call crea_timevector(sgg,lastexecutedtimestep,this%control%finaltimestep,lastexecutedtime) -! !!!!!!!!!!!!!!!!!!!!! +! #endif +! end subroutine initializeConformalElements -! !fin lo cambio aqui +! subroutine initializeEDispersives() +! character (len=bufsize) :: dubuf +! logical :: l_auxinput, l_auxoutput +! #ifdef CompileWithMPI +! integer(kind=4) :: ierr +! #endif -! call updateSigmaM(attinformado) -! call updateThinWiresSigma(attinformado) -! call calc_G1G2Gm1Gm2(sgg,G1,G2,Gm1,Gm2,eps0,mu0) -! call revertThinWiresSigma() - -! ! ! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) +! call MPI_Barrier(SUBCOMM_MPI,ierr) ! #endif -! write(dubuf,*) 'Init Reporting...'; call print11(this%control%layoutnumber,dubuf) -! call InitReporting(sgg,this%control) -! call reportSimulationOptions() +! 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 +! end subroutine initializeEDispersives +! subroutine initializeMDispersives() +! character (len=bufsize) :: dubuf +! logical :: l_auxinput, l_auxoutput ! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) +! integer(kind=4) :: ierr ! #endif -! write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) -! !!!OJO SI SE CAMBIA EL ORDEN DE ESTAS INICIALIZACIONES HAY QUE CAMBIAR EL ORDEN DE STOREADO EN EL RESUMING + ! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) +! 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 +! end subroutine initializeMDispersives -! call initializeBorders() -! call initializeLumped() -! call initializeWires() -! call initializeAnisotropic() -! call initializeSGBC() -! call initializeMultiports() -! call initializeConformalElements() - -! call initializeEDispersives() -! call initializeMDispersives() -! call initializePlanewave() -! call initializeNodalSources() +! subroutine initializePlanewave() +! character (len=bufsize) :: dubuf +! logical :: l_auxinput, l_auxoutput +! #ifdef CompileWithMPI +! integer(kind=4) :: ierr +! #endif -! call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) -! call initializeObservation() +! #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) -! !!!!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 +! l_auxinput=this%thereAre%PlaneWaveBoxes +! l_auxoutput=l_auxinput ! #ifdef CompileWithMPI -! call initializeMPI() +! 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 +! 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 -! if (this%control%resume) close (14) -! ! -! n=initialtimestep -! ini_save = initialtimestep -! n_info = 5 + initialtimestep +! #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 -! write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) -! call InitTiming(sgg, this%control, time_desdelanzamiento, Initialtimestep,maxSourceValue) +! end subroutine initializeNodalSources +! subroutine initializeObservation() +! character(len=bufsize) :: dubuf +! logical :: l_auxinput, l_auxoutput +! #ifdef CompileWithMPI +! integer(kind=4) :: ierr +! #endif -! 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 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,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,b) +! l_auxinput=this%thereAre%Observation.or.this%thereAre%FarFields +! l_auxoutput=l_auxinput -! 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 +! #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 +! end subroutine initializeObservation + +! subroutine initializeMPI() +! character(len=bufsize) :: dubuf +! integer(kind=4) :: ierr +! 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) +! call InitExtraFlushMPI(this%control%layoutnumber,sgg%sweep,sgg%alloc,sgg%med,sgg%nummedia,sggmiEz,sggMiHz) +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! call FlushMPI_H(sgg%alloc,this%control%layoutnumber,this%control%size, sggmiHx,sggmiHy,sggmiHz) +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! 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 + +! !!!!!!!!!!!!!!!!!!!!!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,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) +! 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 + +! #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 + +! 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 +! #ifdef CompileWithStochastic +! if (this%control%stochastic) then +! call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) +! endif +! #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) +! endif +! #endif +! end subroutine flushMPIdata + +! subroutine printSimulationStart() +! character(len=bufsize) :: dubuf +! TYPE (tiempo_t) :: time_out2 ! #ifdef CompileWithMPI -! call flushMPIdata() +! integer (kind=4) :: ierr ! #endif -! !!!no se si el orden wires - sgbcs del sync importa 150519 +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! 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) ! #ifdef CompileWithMPI -! #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 +! 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 +! end subroutine printSimulationStart -! call printSimulationStart() - -! 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 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! logical flushFF = .false., everFlushed = .false. + end subroutine solver_init + +! subroutine solver_run(this) +! class(solver_t) :: this ! #ifdef CompileWithProfiling ! call nvtxStartRange("Antes del bucle N") ! #endif @@ -1357,11 +1566,11 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi ! !!! ! 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,this%perform,parar,.FALSE., & +! call Timing(sgg,b, n,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,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) -! if (.not.parar) then !!! si es por parada se gestiona al final +! 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 @@ -1522,12 +1731,12 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi ! call print11(this%control%layoutnumber,SEPARADOR//separador//separador) ! endif -! endif !!!del if (.not.parar) +! endif !!!del if (.not.this%parar) ! endif !!!del if(n >= n_info ! !!!!!!!!all the previous must be together ! this%control%fatalerror=.false. -! if (parar) then +! if (this%parar) then ! this%control%fatalerror=.true. ! exit ciclo_temporal ! endif @@ -1560,9 +1769,17 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi ! ! write(*write(*,*) 'timestepping: ', n ! n=n+1 !sube de iteracion ! end do ciclo_temporal ! End of the time-stepping loop + +! end subroutine + +! subroutine solver_end(this) +! class(solver_t) :: this +! #ifdef CompileWithMPI +! integer (kind=4) :: ndummy, ierr +! #endif - - + + ! #ifdef CompileWithProfiling ! call nvtxEndRange ! #endif @@ -1581,9 +1798,9 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! 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) +! this%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, & +! call Timing(sgg,b, 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,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) @@ -1612,7 +1829,7 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi ! 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 +! 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 GatherMPI_MTL() @@ -1712,728 +1929,831 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi ! #ifdef CompileWithMPI ! call MPI_Barrier(SUBCOMM_MPI,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,this%perform,parar,.FALSE., & +! call Timing(sgg,b, 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,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 ) + +! end subroutine + +#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 + !!! + class(solver_t) :: this +#ifdef CompileWithMTLN + type (mtln_t) :: mtln_parsed +#endif + + + logical :: dummylog + type (tagtype_t) :: tagtype + + !!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 + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! SIMULATION VARIABLES + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real (kind=rkind) :: maxSourceValue + REAL (kind=8) :: time_desdelanzamiento + type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters + + REAL (KIND=RKIND), intent(inout) :: eps0,mu0 + + type (SGGFDTDINFO), intent(INOUT) :: sgg + 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 + 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), & + 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) + 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) :: Sigma,Epsilon,Mu + REAL (KIND=RKIND_tiempo) :: at,rdummydt + logical :: somethingdone,newsomethingdone,call_timing,l_auxoutput,l_auxinput + character(len=BUFSIZE) :: buff + ! + !!!!!!!PML params!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical :: finishedwithsuccess + !!!!!!! + !Input + type (bounds_t) :: b + + type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize + ! + character (LEN=BUFSIZE) :: dubuf + integer (kind=4) :: ini_save + !Generic + type (Logic_control) :: thereare + + Logical :: flushFF, & + everflushed,still_planewave_time,thereareplanewave,l_aux + + integer (kind=4) :: i,J,K,r,n,n_info,FIELD + ! + ! + real (kind=RKIND) :: pscale_alpha + integer :: rank + !******************************************************************************* + !******************************************************************************* + !******************************************************************************* + + call this%init(sgg,eps0, mu0) + ! call this%solver_run() + ! call this%solver_end() + +! planewave_switched_off=.false. +! this%control%fatalerror=.false. +! parar=.false. +! call perform%reset() +! call d_perform%reset() +! flushFF=.false. +! everflushed=.false. +! call this%thereAre%reset() +! this%thereAre%MagneticMedia = sgg%thereareMagneticMedia +! this%thereAre%PMLMagneticMedia = sgg%therearePMLMagneticMedia + +! !prechecking of no offsetting to prevent errors in case of modifications +! I=sgg%Alloc(iEx)%XI +! J=sgg%Alloc(iEx)%YI +! K=sgg%Alloc(iEx)%ZI +! do field=iEy,6 +! if (sgg%Alloc(field)%XI /= I) call stoponerror(this%control%layoutnumber,this%control%size,'OFFSETS IN INITIAL COORD NOT ALLOWED') +! 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 ! ! -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! !----------------------------------------------------> - contains +! !!!!!!!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)) - 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 findbounds(sgg,b) - 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 - 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 - 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 +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!! 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) + - 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 +! !original +! do i=sgg%ALLOC(iHx)%XI,sgg%ALLOC(iHx)%XE +! dxe(i)=sgg%DX(i) +! end do - 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 - 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) +! do J=sgg%ALLOC(iHy)%YI,sgg%ALLOC(iHy)%YE +! dye(J)=sgg%DY(J) +! end do - 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 +! do K=sgg%ALLOC(iHz)%ZI,sgg%ALLOC(iHz)%ZE +! dze(K)=sgg%DZ(K) +! end do -#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) -#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 +! 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 - end subroutine initializeBorders +! !!!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; - subroutine initializeLumped() - character(len=BUFSIZE) :: dubuf - logical :: l_auxinput, l_auxoutput - !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 - end subroutine initializeLumped - subroutine initializeWires() - real (kind=rkind) :: dtcritico, newdtcritico - character(len=BUFSIZE) :: dubuf - logical :: l_auxinput, l_auxoutput - 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 +! !!!lo cambio aqui permit scaling a 211118 por problemas con resuming: debe leer el eps0, mu0, antes de hacer numeros -#ifdef CompileWithBerengerWires - if (trim(adjustl(this%control%wiresflavor))=='berenger') then +! allocate (G1(0 : sgg%NumMedia),G2(0 : sgg%NumMedia),GM1(0 : sgg%NumMedia),GM2(0 : sgg%NumMedia)) +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!! 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 -#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 this%allocate_fields(sgg) +! Ex => this%Ex +! Ey => this%Ey +! Ez => this%Ez +! Hx => this%Hx +! Hy => this%Hy +! Hz => this%Hz +! ! 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)) -#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 - 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 - 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.' -#endif - endif +! !!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!! Init the local variables and observation stuff needed by each module, taking into account resume status +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! 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 +! this%initialtimestep=0 !vamos a empezar en 0 para escribir el tiempo 0 !sgg sept'16 !? +! tiempoinicial = 0.0_RKIND_tiempo +! 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,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 +! rdummy=sgg%dt +! call MPIupdateMin(real(sgg%dt,RKIND),rdummy) +! rdummy=eps0 +! call MPIupdateMin(eps0,rdummy) +! rdummy=mu0 +! call MPIupdateMin(mu0,rdummy) +! #endif +! #ifdef CompileWithMPI +! 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,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 ) +! return +! else +! write(dubuf,*) 'Incoherence between MPI saved steps for resuming. Retrying with -old....' +! call print11(this%control%layoutnumber,dubuf) +! this%control%resume_fromold=.true. +! close (14) +! open (14,file=trim(adjustl(this%control%nresumeable2))//'.old',form='unformatted') +! 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( 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=',this%lastexecutedtimestep +! call print11(this%control%layoutnumber,dubuf) +! endif +! endif +! #else +! close (14) + +! 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 +! this%initialtimestep=this%lastexecutedtimestep+1 +! tiempoinicial = this%lastexecutedtime +! write(dubuf,*) '[OK] processing resuming data. Last executed time step ',this%lastexecutedtimestep +! call print11(this%control%layoutnumber,dubuf) +! endif +! 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,this%lastexecutedtimestep,this%control%finaltimestep,this%lastexecutedtime) +! !!!!!!!!!!!!!!!!!!!!! + +! !fin lo cambio aqui + +! call updateSigmaM(attinformado) +! call updateThinWiresSigma(attinformado) +! call calc_G1G2Gm1Gm2(sgg,G1,G2,Gm1,Gm2,eps0,mu0) +! call revertThinWiresSigma() + +! ! +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! write(dubuf,*) 'Init Reporting...'; call print11(this%control%layoutnumber,dubuf) +! call InitReporting(sgg,this%control) +! call reportSimulationOptions() - end subroutine initializeWires +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) +! !!!OJO SI SE CAMBIA EL ORDEN DE ESTAS INICIALIZACIONES HAY QUE CAMBIAR EL ORDEN DE STOREADO EN EL RESUMING +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif - subroutine initializeAnisotropic() - character(len=BUFSIZE) :: dubuf - logical :: l_auxinput, l_auxoutput +! call initializeBorders() +! call initializeLumped() +! call initializeWires() +! call initializeAnisotropic() +! call initializeSGBC() +! call initializeMultiports() +! call initializeConformalElements() -#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 - end subroutine initializeAnisotropic +! call initializeEDispersives() +! call initializeMDispersives() +! call initializePlanewave() +! call initializeNodalSources() - subroutine initializeSGBC() - character(len=BUFSIZE) :: dubuf - logical :: l_auxinput, l_auxoutput +! call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) +! call initializeObservation() - 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 - end subroutine initializeSGBC +! !!!!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 initializeMPI() +! #endif - subroutine initializeMultiports() - character(len=BUFSIZE) :: dubuf - logical :: l_auxinput, l_auxoutput +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #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 - end subroutine initializeMultiports +! if (this%control%resume) close (14) +! ! +! n=this%initialtimestep +! ini_save = this%initialtimestep +! n_info = 5 + this%initialtimestep - subroutine initializeConformalElements() - character(len=BUFSIZE) :: dubuf - logical :: l_auxinput, l_auxoutput +! write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) +! call InitTiming(sgg, this%control, time_desdelanzamiento, this%initialtimestep,maxSourceValue) -#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 - end subroutine initializeConformalElements +! 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 - subroutine initializeEDispersives() - character (len=bufsize) :: dubuf - logical :: l_auxinput, l_auxoutput -#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 - end subroutine initializeEDispersives +! 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 +! #ifdef CompileWithMPI +! call flushMPIdata() +! #endif - subroutine initializeMDispersives() - character (len=bufsize) :: dubuf - logical :: l_auxinput, l_auxoutput -#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 - end subroutine initializeMDispersives +! !!!no se si el orden wires - sgbcs del sync importa 150519 +! #ifdef CompileWithMPI +! #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 - subroutine initializePlanewave() - character (len=bufsize) :: dubuf - logical :: l_auxinput, l_auxoutput -#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) +! call printSimulationStart() + +! 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 - 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 - end subroutine initializePlanewave + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!! TIME STEPPING + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! logical flushFF = .false., everFlushed = .false. +! #ifdef CompileWithProfiling +! call nvtxStartRange("Antes del bucle N") +! #endif +! !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 + + +! ciclo_temporal : DO while (N <= this%control%finaltimestep) + +! call step() +! call updateAndFlush() - subroutine initializeNodalSources() - character (len=bufsize) :: dubuf - logical :: l_auxinput, l_auxoutput +! 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,this%initialtimestep, & +! this%control%finaltimestep,this%perform,parar,.FALSE., & +! Ex,Ey,Ez,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) + +! 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 +! 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 +! !!!!!!!!!!!! +! 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=',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) +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,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 (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= ',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) +! #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 (this%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) +! #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= ',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) +! #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= ',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. -#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 +! 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 - end subroutine initializeNodalSources +! #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 .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 - subroutine initializeObservation() - character(len=bufsize) :: dubuf - logical :: l_auxinput, l_auxoutput -#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) +! #endif +! endif !del if (this%performflushDATA.or.... +! ! -#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 - end subroutine initializeObservation - subroutine initializeMPI() - character(len=bufsize) :: dubuf - 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) - call InitExtraFlushMPI(this%control%layoutnumber,sgg%sweep,sgg%alloc,sgg%med,sgg%nummedia,sggmiEz,sggMiHz) - call MPI_Barrier(SUBCOMM_MPI,ierr) - call FlushMPI_H(sgg%alloc,this%control%layoutnumber,this%control%size, sggmiHx,sggmiHy,sggmiHz) - call MPI_Barrier(SUBCOMM_MPI,ierr) - 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 +! 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= ',n +! call print11(this%control%layoutnumber,SEPARADOR//separador//separador) +! call print11(this%control%layoutnumber,dubuf) +! call print11(this%control%layoutnumber,SEPARADOR//separador//separador) +! endif -!!!!!!!!!!!!!!!!!!!!!fin juego con fuego 210815 +! 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 +! #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 & +! #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 +! 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 +! #endif - !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 CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! if (n>this%control%finaltimestep) n=this%control%finaltimestep !readjust n since after finishing it is increased +! this%control%finaltimestep=n +! this%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,this%initialtimestep, & +! this%control%finaltimestep,this%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) -#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) - endif +! write(dubuf,*)'END FDTD time stepping. Beginning posprocessing at n= ',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= ',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,this%initialtimestep,this%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 +! #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 +! 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) -#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 +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,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 +! #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. - subroutine flushMPIdata() - 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 -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) - endif -#endif - 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) -#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 - end subroutine flushMPIdata +! #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,b, n,ndummy,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,this%initialtimestep, & +! this%control%finaltimestep,this%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 ) +! ! +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! !----------------------------------------------------> + + contains - subroutine printSimulationStart() - character(len=bufsize) :: dubuf - TYPE (tiempo_t) :: time_out2 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - 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) -#ifdef CompileWithMPI - 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 - end subroutine printSimulationStart subroutine initMPIConformalProbes() - integer (kind=4) :: group_conformalprobes_dummy + 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 @@ -2475,6 +2795,10 @@ subroutine flushPlanewaveOff(pw_switched_off, pw_still_time, pw_thereAre) subroutine step() logical :: planewave_switched_off = .false. +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#endif + call flushPlanewaveOff(planewave_switched_off, 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() @@ -2648,11 +2972,14 @@ subroutine updateAndFlush() subroutine singleUnpack() character (LEN=BUFSIZE) :: dubuf +#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= ',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 + 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=n*sgg%dt @@ -3012,159 +3339,13 @@ subroutine XXXXfillMagnetic(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sgg 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 -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) -#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) -#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 - End do - 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 -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) -#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) -#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 - 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) - - mediois3=.true.; mediois4=.true. + 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,medio5,mediois1,mediois2,mediois3,mediois4) +!$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 @@ -3173,21 +3354,21 @@ subroutine fillMtag(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sgg 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 + !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 #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) private (i,j,k,medio1,medio2,medio3,medio4) #endif Do k=1,b%sweepHy%NZ Do j=1,b%sweepHy%NY @@ -3196,19 +3377,17 @@ subroutine fillMtag(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sgg 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 + 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,medio5,mediois1,mediois2,mediois3,mediois4) +!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) #endif Do k=1,b%sweepHz%NZ Do j=1,b%sweepHz%NY @@ -3217,318 +3396,179 @@ subroutine fillMtag(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sgg 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 - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!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 - - ! - !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 + 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 + End do + End do +#ifdef CompileWithOpenMP +!$OMP END PARALLEL DO +#endif ! - 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 +#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 +#ifdef CompileWithOpenMP +!$OMP END PARALLEL DO +!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) +#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) +#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 + End do + End do +#ifdef CompileWithOpenMP +!$OMP END PARALLEL DO +#endif + return + end subroutine XXXXfillMagnetic - ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !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 fillMtag(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) - 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 (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) - 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 + 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 +#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%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 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 + End do + End do +#ifdef CompileWithOpenMP +!$OMP END PARALLEL DO +#endif + return + end subroutine fillMtag + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 + + + - end subroutine + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! 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 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end subroutine launch_simulation From 9d2ada9737fca8af18f1e1652ba2df64eabe47ae Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Tue, 8 Jul 2025 17:01:07 +0200 Subject: [PATCH 23/56] [WIP] Reorganizing timestepping --- src_main_pub/timestepping.F90 | 1088 +++++++++++++++++---------------- 1 file changed, 561 insertions(+), 527 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index f2fe4fd7..3816996c 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -97,10 +97,17 @@ module Solver_mod REAL (KIND=RKIND), pointer, dimension (:) :: Idxe, Idye, Idze, Idxh, Idyh, Idzh, dxe, dye, dze, dxh, dyh, dzh real (kind=RKIND_tiempo) :: lastexecutedtime + ! integer(kind=integersizeofmediamatrices), dimension(:,:,:) :: sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz + integer (kind=4) :: initialtimestep, lastexecutedtimestep type(bounds_t) :: bounds logical :: parar + +#ifdef CompileWithMTLN + type (mtln_t) :: mtln_parsed +#endif + contains procedure :: init => solver_init ! procedure :: run => solver_run @@ -283,26 +290,49 @@ subroutine init_distances(this,sgg) this%Idzh=1.0_RKIND/this%dzh end subroutine - subroutine solver_init(this, sgg, eps0, mu0) + 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), intent(inout) :: eps0,mu0 real(kind=RKIND_tiempo) :: ultimodt character (len=bufsize) :: dubuf logical :: attinformado = .false. -#ifdef compileWithMPI +! #ifdef compileWithMPI integer(kind=4) :: dummyMin,dummyMax, ierr real(kind=rkind) :: rdummy -#endif +! #endif + + ! this%sggMiNo = sggMiNo + ! this%sggMiEx = sggMiEx + ! this%sggMiEy = sggMiEy + ! this%sggMiEz = sggMiEz + ! this%sggMiHx = sggMiHx + ! this%sggMiHy = sggMiHy + ! this%sggMiHz = sggMiHz this%control%fatalerror=.false. @@ -453,20 +483,20 @@ subroutine solver_init(this, sgg, eps0, mu0) call MPI_Barrier(SUBCOMM_MPI,ierr) #endif - ! call initializeBorders() -! call initializeLumped() -! call initializeWires() -! call initializeAnisotropic() -! call initializeSGBC() -! call initializeMultiports() -! call initializeConformalElements() + call initializeBorders() + call initializeLumped() + call initializeWires() + call initializeAnisotropic() + call initializeSGBC() + call initializeMultiports() + call initializeConformalElements() -! call initializeEDispersives() -! call initializeMDispersives() -! call initializePlanewave() -! call initializeNodalSources() + call initializeEDispersives() + call initializeMDispersives() + call initializePlanewave() + call initializeNodalSources() -! call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) + call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,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 @@ -914,455 +944,456 @@ subroutine reportSimulationOptions() 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 -! 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 + 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 + 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) +#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 + 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 -! #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) -! #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 +#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) +#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 -! end subroutine initializeBorders + end subroutine initializeBorders -! subroutine initializeLumped() -! character(len=BUFSIZE) :: dubuf -! logical :: l_auxinput, l_auxoutput -! #ifdef CompileWithMPI -! integer(kind=4) :: ierr -! #endif + subroutine initializeLumped() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#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,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 -! end subroutine initializeLumped + !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 + end subroutine initializeLumped -! subroutine initializeWires() -! real (kind=rkind) :: dtcritico, newdtcritico -! character(len=BUFSIZE) :: dubuf -! logical :: l_auxinput, l_auxoutput -! #ifdef CompileWithMPI -! integer(kind=4) :: ierr -! #endif + subroutine initializeWires() + real (kind=rkind) :: dtcritico, newdtcritico + character(len=BUFSIZE) :: dubuf, buff + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#endif -! 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 + 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 -! #ifdef CompileWithBerengerWires -! if (trim(adjustl(this%control%wiresflavor))=='berenger') then +#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 +#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 + 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 -! #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 -! 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 +#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 + 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 -! 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.' -! #endif -! 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 + !!! +!! + 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 + end subroutine initializeWires -! subroutine initializeAnisotropic() -! character(len=BUFSIZE) :: dubuf -! logical :: l_auxinput, l_auxoutput -! #ifdef CompileWithMPI -! integer(kind=4) :: ierr -! #endif + 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,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 -! end subroutine initializeAnisotropic +#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 + end subroutine initializeAnisotropic -! subroutine initializeSGBC() -! character(len=BUFSIZE) :: dubuf -! logical :: l_auxinput, l_auxoutput -! #ifdef CompileWithMPI -! integer(kind=4) :: ierr -! #endif + subroutine initializeSGBC() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#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 -! end subroutine initializeSGBC + 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 + end subroutine initializeSGBC -! subroutine initializeMultiports() -! character(len=BUFSIZE) :: dubuf -! logical :: l_auxinput, l_auxoutput - -! #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 -! end subroutine initializeMultiports - -! subroutine initializeConformalElements() -! character(len=BUFSIZE) :: dubuf -! logical :: l_auxinput, l_auxoutput + subroutine initializeMultiports() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput -! #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 +#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 + end subroutine initializeMultiports -! !!!!!!!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 initializeConformalElements() + character(len=BUFSIZE) :: dubuf + logical :: l_auxinput, l_auxoutput -! subroutine initializeEDispersives() -! character (len=bufsize) :: dubuf -! logical :: l_auxinput, l_auxoutput -! #ifdef CompileWithMPI -! integer(kind=4) :: ierr -! #endif +#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 -! #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 -! end subroutine initializeEDispersives + !!!!!!!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 initializeMDispersives() -! character (len=bufsize) :: dubuf -! logical :: l_auxinput, l_auxoutput -! #ifdef CompileWithMPI -! integer(kind=4) :: ierr -! #endif + subroutine initializeEDispersives() + character (len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#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 -! end subroutine initializeMDispersives +#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 + end subroutine initializeEDispersives -! subroutine initializePlanewave() -! character (len=bufsize) :: dubuf -! logical :: l_auxinput, l_auxoutput -! #ifdef CompileWithMPI -! integer(kind=4) :: ierr -! #endif + subroutine initializeMDispersives() + character (len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#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) +#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 + end subroutine initializeMDispersives -! 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 -! end subroutine initializePlanewave + subroutine initializePlanewave() + character (len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#endif -! subroutine initializeNodalSources() -! character (len=bufsize) :: dubuf -! logical :: l_auxinput, l_auxoutput -! #ifdef CompileWithMPI -! integer(kind=4) :: ierr -! #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) -! #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%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 + end subroutine initializePlanewave + + subroutine initializeNodalSources() + character (len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#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 + 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 -! end subroutine initializeNodalSources + end subroutine initializeNodalSources ! subroutine initializeObservation() ! character(len=bufsize) :: dubuf @@ -1403,7 +1434,7 @@ subroutine reportSimulationOptions() ! 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,sggmiEz,sggMiHz) +! call InitExtraFlushMPI(this %control%layoutnumber,sgg%sweep,sgg%alloc,sgg%med,sgg%nummedia,sggmiEz,sggMiHz) ! call MPI_Barrier(SUBCOMM_MPI,ierr) ! call FlushMPI_H(sgg%alloc,this%control%layoutnumber,this%control%size, sggmiHx,sggmiHy,sggmiHz) ! call MPI_Barrier(SUBCOMM_MPI,ierr) @@ -1531,7 +1562,98 @@ subroutine reportSimulationOptions() ! call print11(this%control%layoutnumber,dubuf) ! endif ! end subroutine printSimulationStart + 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) + 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 +#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%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 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 + End do + End do +#ifdef CompileWithOpenMP +!$OMP END PARALLEL DO +#endif + return + end subroutine fillMtag end subroutine solver_init @@ -2022,7 +2144,11 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi !******************************************************************************* !******************************************************************************* - call this%init(sgg,eps0, mu0) +#ifdef CompileWithMTLN + this%mtln_parsed = mtln_parsed +#endif + + call this%init(sgg,eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, SINPML_fullsize, fullsize, tag_numbers) ! call this%solver_run() ! call this%solver_end() @@ -3467,98 +3593,6 @@ end subroutine XXXXfillMagnetic !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - 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) - - 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 -#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%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 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 - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -#endif - return - end subroutine fillMtag !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 From 572ee30d503211091676520b949685e509056314 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Wed, 9 Jul 2025 11:49:27 +0200 Subject: [PATCH 24/56] Refactor to use sweep fields instead of the field in the boundary --- src_main_pub/evolution_operator.F90 | 76 +++++++++++++++-------------- 1 file changed, 39 insertions(+), 37 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 1046cca1..31f9addc 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -233,31 +233,31 @@ subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, integer, allocatable :: indexList(:) integer :: Nx, Ny, Nz - Nx = field%Nx - Ny = field%Ny - Nz = field%Nz + Nx = field%Nx + 2 + Ny = field%Ny + 2 + Nz = field%Nz + 2 - do i = 1, Nx - 2 - do j = 1, Ny - 2 - do k = 1, Nz - 2 - m = (i * (Ny - 1) + j) * (Nz - 1) + k + do i = 1, Nx + do j = 1, Ny + do k = 1, Nz + m = (i*Ny + j)*Nz + k select case (dirM1) case ('i') - m_shift1 = ((i - 1)*(Ny - 1) + j)*(Nz - 1) + k + m_shift1 = ((i - 1)*Ny + j)*Nz + k case ('j') - m_shift1 = (i*(Ny - 1) + (j - 1))*(Nz - 1) + k + m_shift1 = (i*Ny + (j - 1))*Nz + k case ('k') - m_shift1 = (i*(Ny - 1) + j)*(Nz - 1) + (k - 1) + m_shift1 = (i*Ny + j)*Nz + (k - 1) end select select case (dirM2) case ('i') - m_shift2 = ((i - 1)*(Ny - 1) + j)*(Nz - 1) + k + m_shift2 = ((i - 1)*Ny + j)*Nz + k case ('j') - m_shift2 = (i*(Ny - 1) + (j - 1))*(Nz - 1) + k + m_shift2 = (i*Ny + (j - 1))*Nz + k case ('k') - m_shift2 = (i*(Ny - 1) + j)*(Nz - 1) + (k - 1) + m_shift2 = (i*Ny + j)*Nz + (k - 1) end select allocate(indexList(5)) @@ -286,31 +286,31 @@ subroutine AddMagneticFieldIndices(RowIndexMap, field, shiftH, shiftE1, shiftE2, integer, allocatable :: temp(:), indexList(:) integer, allocatable :: aux1(:), aux2(:), aux3(:), aux4(:) - Nx = field%Nx - Ny = field%Ny - Nz = field%Nz + Nx = field%Nx + 2 + Ny = field%Ny + 2 + Nz = field%Nz + 2 - do i = 0, Nx - 1 - do j = 0, Ny - 1 - do k = 0, Nz - 1 - m = (i*(Ny - 1) + j)*(Nz - 1) + k + do i = 1, Nx + do j = 1, Ny + do k = 1, Nz + m = (i*Ny + j)*Nz + k select case (dir1) case ('i') - m_shift1 = ((i + 1)*(Ny - 1) + j)*(Nz - 1) + k + m_shift1 = ((i + 1)*Ny + j)*Nz + k case ('j') - m_shift1 = (i*(Ny - 1) + (j + 1))*(Nz - 1) + k + m_shift1 = (i*Ny + (j + 1))*Nz + k case ('k') - m_shift1 = (i*(Ny - 1) + j)*(Nz - 1) + (k + 1) + m_shift1 = (i*Ny + j)*Nz + (k + 1) end select select case (dir2) case ('i') - m_shift2 = ((i + 1)*(Ny - 1) + j)*(Nz - 1) + k + m_shift2 = ((i + 1)*Ny + j)*Nz + k case ('j') - m_shift2 = (i*(Ny - 1) + (j + 1))*(Nz - 1) + k + m_shift2 = (i*Ny + (j + 1))*Nz + k case ('k') - m_shift2 = (i*(Ny - 1) + j)*(Nz - 1) + (k + 1) + m_shift2 = (i*Ny + j)*Nz + (k + 1) end select call RowIndexMap%get(key(shiftE1 + m), aux1) @@ -373,21 +373,23 @@ subroutine GenerateRowIndexMap(b, RowIndexMap) integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz shiftEx = 0 - shiftEy = b%Ex%Nx * b%Ex%Ny * b%Ex%Nz - shiftEz = shiftEy + b%Ey%Nx * b%Ey%Ny * b%Ey%Nz - shiftHx = shiftEz + b%Ez%Nx * b%Ez%Ny * b%Ez%Nz - shiftHy = shiftHx + b%Hx%Nx * b%Hx%Ny * b%Hx%Nz - shiftHz = shiftHy + b%Hy%Nx * b%Hy%Ny * b%Hy%Nz + shiftEy = b%sweepEx%Nx * b%sweepEx%Ny * b%sweepEx%Nz + shiftEz = shiftEy + b%sweepEy%Nx * b%sweepEy%Ny * b%sweepEy%Nz + shiftHx = shiftEz + b%sweepEz%Nx * b%sweepEz%Ny * b%sweepEz%Nz + shiftHy = shiftHx + b%sweepHx%Nx * b%sweepHx%Ny * b%sweepHx%Nz + shiftHz = shiftHy + b%sweepHy%Nx * b%sweepHy%Ny * b%sweepHy%Nz - call AddElectricFieldIndices(RowIndexMap, b%Ex, shiftEx, shiftHy, shiftHz, 'k', 'j') - call AddElectricFieldIndices(RowIndexMap, b%Ey, shiftEy, shiftHx, shiftHz, 'k', 'i') - call AddElectricFieldIndices(RowIndexMap, b%Ez, shiftEz, shiftHx, shiftHy, 'j', 'i') + call AddElectricFieldIndices(RowIndexMap, b%sweepEx, shiftEx, shiftHy, shiftHz, 'k', 'j') + call AddElectricFieldIndices(RowIndexMap, b%sweepEy, shiftEy, shiftHx, shiftHz, 'k', 'i') + call AddElectricFieldIndices(RowIndexMap, b%sweepEz, shiftEz, shiftHx, shiftHy, 'j', 'i') ! Before the magnetic fields, it is necessary to create the map of indices related to the boundary conditions - call AddMagneticFieldIndices(RowIndexMap, b%Hx, shiftHx, shiftEy, shiftEz, 'k', 'j') - call AddMagneticFieldIndices(RowIndexMap, b%Hy, shiftHy, shiftEx, shiftEz, 'k', 'i') - call AddMagneticFieldIndices(RowIndexMap, b%Hz, shiftHz, shiftEx, shiftEy, 'j', 'i') + call AddMagneticFieldIndices(RowIndexMap, b%sweepHx, shiftHx, shiftEy, shiftEz, 'k', 'j') + call AddMagneticFieldIndices(RowIndexMap, b%sweepHy, shiftHy, shiftEx, shiftEz, 'k', 'i') + call AddMagneticFieldIndices(RowIndexMap, b%sweepHz, shiftHz, shiftEx, shiftEy, 'j', 'i') + + ! And also, it seems to be boundary conditions for the magnetic fields, so we need to add them as well end subroutine \ No newline at end of file From af86213564cf97610e0ca1447b4cdbeb9f4ee7dc Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Wed, 9 Jul 2025 11:49:37 +0200 Subject: [PATCH 25/56] Update comment to clarify handling of Hz in Back PMC condition --- src_main_pub/bordersother.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From d3e243a0ebfb92ae82ecbe00399757065763c686 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Wed, 9 Jul 2025 13:15:37 +0200 Subject: [PATCH 26/56] [WIP] finished solver_run in timestepping. Missing solver_end --- src_main_pub/fdetypes.F90 | 12 +- src_main_pub/launcher.F90 | 2 +- src_main_pub/semba_fdtd.F90 | 8 +- src_main_pub/timestepping.F90 | 3978 +++++++++++++++--------------- test/system/test_init_solver.F90 | 6 +- 5 files changed, 2016 insertions(+), 1990 deletions(-) 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/launcher.F90 b/src_main_pub/launcher.F90 index 99d431df..f9db8581 100644 --- a/src_main_pub/launcher.F90 +++ b/src_main_pub/launcher.F90 @@ -6,7 +6,7 @@ program SEMBA_FDTD_launcher call semba%init() call semba%launch() - call semba%end() + ! 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 d35fca4b..14cb8324 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -970,17 +970,17 @@ subroutine semba_launch(this) #endif this%finishedwithsuccess=.false. - call solver%init_control(this%l) + call solver%init_control(this%l,this%maxSourceValue, this%time_desdelanzamiento) if ((this%l%finaltimestep >= 0).and.(.not.this%l%skindepthpre)) then #ifdef CompileWithMTLN 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%time_desdelanzamiento, this%maxSourceValue, this%l%EpsMuTimeScale_input_parameters, this%mtln_parsed) + this%l%EpsMuTimeScale_input_parameters, this%mtln_parsed) #else 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%time_desdelanzamiento, this%maxSourceValue, this%l%EpsMuTimeScale_input_parameters) + this%SINPML_fullsize,this%fullsize,this%finishedwithsuccess,this%eps0,this%mu0,this%tagtype,& + this%l%EpsMuTimeScale_input_parameters) #endif deallocate (this%sggMiEx, this%sggMiEy, this%sggMiEz,this%sggMiHx, this%sggMiHy, this%sggMiHz,this%sggMiNo,this%sggMtag) else diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 3816996c..0f870e01 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -93,13 +93,16 @@ module Solver_mod 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_tiempo) :: lastexecutedtime + 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) :: lastexecutedtime ! integer(kind=integersizeofmediamatrices), dimension(:,:,:) :: sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz + real (kind=RKIND) :: maxSourceValue + + integer (kind=4) :: initialtimestep, lastexecutedtimestep, ini_save, n_info, n - integer (kind=4) :: initialtimestep, lastexecutedtimestep type(bounds_t) :: bounds logical :: parar @@ -110,10 +113,10 @@ module Solver_mod contains procedure :: init => solver_init - ! procedure :: run => solver_run + procedure :: run => solver_run ! procedure :: end => solver_end procedure :: init_control => solver_init_control - procedure :: allocate_fields + procedure :: init_fields procedure :: init_distances procedure :: launch_simulation #ifdef CompileWithMTLN @@ -130,9 +133,16 @@ module Solver_mod contains - subroutine solver_init_control(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 @@ -175,11 +185,9 @@ subroutine solver_init_control(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 @@ -209,6 +217,10 @@ subroutine solver_init_control(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 @@ -227,7 +239,7 @@ subroutine launch_mtln_simulation(this, mtln_parsed, nEntradaRoot, layoutnumber) end subroutine #endif - subroutine allocate_fields(this, sgg) + subroutine init_fields(this, sgg) class(solver_t) :: this type (sggfdtdinfo), intent(in) :: sgg allocate ( & @@ -237,6 +249,7 @@ subroutine allocate_fields(this, sgg) 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) @@ -363,16 +376,22 @@ subroutine solver_init(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sgg call findbounds(sgg,this%bounds) 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 - call this%allocate_fields(sgg) + 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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -497,55 +516,55 @@ subroutine solver_init(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sgg call initializeNodalSources() call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, this%bounds, tag_numbers) -! call initializeObservation() + 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 initializeMPI() -! #endif + !!!!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 initializeMPI() +#endif -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif -! if (this%control%resume) close (14) -! ! -! n=this%initialtimestep -! ini_save = this%initialtimestep -! n_info = 5 + this%initialtimestep + if (this%control%resume) close (14) + ! + this%n=this%initialtimestep + this%ini_save = this%initialtimestep + this%n_info = 5 + this%initialtimestep -! write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) -! call InitTiming(sgg, this%control, time_desdelanzamiento, this%initialtimestep,maxSourceValue) + write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) + call InitTiming(sgg, this%control, this%control%time_desdelanzamiento, this%initialtimestep, this%control%maxSourceValue) -! 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 + 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 -! 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 -! #ifdef CompileWithMPI -! call flushMPIdata() -! #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 +#ifdef CompileWithMPI + call flushMPIdata() +#endif -! !!!no se si el orden wires - sgbcs del sync importa 150519 -! #ifdef CompileWithMPI -! #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 +!!!no se si el orden wires - sgbcs del sync importa 150519 +#ifdef CompileWithMPI +#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 -! call printSimulationStart() + call printSimulationStart() -! 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 + ! 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 contains @@ -1395,173 +1414,174 @@ subroutine initializeNodalSources() end subroutine initializeNodalSources -! subroutine initializeObservation() -! character(len=bufsize) :: dubuf -! logical :: l_auxinput, l_auxoutput -! #ifdef CompileWithMPI -! integer(kind=4) :: ierr -! #endif + subroutine initializeObservation() + character(len=bufsize) :: dubuf + logical :: l_auxinput, l_auxoutput +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#endif -! #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,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,b) -! l_auxinput=this%thereAre%Observation.or.this%thereAre%FarFields -! l_auxoutput=l_auxinput +#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,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_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 -! end subroutine initializeObservation +#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 + end subroutine initializeObservation -! subroutine initializeMPI() -! character(len=bufsize) :: dubuf -! integer(kind=4) :: ierr -! 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) -! call InitExtraFlushMPI(this %control%layoutnumber,sgg%sweep,sgg%alloc,sgg%med,sgg%nummedia,sggmiEz,sggMiHz) -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! call FlushMPI_H(sgg%alloc,this%control%layoutnumber,this%control%size, sggmiHx,sggmiHy,sggmiHz) -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! 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 + subroutine initializeMPI() + character(len=bufsize) :: dubuf + integer(kind=4) :: ierr + 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) + call InitExtraFlushMPI(this %control%layoutnumber,sgg%sweep,sgg%alloc,sgg%med,sgg%nummedia,sggmiEz,sggMiHz) + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_H(sgg%alloc,this%control%layoutnumber,this%control%size, sggmiHx,sggmiHy,sggmiHz) + call MPI_Barrier(SUBCOMM_MPI,ierr) + 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 -! !!!!!!!!!!!!!!!!!!!!!fin juego con fuego 210815 +!!!!!!!!!!!!!!!!!!!!!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 + !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) -! 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) + 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 + !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 +#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 - -! 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 -! #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 initializeMPI -! #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 -! end subroutine flushMPIdata + 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 +#ifdef CompileWithStochastic + if (this%control%stochastic) then + call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) + endif +#endif + endif -! subroutine printSimulationStart() -! character(len=bufsize) :: dubuf -! TYPE (tiempo_t) :: time_out2 -! #ifdef CompileWithMPI -! integer (kind=4) :: ierr -! #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) + endif +#endif + end subroutine flushMPIdata + + subroutine printSimulationStart() + character(len=bufsize) :: dubuf + TYPE (tiempo_t) :: time_out2 +#ifdef CompileWithMPI + integer (kind=4) :: ierr +#endif + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + 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 + 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 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! 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) -! #ifdef CompileWithMPI -! 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 -! end subroutine printSimulationStart subroutine fillMtag(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) !------------------------> @@ -1657,1935 +1677,1939 @@ end subroutine fillMtag end subroutine solver_init -! subroutine solver_run(this) -! class(solver_t) :: this -! #ifdef CompileWithProfiling -! call nvtxStartRange("Antes del bucle N") -! #endif + subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, sinPML_fullsize, fullsize, tag_numbers, tagtype) + class(solver_t) :: this + type(sggfdtdinfo), intent(in) :: 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), 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 :: still_planewave_time, call_timing, l_aux, everflushed, 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 CompileWithProfiling + call nvtxStartRange("Antes del bucle N") +#endif ! !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 + still_planewave_time=.true. !inicializacion de la variable + everflushed = .false. + 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 -! ciclo_temporal : DO while (N <= this%control%finaltimestep) + g1 => this%g1 + g2 => this%g2 + gm1 => this%gm1 + gm2 => this%gm2 + + ciclo_temporal : DO while (this%n <= this%control%finaltimestep) -! call step() -! call updateAndFlush() + call step() + call updateAndFlush() -! 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(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 -! !!! -! 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,this%initialtimestep, & -! this%control%finaltimestep,this%perform,this%parar,.FALSE., & -! Ex,Ey,Ez,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) + 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,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 +!!!!!!!!!!!! + 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, 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 + 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,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. + + 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 -! 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 -! !!!!!!!!!!!! -! 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=',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) -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,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 (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= ',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) -! #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 (this%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) -! #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= ',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) -! #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= ',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 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 - -! #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 .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) + call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) + somethingdone=newsomethingdone +#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 (this%performflushDATA.or.... -! ! +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif + 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= ',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%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 + 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(n)>=EpsMuTimeScale_input_parameters%tini).and.& -! &(sgg%tiempo(n)<=EpsMuTimeScale_input_parameters%tend)) then -! #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 & -! #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 -! n=n+1 !sube de iteracion -! end do ciclo_temporal ! End of the time-stepping loop + 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 + 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,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 -! end subroutine +contains -! subroutine solver_end(this) -! class(solver_t) :: this -! #ifdef CompileWithMPI -! integer (kind=4) :: ndummy, ierr -! #endif - + subroutine step() + logical :: planewave_switched_off = .false., thereareplanewave +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#endif -! #ifdef CompileWithProfiling -! call nvtxEndRange -! #endif - -! #ifdef CompileWithConformal -! if(input_conformal_flag)then -! call conformal_final_simulation (conf_timeSteps, n) -! endif -! #endif + call flushPlanewaveOff(planewave_switched_off, 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(this%control%input_conformal_flag) call conformal_advance_E() +#endif + call advanceWires() + call advancePMLE() -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! if (n>this%control%finaltimestep) n=this%control%finaltimestep !readjust n since after finishing it is increased -! this%control%finaltimestep=n -! this%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,this%initialtimestep, & -! this%control%finaltimestep,this%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) +#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) -! write(dubuf,*)'END FDTD time stepping. Beginning posprocessing at n= ',n -! call print11(this%control%layoutnumber,dubuf) + 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.still_planewave_time) then + if(.not.this%control%simu_devia) call AdvancePlaneWaveE(sgg,this%n, this%bounds,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,still_planewave_time) + end if + If (this%thereAre%NodalE) call AdvanceNodalE(sgg,sggMiEx,sggMiEy,sggMiEz,sgg%NumMedia,this%n, this%bounds,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,this%control%simu_devia) -! if ((this%control%flushsecondsFields/=0).or.this%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,this%initialtimestep,this%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 -! #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) +#ifdef CompileWithMPI + if (this%control%size>1) then + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_E_Cray + endif +#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, sggMiHx, sggMiHy, 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,sggMiHx,sggMiHy,sggMiHz,gm2,sgg%nummedia,this%control%conformalskin) +#endif + If (this%thereAre%PlaneWaveBoxes.and.still_planewave_time) then + if (.not.this%control%simu_devia) call AdvancePlaneWaveH(sgg,this%n, this%bounds, GM2, Idxe,Idye, Idze, Hx, Hy, Hz,still_planewave_time) + endif + If (this%thereAre%NodalH) call AdvanceNodalH(sgg,sggMiHx,sggMiHy,sggMiHz,sgg%NumMedia,this%n, this%bounds,GM2,Idxe,Idye,Idze,Hx,Hy,Hz,this%control%simu_devia) -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif + 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) -! 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 -! #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. +#ifdef CompileWithConformal + if(this%control%input_conformal_flag) call conformal_advance_H() +#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) +#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%control%size>1).and.(this%thereAre%wires)) call FlushWiresMPI_Berenger(this%control%layoutnumber,this%control%size) + endif +#endif +#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 -! 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 +!!!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 -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! call Timing(sgg,b, 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,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. +#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,sggMiHx, sggMiHy, 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 +#endif + endif + end subroutine step -! return + 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 -! end subroutine + subroutine updateAndFlush() + integer(kind=4) :: mindum + IF (this%thereAre%Observation) then + call UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,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 -#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) + subroutine singleUnpack() + character (LEN=BUFSIZE) :: dubuf + logical :: somethingdone + real (kind=rkind_tiempo) :: at +#ifdef CompileWithMPI + integer(kind=4) :: ierr #endif - !!! - class(solver_t) :: this -#ifdef CompileWithMTLN - type (mtln_t) :: mtln_parsed + 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 - logical :: dummylog - type (tagtype_t) :: tagtype + subroutine advanceE() +#ifdef CompileWithProfiling + call nvtxStartRange("Antes del bucle EX") +#endif + call Advance_Ex (Ex, Hy, Hz, Idyh, Idzh, sggMiEx, this%bounds,g1,g2) +#ifdef CompileWithProfiling + call nvtxEndRange - !!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 + call nvtxStartRange("Antes del bucle EY") +#endif + call Advance_Ey (Ey, Hz, Hx, Idzh, Idxh, sggMiEy, this%bounds,g1,g2) + +#ifdef CompileWithProfiling + call nvtxEndRange - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !! SIMULATION VARIABLES - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real (kind=rkind) :: maxSourceValue - REAL (kind=8) :: time_desdelanzamiento - type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters + call nvtxStartRange("Antes del bucle EZ") +#endif + call Advance_Ez (Ez, Hx, Hy, Idxh, Idyh, sggMiEz, this%bounds,g1,g2) +#ifdef CompileWithProfiling + call nvtxEndRange +#endif + end subroutine - REAL (KIND=RKIND), intent(inout) :: eps0,mu0 - - type (SGGFDTDINFO), intent(INOUT) :: sgg - 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 - 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), & - 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) - 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) :: Sigma,Epsilon,Mu - REAL (KIND=RKIND_tiempo) :: at,rdummydt - logical :: somethingdone,newsomethingdone,call_timing,l_auxoutput,l_auxinput - character(len=BUFSIZE) :: buff - ! - !!!!!!!PML params!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - logical :: finishedwithsuccess - !!!!!!! - !Input - type (bounds_t) :: b + subroutine Advance_Ex(Ex,Hy,Hz,Idyh,Idzh,sggMiEx,b,g1,g2) - type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize - ! - character (LEN=BUFSIZE) :: dubuf - integer (kind=4) :: ini_save - !Generic - type (Logic_control) :: thereare + !------------------------> + 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 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) +#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) + End do + End do + End do +#ifdef CompileWithOpenMP +!$OMP END PARALLEL DO +#endif + return + end subroutine Advance_Ex - Logical :: flushFF, & - everflushed,still_planewave_time,thereareplanewave,l_aux - - integer (kind=4) :: i,J,K,r,n,n_info,FIELD - ! - ! - real (kind=RKIND) :: pscale_alpha - integer :: rank - !******************************************************************************* - !******************************************************************************* - !******************************************************************************* + subroutine Advance_Ey(Ey,Hz,Hx,Idzh,Idxh,sggMiEy,b,g1,g2) -#ifdef CompileWithMTLN - this%mtln_parsed = mtln_parsed + !------------------------> + 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 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) +#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)) + End do + End do + End do +#ifdef CompileWithOpenMP +!$OMP END PARALLEL DO #endif - call this%init(sgg,eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, SINPML_fullsize, fullsize, tag_numbers) - ! call this%solver_run() - ! call this%solver_end() - -! planewave_switched_off=.false. -! this%control%fatalerror=.false. -! parar=.false. -! call perform%reset() -! call d_perform%reset() -! flushFF=.false. -! everflushed=.false. -! call this%thereAre%reset() -! this%thereAre%MagneticMedia = sgg%thereareMagneticMedia -! this%thereAre%PMLMagneticMedia = sgg%therearePMLMagneticMedia - -! !prechecking of no offsetting to prevent errors in case of modifications -! I=sgg%Alloc(iEx)%XI -! J=sgg%Alloc(iEx)%YI -! K=sgg%Alloc(iEx)%ZI -! do field=iEy,6 -! if (sgg%Alloc(field)%XI /= I) call stoponerror(this%control%layoutnumber,this%control%size,'OFFSETS IN INITIAL COORD NOT ALLOWED') -! 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,b) + return + end subroutine Advance_Ey + subroutine Advance_Ez(Ez,Hx,Hy,Idxh,Idyh,sggMiEz,b,g1,g2) -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!! 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 + !------------------------> + 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) +#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) +#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 +#endif + return + end subroutine Advance_Ez -! 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) + subroutine advanceH() +#ifdef CompileWithProfiling + call nvtxStartRange("Antes del bucle HX") +#endif + call Advance_Hx (Hx, Ey, Ez, Idye, Idze, sggMiHx, this%bounds,gm1,gm2) +#ifdef CompileWithProfiling + call nvtxEndRange + call nvtxStartRange("Antes del bucle HY") +#endif + call Advance_Hy (Hy, Ez, Ex, Idze, Idxe, sggMiHy, this%bounds,gm1,gm2) +#ifdef CompileWithProfiling + call nvtxEndRange + call nvtxStartRange("Antes del bucle HZ") +#endif + call Advance_Hz (Hz, Ex, Ey, Idxe, Idye, 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) -! !original -! do i=sgg%ALLOC(iHx)%XI,sgg%ALLOC(iHx)%XE -! dxe(i)=sgg%DX(i) -! end do + !------------------------> + 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 Advance_Hx -! do J=sgg%ALLOC(iHy)%YI,sgg%ALLOC(iHy)%YE -! dye(J)=sgg%DY(J) -! end do + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine Advance_Hy(Hy,Ez,Ex,IdzE,IdxE,sggMiHy,b,gm1,gm2) -! do K=sgg%ALLOC(iHz)%ZI,sgg%ALLOC(iHz)%ZE -! dze(K)=sgg%DZ(K) -! end do + !------------------------> + 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 -! 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 + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine Advance_Hz(Hz,Ex,Ey,IdxE,IdyE,sggMiHz,b,gm1,gm2) -! !!!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; + !------------------------> + 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 -! !!!lo cambio aqui permit scaling a 211118 por problemas con resuming: debe leer el eps0, mu0, antes de hacer numeros + end subroutine advanceWires -! allocate (G1(0 : sgg%NumMedia),G2(0 : sgg%NumMedia),GM1(0 : sgg%NumMedia),GM2(0 : sgg%NumMedia)) -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!! 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 +! !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,sggMiEx,sggMiEy,sggMiEz,G2,Ex,Ey,Ez,Hx,Hy,Hz) + endif + end subroutine -! call this%allocate_fields(sgg) -! Ex => this%Ex -! Ey => this%Ey -! Ez => this%Ez -! Hx => this%Hx -! Hy => this%Hy -! Hz => this%Hz -! ! 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)) -! !!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!! Init the local variables and observation stuff needed by each module, taking into account resume status -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! 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 -! this%initialtimestep=0 !vamos a empezar en 0 para escribir el tiempo 0 !sgg sept'16 !? -! tiempoinicial = 0.0_RKIND_tiempo -! 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,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 -! rdummy=sgg%dt -! call MPIupdateMin(real(sgg%dt,RKIND),rdummy) -! rdummy=eps0 -! call MPIupdateMin(eps0,rdummy) -! rdummy=mu0 -! call MPIupdateMin(mu0,rdummy) +! !!!!!!!!!sgg 051214 fill in the magnetic walls after the wireframe info + + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! subroutine XXXXfillMagnetic(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz, b) + +! !------------------------> +! 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 +! #ifdef CompileWithOpenMP +! !$OMP END PARALLEL DO +! !$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) +! #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) +! #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 +! End do +! 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 +! #ifdef CompileWithOpenMP +! !$OMP END PARALLEL DO +! !$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) +! #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) +! #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 +! End do +! End do +! #ifdef CompileWithOpenMP +! !$OMP END PARALLEL DO ! #endif -! #ifdef CompileWithMPI -! 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,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 ) -! return -! else -! write(dubuf,*) 'Incoherence between MPI saved steps for resuming. Retrying with -old....' -! call print11(this%control%layoutnumber,dubuf) -! this%control%resume_fromold=.true. -! close (14) -! open (14,file=trim(adjustl(this%control%nresumeable2))//'.old',form='unformatted') -! 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( 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=',this%lastexecutedtimestep -! call print11(this%control%layoutnumber,dubuf) -! endif -! endif -! #else -! close (14) +! return +! end subroutine XXXXfillMagnetic -! 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 -! this%initialtimestep=this%lastexecutedtimestep+1 -! tiempoinicial = this%lastexecutedtime -! write(dubuf,*) '[OK] processing resuming data. Last executed time step ',this%lastexecutedtimestep -! call print11(this%control%layoutnumber,dubuf) -! endif -! 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,this%lastexecutedtimestep,this%control%finaltimestep,this%lastexecutedtime) -! !!!!!!!!!!!!!!!!!!!!! -! !fin lo cambio aqui + end subroutine solver_run -! call updateSigmaM(attinformado) -! call updateThinWiresSigma(attinformado) -! call calc_G1G2Gm1Gm2(sgg,G1,G2,Gm1,Gm2,eps0,mu0) -! call revertThinWiresSigma() - -! ! +! subroutine solver_end(this) +! class(solver_t) :: this ! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) +! integer (kind=4) :: ndummy, ierr ! #endif -! write(dubuf,*) 'Init Reporting...'; call print11(this%control%layoutnumber,dubuf) -! call InitReporting(sgg,this%control) -! call reportSimulationOptions() + -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) + +! #ifdef CompileWithProfiling +! call nvtxEndRange +! #endif + +! #ifdef CompileWithConformal +! if(input_conformal_flag)then +! call conformal_final_simulation (conf_timeSteps, n) +! endif ! #endif -! write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) -! !!!OJO SI SE CAMBIA EL ORDEN DE ESTAS INICIALIZACIONES HAY QUE CAMBIAR EL ORDEN DE STOREADO EN EL RESUMING + ! #ifdef CompileWithMPI ! call MPI_Barrier(SUBCOMM_MPI,ierr) ! #endif +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! if (n>this%control%finaltimestep) n=this%control%finaltimestep !readjust n since after finishing it is increased +! this%control%finaltimestep=n +! this%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,this%initialtimestep, & +! this%control%finaltimestep,this%d_perform,dummylog,.FALSE., & +! Ex,Ey,Ez,everflushed,this%control%nentradaroot,this%control%maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) -! 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, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, tag_numbers) -! call initializeObservation() +! write(dubuf,*)'END FDTD time stepping. Beginning posprocessing at n= ',n +! call print11(this%control%layoutnumber,dubuf) -! !!!!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 initializeMPI() +! if ((this%control%flushsecondsFields/=0).or.this%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,this%initialtimestep,this%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 ! #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) + ! #ifdef CompileWithMPI ! call MPI_Barrier(SUBCOMM_MPI,ierr) ! #endif -! if (this%control%resume) close (14) -! ! -! n=this%initialtimestep -! ini_save = this%initialtimestep -! n_info = 5 + this%initialtimestep - -! write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) -! call InitTiming(sgg, this%control, time_desdelanzamiento, this%initialtimestep,maxSourceValue) - +! 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 +! #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. -! 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 +! 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) -! 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 ! #ifdef CompileWithMPI -! call flushMPIdata() +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! call MPI_AllReduce( somethingdone, newsomethingdone, 1_4, MPI_LOGICAL, MPI_LOR, SUBCOMM_MPI, ierr) +! somethingdone=newsomethingdone ! #endif - -! !!!no se si el orden wires - sgbcs del sync importa 150519 +! 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 -! #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) +! 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 -! #endif -! #endif - -! call printSimulationStart() - -! 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 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! logical flushFF = .false., everFlushed = .false. -! #ifdef CompileWithProfiling -! call nvtxStartRange("Antes del bucle N") -! #endif -! !240424 sgg creo el comunicador mpi de las sondas conformal aqui. debe irse con el nuevo conformal -! #ifdef CompileWithConformal ! #ifdef CompileWithMPI -! call initMPIConformalProbes() -! #endif +! call MPI_Barrier(SUBCOMM_MPI,ierr) ! #endif +! call Timing(sgg,b, 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,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= ',n +! call print11(this%control%layoutnumber,dubuf) +! finishedwithsuccess=.true. +! return -! ciclo_temporal : DO while (N <= this%control%finaltimestep) - -! call step() -! call updateAndFlush() +! end subroutine -! 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,this%initialtimestep, & -! this%control%finaltimestep,this%perform,parar,.FALSE., & -! Ex,Ey,Ez,everflushed,this%control%nentradaroot,maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) +#ifdef CompileWithMTLN + subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & + SINPML_Fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & + 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, & + EpsMuTimeScale_input_parameters) +#endif + !!! + class(solver_t) :: this +#ifdef CompileWithMTLN + type (mtln_t) :: mtln_parsed +#endif -! 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 -! 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 -! !!!!!!!!!!!! -! 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=',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) -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,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 (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= ',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) -! #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 (this%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) -! #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= ',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) -! #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= ',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 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 + logical :: dummylog + type (tagtype_t) :: tagtype -! #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 .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 + !!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 -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! endif !del if (this%performflushDATA.or.... -! ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !! SIMULATION VARIABLES + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters + REAL (KIND=RKIND), intent(inout) :: eps0,mu0 + + type (SGGFDTDINFO), intent(INOUT) :: sgg + 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 + 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), & + 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) + 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) :: Sigma,Epsilon,Mu + REAL (KIND=RKIND_tiempo) :: at,rdummydt + logical :: somethingdone,newsomethingdone,l_auxoutput,l_auxinput + character(len=BUFSIZE) :: buff + ! + !!!!!!!PML params!!!!!!!!!!!!!!!!!!!!!!!!!!!! + real (kind=RKIND) :: maxSourceValue -! 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= ',n -! call print11(this%control%layoutnumber,SEPARADOR//separador//separador) -! call print11(this%control%layoutnumber,dubuf) -! call print11(this%control%layoutnumber,SEPARADOR//separador//separador) -! endif + logical :: finishedwithsuccess + !!!!!!! + !Input + type (bounds_t) :: b -! 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 -! #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 & -! #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 -! n=n+1 !sube de iteracion -! end do ciclo_temporal ! End of the time-stepping loop - - - -! #ifdef CompileWithProfiling -! call nvtxEndRange -! #endif + type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize + ! + character (LEN=BUFSIZE) :: dubuf + integer (kind=4) :: ini_save + !Generic + type (Logic_control) :: thereare -! #ifdef CompileWithConformal -! if(input_conformal_flag)then -! call conformal_final_simulation (conf_timeSteps, n) -! endif -! #endif + Logical :: still_planewave_time,thereareplanewave -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! if (n>this%control%finaltimestep) n=this%control%finaltimestep !readjust n since after finishing it is increased -! this%control%finaltimestep=n -! this%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,this%initialtimestep, & -! this%control%finaltimestep,this%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) + integer (kind=4) :: i,J,K,r,n,n_info,FIELD + ! + ! + ! real (kind=RKIND) :: pscale_alpha + integer :: rank + !******************************************************************************* + !******************************************************************************* + !******************************************************************************* -! write(dubuf,*)'END FDTD time stepping. Beginning posprocessing at n= ',n -! call print11(this%control%layoutnumber,dubuf) +#ifdef CompileWithMTLN + this%mtln_parsed = mtln_parsed +#endif -! if ((this%control%flushsecondsFields/=0).or.this%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,this%initialtimestep,this%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 -! #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) + ! 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 + ! call this%init_fields(sgg) + ! Ex => this%Ex; Ey => this%Ey; Ez => this%Ez; Hx => this%Hx; Hy => this%Hy; Hz => this%Hz -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif + 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, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, SINPML_fullsize, fullsize, tag_numbers, tagtype) + ! call this%solver_end() -! 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 -! #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. +! planewave_switched_off=.false. +! this%control%fatalerror=.false. +! parar=.false. +! call perform%reset() +! call d_perform%reset() +! flushFF=.false. +! everflushed=.false. +! call this%thereAre%reset() +! this%thereAre%MagneticMedia = sgg%thereareMagneticMedia +! this%thereAre%PMLMagneticMedia = sgg%therearePMLMagneticMedia -! 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) +! !prechecking of no offsetting to prevent errors in case of modifications +! I=sgg%Alloc(iEx)%XI +! J=sgg%Alloc(iEx)%YI +! K=sgg%Alloc(iEx)%ZI +! do field=iEy,6 +! if (sgg%Alloc(field)%XI /= I) call stoponerror(this%control%layoutnumber,this%control%size,'OFFSETS IN INITIAL COORD NOT ALLOWED') +! 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 -! #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 +! write(whoami,'(a,i5,a,i5,a)') '(',this%control%layoutnumber+1,'/',this%control%size,') ' -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! call Timing(sgg,b, n,ndummy,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,this%initialtimestep, & -! this%control%finaltimestep,this%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 ) +! !file names +! write(chari,*) this%control%layoutnumber+1 ! ! -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! !----------------------------------------------------> - contains +! !!!!!!!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,b) - 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 - 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) - 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) - endif - endif - end subroutine +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!! 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 - subroutine step() - logical :: planewave_switched_off = .false. -#ifdef CompileWithMPI - integer(kind=4) :: ierr -#endif +! 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) - call flushPlanewaveOff(planewave_switched_off, 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 - call advanceConformalE() -#endif - 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)) then - call AdvancesgbcE(real(sgg%dt,RKIND),this%control%sgbcDispersive,this%control%simu_devia,this%control%stochastic) - endif - if (this%thereAre%Lumpeds) call AdvanceLumpedE(sgg,n,this%control%simu_devia,this%control%stochastic) - IF (this%thereAre%Edispersives) call AdvanceEDispersiveE(sgg) - 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 - If (this%thereAre%NodalE) then - call AdvanceNodalE(sgg,sggMiEx,sggMiEy,sggMiEz,sgg%NumMedia,n, b,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,this%control%simu_devia) - endif +! !original +! do i=sgg%ALLOC(iHx)%XI,sgg%ALLOC(iHx)%XE +! dxe(i)=sgg%DX(i) +! end do -#ifdef CompileWithMPI - if (this%control%size>1) then - call MPI_Barrier(SUBCOMM_MPI,ierr) - call FlushMPI_E_Cray - endif -#endif - IF (this%thereAre%Anisotropic) call AdvanceAnisotropicH(sgg%alloc,ex,ey,ez,hx,hy,hz,Idxe,Idye,Idze,Idxh,Idyh,Idzh) -#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") -#endif - call Advance_Hz (Hz, Ex, Ey, Idxe, Idye, sggMiHz, b,gm1,gm2) -#ifdef CompileWithProfiling - call nvtxEndRange -#endif - - If (this%thereAre%PMLbodies) then !waveport absorbers - call AdvancePMLbodyH - endif - If (this%thereAre%PMLBorders) then - call AdvanceMagneticCPML ( sgg%NumMedia, b, sggMiHx, sggMiHy, sggMiHz, gm2, Hx, Hy, Hz, Ex, Ey, Ez) - endif - - If (this%thereAre%PMCBorders) then - call MinusCloneMagneticPMC(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) - endif - If (this%thereAre%PeriodicBorders) then - call CloneMagneticPeriodic(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) - endif - IF (this%thereAre%sgbcs.and.(this%control%sgbc)) then - call AdvancesgbcH() - endif - 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,sggMiHx,sggMiHy,sggMiHz,gm2,sgg%nummedia,this%control%conformalskin) -#endif - 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 - If (this%thereAre%NodalH) then - call AdvanceNodalH(sgg,sggMiHx,sggMiHy,sggMiHz,sgg%NumMedia,n, b ,GM2,Idxe,Idye,Idze,Hx,Hy,Hz,this%control%simu_devia) - endif +! do J=sgg%ALLOC(iHy)%YI,sgg%ALLOC(iHy)%YE +! dye(J)=sgg%DY(J) +! end do - 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 - 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) then - call CloneMagneticPeriodic(sgg%alloc,sgg%Border,Hx,Hy,Hz,sgg%sweep,this%control%layoutnumber,this%control%size) - endif +! do K=sgg%ALLOC(iHz)%ZI,sgg%ALLOC(iHz)%ZE +! dze(K)=sgg%DZ(K) +! end do -#ifdef CompileWithConformal - if(input_conformal_flag)then - call conformal_advance_H() - endif -#endif +! 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 -#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 -#ifdef CompileWithStochastic - if (this%control%stochastic) then - call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) - endif -#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) - endif -#endif -#endif +! !!!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; -!!!no se si el orden wires - sgbcs del sync importa 150519 -#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 -#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%thereAre%MURBorders) then - call AdvanceMagneticMUR (b, sgg,sggMiHx, sggMiHy, 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 -#endif - ENDIF +! !!!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)) +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!! 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 - end subroutine step +! call this%init_fields(sgg) +! Ex => this%Ex +! Ey => this%Ey +! Ez => this%Ez +! Hx => this%Hx +! Hy => this%Hy +! Hz => this%Hz +! ! 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)) - subroutine updateAndFlush() - integer(kind=4) :: mindum - IF (this%thereAre%Observation) then - 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) - 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 - endif - endif - end subroutine +! !!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!! Init the local variables and observation stuff needed by each module, taking into account resume status +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine singleUnpack() - character (LEN=BUFSIZE) :: dubuf -#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= ',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=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) +! 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 +! this%initialtimestep=0 !vamos a empezar en 0 para escribir el tiempo 0 !sgg sept'16 !? +! tiempoinicial = 0.0_RKIND_tiempo +! 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,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 +! rdummy=sgg%dt +! call MPIupdateMin(real(sgg%dt,RKIND),rdummy) +! rdummy=eps0 +! call MPIupdateMin(eps0,rdummy) +! rdummy=mu0 +! call MPIupdateMin(mu0,rdummy) +! #endif +! #ifdef CompileWithMPI +! 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,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 ) +! return +! else +! write(dubuf,*) 'Incoherence between MPI saved steps for resuming. Retrying with -old....' +! call print11(this%control%layoutnumber,dubuf) +! this%control%resume_fromold=.true. +! close (14) +! open (14,file=trim(adjustl(this%control%nresumeable2))//'.old',form='unformatted') +! 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( 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=',this%lastexecutedtimestep +! call print11(this%control%layoutnumber,dubuf) +! endif +! endif +! #else +! close (14) - end subroutine +! 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 +! this%initialtimestep=this%lastexecutedtimestep+1 +! tiempoinicial = this%lastexecutedtime +! write(dubuf,*) '[OK] processing resuming data. Last executed time step ',this%lastexecutedtimestep +! call print11(this%control%layoutnumber,dubuf) +! endif +! 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,this%lastexecutedtimestep,this%control%finaltimestep,this%lastexecutedtime) +! !!!!!!!!!!!!!!!!!!!!! - subroutine advanceE() -#ifdef CompileWithProfiling - call nvtxStartRange("Antes del bucle EX") -#endif - call Advance_Ex (Ex, Hy, Hz, Idyh, Idzh, sggMiEx, b,g1,g2) -#ifdef CompileWithProfiling - call nvtxEndRange +! !fin lo cambio aqui - call nvtxStartRange("Antes del bucle EY") -#endif - call Advance_Ey (Ey, Hz, Hx, Idzh, Idxh, sggMiEy, b,g1,g2) - -#ifdef CompileWithProfiling - call nvtxEndRange - - call nvtxStartRange("Antes del bucle EZ") -#endif - call Advance_Ez (Ez, Hx, Hy, Idxh, Idyh, sggMiEz, b,g1,g2) -#ifdef CompileWithProfiling - call nvtxEndRange -#endif - end subroutine +! call updateSigmaM(attinformado) +! call updateThinWiresSigma(attinformado) +! call calc_G1G2Gm1Gm2(sgg,G1,G2,Gm1,Gm2,eps0,mu0) +! call revertThinWiresSigma() + +! ! +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! write(dubuf,*) 'Init Reporting...'; call print11(this%control%layoutnumber,dubuf) +! call InitReporting(sgg,this%control) +! call reportSimulationOptions() - subroutine Advance_Ex(Ex,Hy,Hz,Idyh,Idzh,sggMiEx,b,g1,g2) +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) +! !!!OJO SI SE CAMBIA EL ORDEN DE ESTAS INICIALIZACIONES HAY QUE CAMBIAR EL ORDEN DE STOREADO EN EL RESUMING +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif - !------------------------> - 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 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) -#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) - End do - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -#endif - return - end subroutine Advance_Ex +! call initializeBorders() +! call initializeLumped() +! call initializeWires() +! call initializeAnisotropic() +! call initializeSGBC() +! call initializeMultiports() +! call initializeConformalElements() - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Ey(Ey,Hz,Hx,Idzh,Idxh,sggMiEy,b,g1,g2) +! call initializeEDispersives() +! call initializeMDispersives() +! call initializePlanewave() +! call initializeNodalSources() - !------------------------> - 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 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) -#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)) - End do - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -#endif +! call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, 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 initializeMPI() +! #endif + +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! if (this%control%resume) close (14) +! ! +! n=this%initialtimestep +! ini_save = this%initialtimestep +! n_info = 5 + this%initialtimestep - return - end subroutine Advance_Ey +! write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) +! call InitTiming(sgg, this%control, this%control%time_desdelanzamiento, this%initialtimestep,this%control%maxSourceValue) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - 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 PARALLEL DO DEFAULT(SHARED) collapse (2) private (i,j,k,medio,Idyhj) -#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) -#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 -#endif - return - end subroutine Advance_Ez +! 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 - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! 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 +! #ifdef CompileWithMPI +! call flushMPIdata() +! #endif +! !!!no se si el orden wires - sgbcs del sync importa 150519 +! #ifdef CompileWithMPI +! #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 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Hx(Hx,Ey,Ez,IdyE,IdzE,sggMiHx,b,gm1,gm2) +! call printSimulationStart() + +! 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 - !------------------------> - 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 Advance_Hx + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!! TIME STEPPING + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! logical flushFF = .false., everFlushed = .false. +! #ifdef CompileWithProfiling +! call nvtxStartRange("Antes del bucle N") +! #endif +! !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 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Hy(Hy,Ez,Ex,IdzE,IdxE,sggMiHy,b,gm1,gm2) - !------------------------> - 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 +! ciclo_temporal : DO while (N <= this%control%finaltimestep) + +! call step() +! call updateAndFlush() - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Hz(Hz,Ex,Ey,IdxE,IdyE,sggMiHz,b,gm1,gm2) +! 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,this%initialtimestep, & +! this%control%finaltimestep,this%perform,parar,.FALSE., & +! Ex,Ey,Ez,everflushed,this%control%nentradaroot,this%control%maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) - !------------------------> - 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 +! 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 +! 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 +! !!!!!!!!!!!! +! 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=',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) +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,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 (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= ',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) +! #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 (this%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) +! #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= ',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) +! #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= ',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 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 + +! #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 .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 (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= ',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 +! #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 & +! #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 +! 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 +! #endif + +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! if (n>this%control%finaltimestep) n=this%control%finaltimestep !readjust n since after finishing it is increased +! this%control%finaltimestep=n +! this%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,this%initialtimestep, & +! this%control%finaltimestep,this%d_perform,dummylog,.FALSE., & +! Ex,Ey,Ez,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= ',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= ',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,this%initialtimestep,this%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 +! #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) - subroutine advanceConformalE() -#ifdef CompileWithConformal - if(input_conformal_flag)then - call conformal_advance_E() - endif -#endif - end subroutine +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,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 +! #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. - 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 -#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 - 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 +! 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 +! #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 - !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) - endif - end subroutine +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! call Timing(sgg,b, n,ndummy,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,this%initialtimestep, & +! this%control%finaltimestep,this%perform,parar,.FALSE., & +! Ex,Ey,Ez,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= ',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 ) +! ! +! #ifdef CompileWithMPI +! call MPI_Barrier(SUBCOMM_MPI,ierr) +! #endif +! !----------------------------------------------------> + contains - !!!!!!!!!sgg 051214 fill in the magnetic walls after the wireframe info + 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 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine XXXXfillMagnetic(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz, b) - !------------------------> - 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 -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) -#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) -#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 - End do - 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 -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -!$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) -#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) -#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 - End do - End do -#ifdef CompileWithOpenMP -!$OMP END PARALLEL DO -#endif - return - end subroutine XXXXfillMagnetic !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 diff --git a/test/system/test_init_solver.F90 b/test/system/test_init_solver.F90 index d4a7d32b..e14cab65 100644 --- a/test/system/test_init_solver.F90 +++ b/test/system/test_init_solver.F90 @@ -5,7 +5,7 @@ integer function test_init_solver() bind (C) result(err) type(semba_fdtd_t) :: semba character(len=*), parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'holland1981.fdtd.json' - call semba%init("-i "//filename) - call semba%launch() - call semba%end() + call semba%init() + ! call semba%launch() + ! call semba%end() end function \ No newline at end of file From 14ab48cbf9594fd6a2c9e0b9164e420373a326e3 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Wed, 9 Jul 2025 13:54:11 +0200 Subject: [PATCH 27/56] [WIP] large refactoring of timestepping --- src_main_pub/timestepping.F90 | 333 +++++++++++++++++----------------- 1 file changed, 171 insertions(+), 162 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 0f870e01..3c6e13e0 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -105,7 +105,7 @@ module Solver_mod type(bounds_t) :: bounds - logical :: parar + logical :: parar, everflushed = .false. #ifdef CompileWithMTLN type (mtln_t) :: mtln_parsed @@ -114,7 +114,7 @@ module Solver_mod contains procedure :: init => solver_init procedure :: run => solver_run - ! procedure :: end => solver_end + procedure :: end => solver_end procedure :: init_control => solver_init_control procedure :: init_fields procedure :: init_distances @@ -352,8 +352,6 @@ subroutine solver_init(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sgg this%parar=.false. call this%perform%reset() call this%d_perform%reset() - ! flushFF=.false. - ! everflushed=.false. call this%thereAre%reset() this%thereAre%MagneticMedia = sgg%thereareMagneticMedia this%thereAre%PMLMagneticMedia = sgg%therearePMLMagneticMedia @@ -1702,7 +1700,7 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM 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 :: still_planewave_time, call_timing, l_aux, everflushed, flushFF, somethingdone, newsomethingdone + logical :: still_planewave_time, call_timing, l_aux, flushFF, somethingdone, newsomethingdone integer :: i real (kind=rkind) :: pscale_alpha REAL (kind=rkind_tiempo) :: at @@ -1720,7 +1718,6 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM ! #endif ! #endif still_planewave_time=.true. !inicializacion de la variable - everflushed = .false. flushFF = .false. pscale_alpha=1.0 !se le entra con 1.0 @@ -1752,7 +1749,7 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM 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,everflushed,this%control%nentradaroot,this%control%maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) + 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 @@ -1784,7 +1781,7 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM 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, everflushed, & + 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) @@ -2604,173 +2601,186 @@ subroutine advancePMLE() end subroutine solver_run -! subroutine solver_end(this) -! class(solver_t) :: this -! #ifdef CompileWithMPI -! integer (kind=4) :: ndummy, ierr -! #endif + subroutine solver_end(this, sgg, eps0, mu0, sggMtag, tagtype, finishedwithsuccess) + class(solver_t) :: this + type(sggfdtdinfo), intent(in) :: sgg + real(kind=rkind), intent(in) :: eps0,mu0 + integer (KIND=IKINDMTAG), intent(in) :: & + 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 (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 CompileWithProfiling + call nvtxEndRange +#endif -! #ifdef CompileWithConformal -! if(input_conformal_flag)then -! call conformal_final_simulation (conf_timeSteps, n) -! endif -! #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 (n>this%control%finaltimestep) n=this%control%finaltimestep !readjust n since after finishing it is increased -! this%control%finaltimestep=n -! this%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,this%initialtimestep, & -! this%control%finaltimestep,this%d_perform,dummylog,.FALSE., & -! Ex,Ey,Ez,everflushed,this%control%nentradaroot,this%control%maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,ierr) +#endif -! write(dubuf,*)'END FDTD time stepping. Beginning posprocessing at n= ',n -! call print11(this%control%layoutnumber,dubuf) + 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) -! if ((this%control%flushsecondsFields/=0).or.this%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,this%initialtimestep,this%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 -! #endif -! endif + 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= ',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 (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 +#ifdef CompileWithMPI + call MPI_Barrier(SUBCOMM_MPI,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 -! #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,'(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 (this%thereAre%Observation) call createvtk(this%control%layoutnumber,this%control%size,sgg,this%control%vtkindex,somethingdone,this%control%mpidir,tagtype,sggMtag,this%control%dontwritevtk) + 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 -! #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 + 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. -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! call Timing(sgg,b, 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,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= ',n -! call print11(this%control%layoutnumber,dubuf) -! finishedwithsuccess=.true. + 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) -! return +#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 -! end subroutine +#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 #ifdef CompileWithMTLN subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & @@ -2863,7 +2873,7 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi 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, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, SINPML_fullsize, fullsize, tag_numbers, tagtype) - ! call this%solver_end() + call this%end(sgg, eps0, mu0, sggMtag, tagtype, finishedwithsuccess) ! planewave_switched_off=.false. ! this%control%fatalerror=.false. @@ -3459,7 +3469,6 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi ! 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 GatherMPI_MTL() ! call FlushMTLNObservationFiles(this%control%nentradaroot, mtlnProblem = .false.) ! end if ! #endif From 74d213548313368fbf955fc227bd5455c4910871 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Wed, 9 Jul 2025 15:06:44 +0200 Subject: [PATCH 28/56] Timestepping now have init run and end methods part of class. Next is making step a class method accesible from outside --- src_main_pub/launcher.F90 | 2 +- src_main_pub/semba_fdtd.F90 | 16 +- src_main_pub/timestepping.F90 | 1206 ++------------------------------- 3 files changed, 71 insertions(+), 1153 deletions(-) diff --git a/src_main_pub/launcher.F90 b/src_main_pub/launcher.F90 index f9db8581..99d431df 100644 --- a/src_main_pub/launcher.F90 +++ b/src_main_pub/launcher.F90 @@ -6,7 +6,7 @@ program SEMBA_FDTD_launcher call semba%init() call semba%launch() - ! call semba%end() + 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 14cb8324..57fc4602 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -115,6 +115,7 @@ subroutine semba_init(this, input_flags) type (conf_conflicts_t), pointer :: conf_conflicts #endif + call sleep(5) call initEntrada(this%l) newrotate=.false. !!ojo tocar luego @@ -971,17 +972,14 @@ subroutine semba_launch(this) this%finishedwithsuccess=.false. call solver%init_control(this%l,this%maxSourceValue, this%time_desdelanzamiento) - - if ((this%l%finaltimestep >= 0).and.(.not.this%l%skindepthpre)) then #ifdef CompileWithMTLN - 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%EpsMuTimeScale_input_parameters, this%mtln_parsed) -#else - 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%EpsMuTimeScale_input_parameters) + 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%EpsMuTimeScale_input_parameters) deallocate (this%sggMiEx, this%sggMiEy, this%sggMiEz,this%sggMiHx, this%sggMiHy, this%sggMiHz,this%sggMiNo,this%sggMtag) else #ifdef CompileWithMPI diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 3c6e13e0..1b69170f 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -98,7 +98,6 @@ module Solver_mod real(kind=rkind), pointer, dimension ( : ) :: g1,g2,gM1,gM2 real (kind=RKIND_tiempo) :: lastexecutedtime - ! integer(kind=integersizeofmediamatrices), dimension(:,:,:) :: sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz real (kind=RKIND) :: maxSourceValue integer (kind=4) :: initialtimestep, lastexecutedtimestep, ini_save, n_info, n @@ -124,13 +123,6 @@ module Solver_mod #endif end type -! private - -! public launch_simulation -! #ifdef CompileWithMTLN -! public launch_mtln_simulation -! #endif - contains subroutine solver_init_control(this, input, maxSourceValue, time_desdelanzamiento) @@ -171,7 +163,6 @@ subroutine solver_init_control(this, input, maxSourceValue, time_desdelanzamient 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 @@ -303,6 +294,33 @@ subroutine init_distances(this,sgg) this%Idzh=1.0_RKIND/this%dzh end subroutine + subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & + SINPML_Fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & + EpsMuTimeScale_input_parameters) + class(solver_t) :: this + type (SGGFDTDINFO), intent(INOUT) :: sgg + 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), 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), & + 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) + type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize + logical :: finishedwithsuccess + REAL (KIND=RKIND), intent(inout) :: eps0,mu0 + type (tagtype_t) :: tagtype + type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters + + 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, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, SINPML_fullsize, fullsize, tag_numbers, tagtype) + call this%end(sgg, eps0, mu0, sggMtag, tagtype, finishedwithsuccess) + 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 @@ -339,14 +357,6 @@ subroutine solver_init(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sgg 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%control%fatalerror=.false. this%parar=.false. @@ -1673,6 +1683,18 @@ subroutine fillMtag(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sgg 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 subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, sinPML_fullsize, fullsize, tag_numbers, tagtype) @@ -1711,12 +1733,12 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM #ifdef CompileWithProfiling call nvtxStartRange("Antes del bucle N") #endif -! !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 +!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 still_planewave_time=.true. !inicializacion de la variable flushFF = .false. pscale_alpha=1.0 !se le entra con 1.0 @@ -2459,145 +2481,23 @@ subroutine advancePMLE() endif end subroutine - - -! !!!!!!!!!sgg 051214 fill in the magnetic walls after the wireframe info - - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! subroutine XXXXfillMagnetic(sgg,sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz, b) - -! !------------------------> -! 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 -! #ifdef CompileWithOpenMP -! !$OMP END PARALLEL DO -! !$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) -! #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) -! #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 -! End do -! 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 -! #ifdef CompileWithOpenMP -! !$OMP END PARALLEL DO -! !$OMP PARALLEL DO DEFAULT(SHARED) private (i,j,k,medio1,medio2,medio3,medio4) -! #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) -! #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 -! End do -! End do -! #ifdef CompileWithOpenMP -! !$OMP END PARALLEL DO -! #endif -! return -! end subroutine XXXXfillMagnetic - + 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 end subroutine solver_run @@ -2609,7 +2509,7 @@ subroutine solver_end(this, sgg, eps0, mu0, sggMtag, tagtype, finishedwithsucces 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 (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 @@ -2782,867 +2682,6 @@ subroutine solver_end(this, sgg, eps0, mu0, sggMtag, tagtype, finishedwithsucces end subroutine -#ifdef CompileWithMTLN - subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & - SINPML_Fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & - 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, & - EpsMuTimeScale_input_parameters) -#endif - !!! - class(solver_t) :: this -#ifdef CompileWithMTLN - type (mtln_t) :: mtln_parsed -#endif - - - logical :: dummylog - type (tagtype_t) :: tagtype - - !!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 - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !! SIMULATION VARIABLES - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters - - REAL (KIND=RKIND), intent(inout) :: eps0,mu0 - - type (SGGFDTDINFO), intent(INOUT) :: sgg - 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 - 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), & - 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) - 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) :: Sigma,Epsilon,Mu - REAL (KIND=RKIND_tiempo) :: at,rdummydt - logical :: somethingdone,newsomethingdone,l_auxoutput,l_auxinput - character(len=BUFSIZE) :: buff - ! - !!!!!!!PML params!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real (kind=RKIND) :: maxSourceValue - - logical :: finishedwithsuccess - !!!!!!! - !Input - type (bounds_t) :: b - - type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize,fullsize - ! - character (LEN=BUFSIZE) :: dubuf - integer (kind=4) :: ini_save - !Generic - type (Logic_control) :: thereare - - Logical :: still_planewave_time,thereareplanewave - - integer (kind=4) :: i,J,K,r,n,n_info,FIELD - ! - ! - ! real (kind=RKIND) :: pscale_alpha - integer :: rank - !******************************************************************************* - !******************************************************************************* - !******************************************************************************* - -#ifdef CompileWithMTLN - this%mtln_parsed = mtln_parsed -#endif - - ! 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 - ! call this%init_fields(sgg) - ! Ex => this%Ex; Ey => this%Ey; Ez => this%Ez; Hx => this%Hx; Hy => this%Hy; Hz => this%Hz - - 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, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, SINPML_fullsize, fullsize, tag_numbers, tagtype) - call this%end(sgg, eps0, mu0, sggMtag, tagtype, finishedwithsuccess) - -! planewave_switched_off=.false. -! this%control%fatalerror=.false. -! parar=.false. -! call perform%reset() -! call d_perform%reset() -! flushFF=.false. -! everflushed=.false. -! call this%thereAre%reset() -! this%thereAre%MagneticMedia = sgg%thereareMagneticMedia -! this%thereAre%PMLMagneticMedia = sgg%therearePMLMagneticMedia - -! !prechecking of no offsetting to prevent errors in case of modifications -! I=sgg%Alloc(iEx)%XI -! J=sgg%Alloc(iEx)%YI -! K=sgg%Alloc(iEx)%ZI -! do field=iEy,6 -! if (sgg%Alloc(field)%XI /= I) call stoponerror(this%control%layoutnumber,this%control%size,'OFFSETS IN INITIAL COORD NOT ALLOWED') -! 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,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; - - -! !!!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)) -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!! 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 - -! call this%init_fields(sgg) -! Ex => this%Ex -! Ey => this%Ey -! Ez => this%Ez -! Hx => this%Hx -! Hy => this%Hy -! Hz => this%Hz -! ! 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)) - -! !!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!! Init the local variables and observation stuff needed by each module, taking into account resume status -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! 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 -! this%initialtimestep=0 !vamos a empezar en 0 para escribir el tiempo 0 !sgg sept'16 !? -! tiempoinicial = 0.0_RKIND_tiempo -! 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,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 -! rdummy=sgg%dt -! call MPIupdateMin(real(sgg%dt,RKIND),rdummy) -! rdummy=eps0 -! call MPIupdateMin(eps0,rdummy) -! rdummy=mu0 -! call MPIupdateMin(mu0,rdummy) -! #endif -! #ifdef CompileWithMPI -! 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,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 ) -! return -! else -! write(dubuf,*) 'Incoherence between MPI saved steps for resuming. Retrying with -old....' -! call print11(this%control%layoutnumber,dubuf) -! this%control%resume_fromold=.true. -! close (14) -! open (14,file=trim(adjustl(this%control%nresumeable2))//'.old',form='unformatted') -! 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( 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=',this%lastexecutedtimestep -! call print11(this%control%layoutnumber,dubuf) -! endif -! endif -! #else -! close (14) - -! 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 -! this%initialtimestep=this%lastexecutedtimestep+1 -! tiempoinicial = this%lastexecutedtime -! write(dubuf,*) '[OK] processing resuming data. Last executed time step ',this%lastexecutedtimestep -! call print11(this%control%layoutnumber,dubuf) -! endif -! 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,this%lastexecutedtimestep,this%control%finaltimestep,this%lastexecutedtime) -! !!!!!!!!!!!!!!!!!!!!! - -! !fin lo cambio aqui - -! call updateSigmaM(attinformado) -! call updateThinWiresSigma(attinformado) -! call calc_G1G2Gm1Gm2(sgg,G1,G2,Gm1,Gm2,eps0,mu0) -! call revertThinWiresSigma() - -! ! -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! write(dubuf,*) 'Init Reporting...'; call print11(this%control%layoutnumber,dubuf) -! call InitReporting(sgg,this%control) -! call reportSimulationOptions() - -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! write(dubuf,*) '[OK]'; call print11(this%control%layoutnumber,dubuf) -! !!!OJO SI SE CAMBIA EL ORDEN DE ESTAS INICIALIZACIONES HAY QUE CAMBIAR EL ORDEN DE STOREADO EN EL RESUMING -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #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, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, b, 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 initializeMPI() -! #endif - -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif - -! if (this%control%resume) close (14) -! ! -! n=this%initialtimestep -! ini_save = this%initialtimestep -! n_info = 5 + this%initialtimestep - -! write(dubuf,*) 'Init Timing...'; call print11(this%control%layoutnumber,dubuf) -! call InitTiming(sgg, this%control, this%control%time_desdelanzamiento, this%initialtimestep,this%control%maxSourceValue) - - -! 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 - -! 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 -! #ifdef CompileWithMPI -! call flushMPIdata() -! #endif - -! !!!no se si el orden wires - sgbcs del sync importa 150519 -! #ifdef CompileWithMPI -! #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 - -! call printSimulationStart() - -! 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 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! logical flushFF = .false., everFlushed = .false. -! #ifdef CompileWithProfiling -! call nvtxStartRange("Antes del bucle N") -! #endif -! !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 - - -! ciclo_temporal : DO while (N <= this%control%finaltimestep) - -! call step() -! call updateAndFlush() - -! 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,this%initialtimestep, & -! this%control%finaltimestep,this%perform,parar,.FALSE., & -! Ex,Ey,Ez,everflushed,this%control%nentradaroot,this%control%maxSourceValue,this%control%opcionestotales,this%control%simu_devia,this%control%dontwritevtk,this%control%permitscaling) - -! 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 -! 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 -! !!!!!!!!!!!! -! 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=',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) -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,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 (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= ',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) -! #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 (this%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) -! #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= ',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) -! #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= ',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 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 - -! #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 .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 (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= ',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 -! #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 & -! #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 -! 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 -! #endif - -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! if (n>this%control%finaltimestep) n=this%control%finaltimestep !readjust n since after finishing it is increased -! this%control%finaltimestep=n -! this%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,this%initialtimestep, & -! this%control%finaltimestep,this%d_perform,dummylog,.FALSE., & -! Ex,Ey,Ez,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= ',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= ',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,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= ',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) - -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,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 -! #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,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,b, n,ndummy,this%control%layoutnumber,this%control%size, this%control%maxCPUtime,this%control%flushsecondsFields,this%control%flushsecondsData,this%initialtimestep, & -! this%control%finaltimestep,this%perform,parar,.FALSE., & -! Ex,Ey,Ez,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= ',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 ) -! ! -! #ifdef CompileWithMPI -! call MPI_Barrier(SUBCOMM_MPI,ierr) -! #endif -! !----------------------------------------------------> - - contains - - - - 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 - - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 - - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!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 - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - end subroutine launch_simulation - - - - !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 ) character (len=*) , intent(in) :: wiresflavor @@ -3689,126 +2728,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 From 19d1a3f966d39364c531af31cbd39e6b588c47b2 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Wed, 9 Jul 2025 15:17:40 +0200 Subject: [PATCH 29/56] minor --- test/system/test_init_solver.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/system/test_init_solver.F90 b/test/system/test_init_solver.F90 index e14cab65..b41b89cb 100644 --- a/test/system/test_init_solver.F90 +++ b/test/system/test_init_solver.F90 @@ -5,7 +5,8 @@ integer function test_init_solver() bind (C) result(err) type(semba_fdtd_t) :: semba character(len=*), parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'holland1981.fdtd.json' - call semba%init() + err = 0 + ! call semba%init() ! call semba%launch() ! call semba%end() end function \ No newline at end of file From 727b02e0dad7f379a0ec968502bacfdc8f9c776c Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Wed, 9 Jul 2025 15:28:23 +0200 Subject: [PATCH 30/56] Minor changes for windows compilation --- src_main_pub/timestepping.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 1b69170f..204aadde 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -1451,13 +1451,12 @@ subroutine initializeObservation() endif end subroutine initializeObservation +#ifdef CompileWithMPI subroutine initializeMPI() character(len=bufsize) :: dubuf integer(kind=4) :: ierr 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) @@ -1467,9 +1466,6 @@ subroutine initializeMPI() call MPI_Barrier(SUBCOMM_MPI,ierr) 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 @@ -1531,7 +1527,9 @@ subroutine initializeMPI() #endif end subroutine initializeMPI +#endif +#ifdef CompileWithMPI subroutine flushMPIdata() integer(kind=4) :: ierr call MPI_Barrier(SUBCOMM_MPI,ierr) @@ -1558,6 +1556,7 @@ subroutine flushMPIdata() endif #endif end subroutine flushMPIdata +#endif subroutine printSimulationStart() character(len=bufsize) :: dubuf @@ -2481,6 +2480,7 @@ subroutine advancePMLE() endif end subroutine +#ifdef CompileWithMPI subroutine initMPIConformalProbes() integer (kind=4) :: group_conformalprobes_dummy, ierr !!!!sgg250424 niapa para que funcionen sondas conformal mpi @@ -2498,7 +2498,7 @@ subroutine initMPIConformalProbes() 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 solver_run subroutine solver_end(this, sgg, eps0, mu0, sggMtag, tagtype, finishedwithsuccess) From b8940871f6e1c6aafff96b135c2349f0f77eb888 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Thu, 10 Jul 2025 09:02:09 +0200 Subject: [PATCH 31/56] Minor --- src_main_pub/semba_fdtd.F90 | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index 57fc4602..8091a5c9 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -115,8 +115,6 @@ subroutine semba_init(this, input_flags) 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 @@ -130,13 +128,13 @@ subroutine semba_init(this, input_flags) 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 - this%l%size = 1 - this%l%layoutnumber = 0 + this%l%size = 1 + this%l%layoutnumber = 0 #endif - call setglobal(this%l%layoutnumber,this%l%size) !para crear variables globales con info MPI + 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, ') ' + 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,this%l%ierr) @@ -268,14 +266,14 @@ subroutine semba_init(this, input_flags) #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) - end if + + ! 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 From ad2c96d222415cc6085f8c0fd00cbc4c179cdc40 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 11 Jul 2025 07:59:46 +0200 Subject: [PATCH 32/56] minor change --- src_main_pub/semba_fdtd.F90 | 5 +++-- src_main_pub/timestepping.F90 | 7 +++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index 8091a5c9..9dcdf43a 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -969,7 +969,7 @@ subroutine semba_launch(this) #endif this%finishedwithsuccess=.false. - call solver%init_control(this%l,this%maxSourceValue, this%time_desdelanzamiento) + #ifdef CompileWithMTLN solver%mtln_parsed = this%mtln_parsed #endif @@ -977,7 +977,8 @@ subroutine semba_launch(this) 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%EpsMuTimeScale_input_parameters) + 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 diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 204aadde..ea646a27 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -296,7 +296,7 @@ subroutine init_distances(this,sgg) subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, & SINPML_Fullsize,fullsize,finishedwithsuccess,Eps0,Mu0,tagtype, & - EpsMuTimeScale_input_parameters) + input, maxSourceValue, time_desdelanzamiento) class(solver_t) :: this type (SGGFDTDINFO), intent(INOUT) :: sgg integer (KIND=IKINDMTAG) :: & @@ -314,8 +314,11 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi logical :: finishedwithsuccess REAL (KIND=RKIND), intent(inout) :: eps0,mu0 type (tagtype_t) :: tagtype - type (EpsMuTimeScale_input_parameters_t) :: EpsMuTimeScale_input_parameters + 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, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, SINPML_fullsize, fullsize, tag_numbers, tagtype) call this%end(sgg, eps0, mu0, sggMtag, tagtype, finishedwithsuccess) From 4e1923febf767619c199cfb7d214d99364af220e Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 11 Jul 2025 11:07:37 +0200 Subject: [PATCH 33/56] Adds possibility to call semba from test without command line arguments. Adds methods to advance fields and set/get fields --- src_main_pub/getargs.F90 | 15 +- src_main_pub/interpreta_switches.F90 | 107 ++-- src_main_pub/semba_fdtd.F90 | 27 +- src_main_pub/timestepping.F90 | 906 +++++++++++++++------------ test/system/init_solver.fdtd.json | 52 ++ test/system/test_init_solver.F90 | 17 +- 6 files changed, 641 insertions(+), 483 deletions(-) create mode 100644 test/system/init_solver.fdtd.json 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 65abe739..fd38509d 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -177,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 @@ -190,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.) @@ -199,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 @@ -213,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 @@ -222,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 @@ -256,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 @@ -295,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.) @@ -308,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. @@ -335,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.) @@ -384,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 @@ -401,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 @@ -415,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 @@ -442,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 @@ -489,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) @@ -547,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 @@ -561,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 @@ -576,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 @@ -592,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 @@ -607,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 @@ -620,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 @@ -633,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 @@ -646,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 @@ -659,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 @@ -694,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 @@ -706,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 @@ -717,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 @@ -765,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 @@ -776,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' @@ -793,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 @@ -863,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 @@ -874,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 @@ -911,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. @@ -927,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 @@ -953,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 @@ -964,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 @@ -972,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 @@ -1766,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 @@ -1776,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.) @@ -1788,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 @@ -1797,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 @@ -1832,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 @@ -1842,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 @@ -1921,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 @@ -1934,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 @@ -1951,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 diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index 9dcdf43a..409bc2cf 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -94,7 +94,7 @@ subroutine semba_init(this, input_flags) character (LEN=BUFSIZE) :: filename_h5bin ! File name integer (KIND=4) :: myunit,jmed - integer (kind=4) :: finaltimestepantesdecorregir,NEWfinaltimestep,thefileno + integer (kind=4) :: finaltimestepantesdecorregir,NlaunEWfinaltimestep,thefileno integer (kind=4) :: statuse integer (KIND=4) :: status, i, field INTEGER (KIND=4) :: verdadero_mpidir @@ -114,7 +114,7 @@ subroutine semba_init(this, input_flags) #ifdef CompileWithConformal 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 @@ -267,16 +267,17 @@ subroutine semba_init(this, input_flags) 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 + 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 + 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 this%l%chain2=trim(adjustl(this%l%chain2)) !concatena con lo que haya en launch @@ -324,7 +325,7 @@ subroutine semba_init(this, input_flags) 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) + CALL getcommandargument (this%l%chain2, 1, chaindummy, this%l%length, statuse, getBinaryPath()) this%l%chain2=trim(adjustl(this%l%chain2)) chaindummy=trim(adjustl(chaindummy)) @@ -1180,7 +1181,7 @@ subroutine semba_end(this) #ifdef CompileWithMPI CALL MPI_FINALIZE (this%l%ierr) #endif - STOP + ! STOP ! end subroutine semba_end diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index ea646a27..4ee4c582 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -97,6 +97,9 @@ module Solver_mod 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 @@ -104,7 +107,7 @@ module Solver_mod type(bounds_t) :: bounds - logical :: parar, everflushed = .false. + logical :: parar, everflushed = .false., still_planewave_time #ifdef CompileWithMTLN type (mtln_t) :: mtln_parsed @@ -115,9 +118,12 @@ module Solver_mod procedure :: run => solver_run procedure :: end => solver_end procedure :: init_control => solver_init_control - procedure :: init_fields - procedure :: init_distances + 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 @@ -294,6 +300,61 @@ subroutine init_distances(this,sgg) this%Idzh=1.0_RKIND/this%dzh end subroutine + 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 + + 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 + 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) @@ -319,9 +380,11 @@ subroutine launch_simulation(this, sgg,sggMtag,tag_numbers,sggMiNo,sggMiEx,sggMi 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, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, SINPML_fullsize, fullsize, tag_numbers, tagtype) - call this%end(sgg, eps0, mu0, sggMtag, tagtype, finishedwithsuccess) + 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) + + end subroutine launch_simulation subroutine solver_init(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, sinPML_fullsize, fullsize, tag_numbers) @@ -360,6 +423,15 @@ subroutine solver_init(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sgg 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 + this%control%fatalerror=.false. this%parar=.false. @@ -526,7 +598,7 @@ subroutine solver_init(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sgg call initializePlanewave() call initializeNodalSources() - call fillMtag(sgg, sggMiEx, sggMiEy, sggMiEz, sggMiHx, sggMiHy, sggMiHz,sggMtag, this%bounds, tag_numbers) + 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 @@ -573,10 +645,6 @@ subroutine solver_init(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sgg call printSimulationStart() - ! 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 - contains subroutine findbounds(sgg,b) @@ -1017,7 +1085,7 @@ subroutine initializeBorders() 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) + 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 @@ -1057,7 +1125,7 @@ subroutine initializeLumped() !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) + 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 @@ -1086,7 +1154,7 @@ subroutine initializeWires() 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, & + 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 @@ -1109,7 +1177,7 @@ subroutine initializeWires() 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, & + 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) @@ -1142,9 +1210,9 @@ subroutine initializeWires() 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%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, & @@ -1211,7 +1279,7 @@ subroutine initializeAnisotropic() 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) + 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 @@ -1238,7 +1306,7 @@ subroutine initializeSGBC() 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, & + 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 @@ -1264,7 +1332,7 @@ subroutine initializeMultiports() 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, & + 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 @@ -1293,8 +1361,8 @@ subroutine initializeConformalElements() 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,& + 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 @@ -1327,7 +1395,7 @@ subroutine initializeEDispersives() 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) + 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 @@ -1352,7 +1420,7 @@ subroutine initializeMDispersives() 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) + 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 @@ -1377,7 +1445,7 @@ subroutine initializePlanewave() 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) + 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) l_auxinput=this%thereAre%PlaneWaveBoxes l_auxoutput=l_auxinput @@ -1436,7 +1504,7 @@ subroutine initializeObservation() 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, & + 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) @@ -1463,11 +1531,11 @@ subroutine initializeMPI() 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,sggmiEz,sggMiHz) + 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, sggmiHx,sggmiHy,sggmiHz) + 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, sggmiEx,sggmiEy,sggmiEz) + 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 @@ -1504,7 +1572,7 @@ subroutine initializeMPI() #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, & + 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) @@ -1699,23 +1767,12 @@ subroutine crea_timevector(sgg,lastexecutedtimestep,finaltimestep,lastexecutedti end subroutine solver_init - subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz, sggMtag, sinPML_fullsize, fullsize, tag_numbers, tagtype) + subroutine solver_run(this, sgg, eps0, mu0, sinPML_fullsize, fullsize, tag_numbers, tagtype) class(solver_t) :: this type(sggfdtdinfo), intent(in) :: 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), intent(in) :: tag_numbers type (tagtype_t), intent(in) :: tagtype @@ -1724,7 +1781,7 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM 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 :: still_planewave_time, call_timing, l_aux, flushFF, somethingdone, newsomethingdone + logical :: call_timing, l_aux, flushFF, somethingdone, newsomethingdone integer :: i real (kind=rkind) :: pscale_alpha REAL (kind=rkind_tiempo) :: at @@ -1741,7 +1798,7 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM call initMPIConformalProbes() #endif #endif - still_planewave_time=.true. !inicializacion de la variable + this%still_planewave_time=.true. !inicializacion de la variable flushFF = .false. pscale_alpha=1.0 !se le entra con 1.0 @@ -1756,7 +1813,7 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM ciclo_temporal : DO while (this%n <= this%control%finaltimestep) - call step() + call this%step(sgg, eps0, mu0, sinPML_fullsize, tag_numbers) call updateAndFlush() if(this%n >= this%n_info) then @@ -1875,7 +1932,7 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM 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) + 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) @@ -1958,7 +2015,7 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM this%control%sgbcDispersive,this%control%finaltimestep, & eps0,mu0, & this%control%simu_devia, & - EpsMuTimeScale_input_parameters,pscale_alpha,still_planewave_time & + EpsMuTimeScale_input_parameters,pscale_alpha,this%still_planewave_time & #ifdef CompileWithMPI ,this%control%layoutnumber,this%control%size & #endif @@ -1976,540 +2033,565 @@ subroutine solver_run(this, sgg, eps0, mu0, sggMiNo,sggMiEx,sggMiEy,sggMiEz,sggM 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 step() - logical :: planewave_switched_off = .false., thereareplanewave - + 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 + + + type (limit_t), dimension(1:6), intent(in) :: SINPML_fullsize + type(taglist_t), intent(in) :: tag_numbers + + + 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 + + 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 + + + +#ifdef CompileWithMPI + integer(kind=4) :: ierr +#endif - call flushPlanewaveOff(planewave_switched_off, 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() + 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(this%control%input_conformal_flag) call conformal_advance_E() + if(this%control%input_conformal_flag) call conformal_advance_E() #endif - call advanceWires() - call advancePMLE() + call advanceWires() + call advancePMLE() #ifdef CompileWithNIBC - IF (this%thereAre%Multiports.and.(this%control%mibc)) call AdvanceMultiportE(sgg%alloc,Ex, Ey, Ez) + 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%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.still_planewave_time) then - if(.not.this%control%simu_devia) call AdvancePlaneWaveE(sgg,this%n, this%bounds,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,still_planewave_time) - end if - If (this%thereAre%NodalE) call AdvanceNodalE(sgg,sggMiEx,sggMiEy,sggMiEz,sgg%NumMedia,this%n, this%bounds,G2,Idxh,Idyh,Idzh,Ex,Ey,Ez,this%control%simu_devia) + 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) #ifdef CompileWithMPI - if (this%control%size>1) then - call MPI_Barrier(SUBCOMM_MPI,ierr) - call FlushMPI_E_Cray - endif + if (this%control%size>1) then + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_E_Cray + endif #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, sggMiHx, sggMiHy, 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) + 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,sggMiHx,sggMiHy,sggMiHz,gm2,sgg%nummedia,this%control%conformalskin) + 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.still_planewave_time) then - if (.not.this%control%simu_devia) call AdvancePlaneWaveH(sgg,this%n, this%bounds, GM2, Idxe,Idye, Idze, Hx, Hy, Hz,still_planewave_time) - endif - If (this%thereAre%NodalH) call AdvanceNodalH(sgg,sggMiHx,sggMiHy,sggMiHz,sgg%NumMedia,this%n, this%bounds,GM2,Idxe,Idye,Idze,Hx,Hy,Hz,this%control%simu_devia) + 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 + 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 - 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) + 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() + 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) + !!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) + if (this%control%stochastic) call syncstoch_mpi_wires(this%control%simu_devia,this%control%layoutnumber,this%control%size) #endif - 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) - 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 #endif !!!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) + if (this%control%stochastic) call syncstoch_mpi_sgbcs(this%control%simu_devia,this%control%layoutnumber,this%control%size) #endif #endif #ifdef CompileWithMPI #ifdef CompileWithStochastic - if (this%control%stochastic) call syncstoch_mpi_lumped(this%control%simu_devia,this%control%layoutnumber,this%control%size) + 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,sggMiHx, sggMiHy, 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 -#endif - endif - end subroutine step - - 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 + 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 - 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 updateAndFlush() - integer(kind=4) :: mindum - IF (this%thereAre%Observation) then - call UpdateObservation(sgg,sggMiEx,sggMiEy,sggMiEz,sggMiHx,sggMiHy,sggMiHz,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 + call MPI_Barrier(SUBCOMM_MPI,ierr) + call FlushMPI_H_Cray endif endif - end subroutine +#endif + endif +contains - subroutine singleUnpack() - character (LEN=BUFSIZE) :: dubuf - logical :: somethingdone - real (kind=rkind_tiempo) :: at + 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 - 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) + 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 -#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 + 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() + subroutine advanceE() #ifdef CompileWithProfiling - call nvtxStartRange("Antes del bucle EX") + call nvtxStartRange("Antes del bucle EX") #endif - call Advance_Ex (Ex, Hy, Hz, Idyh, Idzh, sggMiEx, this%bounds,g1,g2) + call Advance_Ex (Ex, Hy, Hz, Idyh, Idzh, this%sggMiEx, this%bounds,g1,g2) #ifdef CompileWithProfiling - call nvtxEndRange + call nvtxEndRange - call nvtxStartRange("Antes del bucle EY") + call nvtxStartRange("Antes del bucle EY") #endif - call Advance_Ey (Ey, Hz, Hx, Idzh, Idxh, sggMiEy, this%bounds,g1,g2) - + call Advance_Ey (Ey, Hz, Hx, Idzh, Idxh, this%sggMiEy, this%bounds,g1,g2) + #ifdef CompileWithProfiling - call nvtxEndRange + call nvtxEndRange - call nvtxStartRange("Antes del bucle EZ") + call nvtxStartRange("Antes del bucle EZ") #endif - call Advance_Ez (Ez, Hx, Hy, Idxh, Idyh, sggMiEz, this%bounds,g1,g2) + call Advance_Ez (Ez, Hx, Hy, Idxh, Idyh, this%sggMiEz, this%bounds,g1,g2) #ifdef CompileWithProfiling - call nvtxEndRange + call nvtxEndRange #endif - end subroutine + end subroutine - subroutine Advance_Ex(Ex,Hy,Hz,Idyh,Idzh,sggMiEx,b,g1,g2) + subroutine Advance_Ex(Ex,Hy,Hz,Idyh,Idzh,sggMiEx,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%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 + !------------------------> + 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 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) #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) - 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 + End do #ifdef CompileWithOpenMP !$OMP END PARALLEL DO #endif - return - end subroutine Advance_Ex - - subroutine Advance_Ey(Ey,Hz,Hx,Idzh,Idxh,sggMiEy,b,g1,g2) + 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 + !------------------------> + 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 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) #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)) - 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 Advance_Ey + return + end subroutine Advance_Ey - subroutine Advance_Ez(Ez,Hx,Hy,Idxh,Idyh,sggMiEz,b,g1,g2) + 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 + !------------------------> + 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) #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) #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 + 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 #endif - return - end subroutine Advance_Ez + return + end subroutine Advance_Ez - subroutine advanceH() + subroutine advanceH() #ifdef CompileWithProfiling - call nvtxStartRange("Antes del bucle HX") + call nvtxStartRange("Antes del bucle HX") #endif - call Advance_Hx (Hx, Ey, Ez, Idye, Idze, sggMiHx, this%bounds,gm1,gm2) + call Advance_Hx (Hx, Ey, Ez, Idye, Idze, this%sggMiHx, this%bounds,gm1,gm2) #ifdef CompileWithProfiling - call nvtxEndRange - call nvtxStartRange("Antes del bucle HY") + call nvtxEndRange + call nvtxStartRange("Antes del bucle HY") #endif - call Advance_Hy (Hy, Ez, Ex, Idze, Idxe, sggMiHy, this%bounds,gm1,gm2) + call Advance_Hy (Hy, Ez, Ex, Idze, Idxe, this%sggMiHy, this%bounds,gm1,gm2) #ifdef CompileWithProfiling - call nvtxEndRange - call nvtxStartRange("Antes del bucle HZ") + call nvtxEndRange + call nvtxStartRange("Antes del bucle HZ") #endif - call Advance_Hz (Hz, Ex, Ey, Idxe, Idye, sggMiHz, this%bounds,gm1,gm2) + call Advance_Hz (Hz, Ex, Ey, Idxe, Idye, this%sggMiHz, this%bounds,gm1,gm2) #ifdef CompileWithProfiling - call nvtxEndRange + 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 + 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 + 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 Advance_Hx + return + end subroutine Advance_Hx - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Hy(Hy,Ez,Ex,IdzE,IdxE,sggMiHy,b,gm1,gm2) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine Advance_Hy(Hy,Ez,Ex,IdzE,IdxE,sggMiHy,b,gm1,gm2) - !------------------------> - 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 + !------------------------> + 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 + 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 + return + end subroutine Advance_Hy - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine Advance_Hz(Hz,Ex,Ey,IdxE,IdyE,sggMiHz,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%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 + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine Advance_Hz(Hz,Ex,Ey,IdxE,IdyE,sggMiHz,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%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 + 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 + 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 + 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 + 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 + 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 + 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 + if (this%control%use_mtln_wires) then #ifdef CompileWithMTLN - call AdvanceWiresE_mtln(sgg,Idxh,Idyh,Idzh,eps0,mu0) + call AdvanceWiresE_mtln(sgg,Idxh,Idyh,Idzh,eps0,mu0) #else - write(buff,'(a)') 'WIR_ERROR: Executable was not compiled with MTLN modules.' + write(buff,'(a)') 'WIR_ERROR: Executable was not compiled with MTLN modules.' #endif - end if + end if - end subroutine advanceWires + 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,sggMiEx,sggMiEy,sggMiEz,G2,Ex,Ey,Ez,Hx,Hy,Hz) - endif - end subroutine + 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 #ifdef CompileWithMPI - subroutine initMPIConformalProbes() - integer (kind=4) :: group_conformalprobes_dummy, ierr + 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 + 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 solver_run - subroutine solver_end(this, sgg, eps0, mu0, sggMtag, tagtype, finishedwithsuccess) + end subroutine step + + 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 - integer (KIND=IKINDMTAG), intent(in) :: & - 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 (tagtype_t), intent(in) :: tagtype logical, intent(inout) :: finishedwithsuccess @@ -2624,7 +2706,7 @@ subroutine solver_end(this, sgg, eps0, mu0, sggMtag, tagtype, finishedwithsucces 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,sggMtag,this%control%dontwritevtk) + 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) 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/test_init_solver.F90 b/test/system/test_init_solver.F90 index b41b89cb..718eaaa1 100644 --- a/test/system/test_init_solver.F90 +++ b/test/system/test_init_solver.F90 @@ -3,10 +3,21 @@ integer function test_init_solver() bind (C) result(err) use system_testingTools_mod implicit none type(semba_fdtd_t) :: semba + type(solver_t) :: solver character(len=*), parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'holland1981.fdtd.json' err = 0 - ! call semba%init() - ! call semba%launch() - ! call semba%end() + + 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 end function \ No newline at end of file From 7e7887dad2b8b0ffa77cfbf95f2b57b28becf3d0 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 11 Jul 2025 11:15:34 +0200 Subject: [PATCH 34/56] Minor --- src_main_pub/semba_fdtd.F90 | 2 +- src_main_pub/timestepping.F90 | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src_main_pub/semba_fdtd.F90 b/src_main_pub/semba_fdtd.F90 index 409bc2cf..58ad5fb5 100755 --- a/src_main_pub/semba_fdtd.F90 +++ b/src_main_pub/semba_fdtd.F90 @@ -94,7 +94,7 @@ subroutine semba_init(this, input_flags) character (LEN=BUFSIZE) :: filename_h5bin ! File name integer (KIND=4) :: myunit,jmed - integer (kind=4) :: finaltimestepantesdecorregir,NlaunEWfinaltimestep,thefileno + integer (kind=4) :: finaltimestepantesdecorregir,NEWfinaltimestep,thefileno integer (kind=4) :: statuse integer (KIND=4) :: status, i, field INTEGER (KIND=4) :: verdadero_mpidir diff --git a/src_main_pub/timestepping.F90 b/src_main_pub/timestepping.F90 index 4ee4c582..7552a229 100755 --- a/src_main_pub/timestepping.F90 +++ b/src_main_pub/timestepping.F90 @@ -2092,6 +2092,10 @@ subroutine step(this, sgg, eps0, mu0, sinPML_fullsize, tag_numbers) 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 + 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 @@ -2103,9 +2107,6 @@ subroutine step(this, sgg, eps0, mu0, sinPML_fullsize, tag_numbers) -#ifdef CompileWithMPI - integer(kind=4) :: ierr -#endif 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) From 3a9895fa5c6592e75cfc8c582b0adf7c097c9178 Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 11 Jul 2025 11:38:52 +0200 Subject: [PATCH 35/56] minor --- test/system/test_init_solver.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/system/test_init_solver.F90 b/test/system/test_init_solver.F90 index 718eaaa1..ad7389c8 100644 --- a/test/system/test_init_solver.F90 +++ b/test/system/test_init_solver.F90 @@ -20,4 +20,6 @@ integer function test_init_solver() bind (C) result(err) 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 From fd348cdff8c5a57d7bb82d0ac3ffadaba4fbb18b Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 11 Jul 2025 11:39:14 +0200 Subject: [PATCH 36/56] Minor --- test/system/test_init_solver.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/test/system/test_init_solver.F90 b/test/system/test_init_solver.F90 index ad7389c8..ca438bd0 100644 --- a/test/system/test_init_solver.F90 +++ b/test/system/test_init_solver.F90 @@ -4,10 +4,8 @@ integer function test_init_solver() bind (C) result(err) implicit none type(semba_fdtd_t) :: semba type(solver_t) :: solver - character(len=*), parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'holland1981.fdtd.json' err = 0 - call chdir("./test/system/") call semba%init("-i init_solver.fdtd.json") From 57a6629f40d76894ecdc38cc4d5ad5720b01055c Mon Sep 17 00:00:00 2001 From: Alberto-o Date: Fri, 11 Jul 2025 12:27:38 +0200 Subject: [PATCH 37/56] Minor, assigns default false to "thereare_stoch" --- src_main_pub/interpreta_switches.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src_main_pub/interpreta_switches.F90 b/src_main_pub/interpreta_switches.F90 index fd38509d..b070c675 100755 --- a/src_main_pub/interpreta_switches.F90 +++ b/src_main_pub/interpreta_switches.F90 @@ -2108,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 From 5a792097dd89c9a05560cdccd18d0e97b5bd31a8 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Mon, 14 Jul 2025 10:40:01 +0200 Subject: [PATCH 38/56] Add FDTD input file for planewave simulation with PEC boundaries --- .../cases/planewave/pw-with-pec.fdtd.json | 58 +++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 testData/cases/planewave/pw-with-pec.fdtd.json 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 From a92a8cbe0b248e56798683e7f0968be61b0c8573 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Mon, 21 Jul 2025 12:59:42 +0200 Subject: [PATCH 39/56] Created routines associated to the evolution operator of the fdtd system --- src_main_pub/evolution_operator.F90 | 575 ++++++++++++++++------------ 1 file changed, 331 insertions(+), 244 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 31f9addc..a705b7b2 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -5,17 +5,18 @@ module evolution_operator use fdetypes use Report - use fhash, only: fhash_tbl, key => fhash_key + use fhash, only: fhash_tbl_t, key => fhash_key + + implicit none type :: field_array_t real(RKIND), pointer, dimension(:,:,:) :: data character(len=2) :: field_type ! 'Ex', 'Ey', 'Ez', 'Hx', etc. end type - implicit none private - public :: evolution_operator + public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis contains @@ -30,6 +31,7 @@ subroutine GenerateElectricalInputBasis(M, dim1, dim2, M_ee, M_eo, M_oe, M_oo) 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) @@ -42,14 +44,15 @@ subroutine GenerateElectricalInputBasis(M, dim1, dim2, M_ee, M_eo, M_oe, M_oo) do i = 0, sz(1)-1 do j = 0, sz(2)-1 do k = 0, sz(3)-1 - v1 = [i, j, k](dim1) - v2 = [i, j, k](dim2) + ijk = [i, j, k] + v1 = ijk(dim1) + v2 = ijk(dim2) select case (2*mod(v1,2) + mod(v2,2)) - case (0); M_ee(i,j,k) = 1.0_RKIND - case (1); M_eo(i,j,k) = 1.0_RKIND - case (2); M_oe(i,j,k) = 1.0_RKIND - case (3); M_oo(i,j,k) = 1.0_RKIND + 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 @@ -79,7 +82,7 @@ subroutine GenerateMagneticalInputBasis(A, M1, M2, M3, M) idx1 = mod(i, M1) idx2 = mod(j, M2) idx3 = mod(k, M3) - M(idx1+1, idx2+1, idx3+1, i, j, k) = 1.0_RKIND + M(idx1+1, idx2+1, idx3+1, i+1, j+1, k+1) = 1.0_RKIND end do end do end do @@ -92,52 +95,74 @@ subroutine GenerateInputFieldsBasis(b, FieldList) type (bounds_t), intent( IN) :: b type(field_array_t), allocatable, intent(OUT) :: FieldList(:) - allocate(FieldList(66)) - + ! Generating the basis for the electical fields real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) :: Ex real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) :: Ey real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) :: Ez + + ! Generating the basis for the magnetical fields + real (kind = RKIND), dimension ( 0 : b%HX%NX-1 , 0 : b%HX%NY-1 , 0 : b%HX%NZ-1 ) :: Hx + real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) :: Hy + real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) :: Hz + + ! Allocating the basis for the electrical fields + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ex_ee + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ex_eo + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ex_oe + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ex_oo + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ey_ee + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ey_eo + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ey_oe + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ey_oo + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ez_ee + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ez_eo + real (kind = RKIND), allocatable, dimension(:,:,:) :: Ez_oe + real (kind = RKIND), allocatable, dimension(:,:,:) :: 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(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(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 + FieldList(9)%data = Ez_ee + FieldList(10)%data = Ez_eo + FieldList(11)%data = Ez_oe + FieldList(12)%data = Ez_oo - ! Generating the basis for the magnetical fields - real (kind = RKIND), dimension ( 0 : b%HX%NX-1 , 0 : b%HX%NY-1 , 0 : b%HX%NZ-1 ) :: Hx - real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) :: Hy - real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) :: Hz - - Hx = 0.0_RKIND - Hy = 0.0_RKIND - Hz = 0.0_RKIND 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 - integer :: idx, i1, i2, i3 idx = 0 @@ -155,7 +180,7 @@ subroutine GenerateInputFieldsBasis(b, FieldList) do i2 = 1, 3 do i3 = 1, 3 idx = idx + 1 - FieldList(idx)%data => Hx_m(i1, i2, i3, :, :, :) + FieldList(idx)%data = Hx_m(i1, i2, i3, :, :, :) FieldList(idx)%field_type = 'Hx' end do end do @@ -165,7 +190,7 @@ subroutine GenerateInputFieldsBasis(b, FieldList) do i2 = 1, 2 do i3 = 1, 3 idx = idx + 1 - FieldList(idx)%data => Hy_m(i1, i2, i3, :, :, :) + FieldList(idx)%data = Hy_m(i1, i2, i3, :, :, :) FieldList(idx)%field_type = 'Hy' end do end do @@ -175,7 +200,7 @@ subroutine GenerateInputFieldsBasis(b, FieldList) do i2 = 1, 3 do i3 = 1, 2 idx = idx + 1 - FieldList(idx)%data => Hz_m(i1, i2, i3, :, :, :) + FieldList(idx)%data = Hz_m(i1, i2, i3, :, :, :) end do end do @@ -183,213 +208,275 @@ subroutine GenerateInputFieldsBasis(b, FieldList) end subroutine - subroutine GenerateOutputFields(b, FieldList) + ! subroutine GenerateOutputFields(b, FieldList) - type (bounds_t), intent( IN) :: b - type(field_array_t), allocatable, intent(OUT) :: FieldListOutput(:) ! Aquí necesito cambiar el tipo de variable de los outputs para tener en cuenta que con el input i, se generan varios outputs - allocate(FieldListOutput(66)) - - call GenerateInputFieldsBasis(b, FieldListInput) - - integer :: i - - do i = 1, size(FieldListInput) - ! Acá es necesario realizar el paso temporal y extraer los campos usando el timestepping/resuming, en todo caso si la función es general, se llama fuera del case y se almacena dependiendo - ! del caso. - select case (trim(FieldListInput(i)%field_type)) - case ("Ex") - call Advance_Ex() - call Advance_Hy() - call Advance_Hz() - case ("Ey") - call Advance_Ey() - call Advance_Hx() - call Advance_Hz() - case ("Ez") - call Advance_Ez() - call Advance_Hx() - call Advance_Hy() - case ("Hx") - call Advance_Ex() - call Advance_Ey() - Call Advance_Ez() - call Advance_Hx() - case ("Hy") - call Advance_Hy() - case ("Hz") - call Advance_Hz() - end select - end do - - end subroutine - - subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, dirM1, dirM2) - type(fhash_tbl), intent(inout) :: RowIndexMap - type(limit_t), intent(in) :: field - integer, intent(in) :: shiftE, shiftM1, shiftM2 - character(len=1), intent(in) :: dirM1, dirM2 - - integer :: i, j, k, m, m_shift1, m_shift2 - integer, allocatable :: indexList(:) - integer :: Nx, Ny, Nz - - Nx = field%Nx + 2 - Ny = field%Ny + 2 - Nz = field%Nz + 2 - - do i = 1, Nx - do j = 1, Ny - do k = 1, Nz - m = (i*Ny + j)*Nz + k - - select case (dirM1) - case ('i') - m_shift1 = ((i - 1)*Ny + j)*Nz + k - case ('j') - m_shift1 = (i*Ny + (j - 1))*Nz + k - case ('k') - m_shift1 = (i*Ny + j)*Nz + (k - 1) - end select - - select case (dirM2) - case ('i') - m_shift2 = ((i - 1)*Ny + j)*Nz + k - case ('j') - m_shift2 = (i*Ny + (j - 1))*Nz + k - case ('k') - m_shift2 = (i*Ny + j)*Nz + (k - 1) - end select - - allocate(indexList(5)) - indexList(1) = shiftE + m - indexList(2) = shiftM1 + m - indexList(3) = shiftM1 + m_shift2 - indexList(4) = shiftM2 + m - indexList(5) = shiftM2 + m_shift1 - - call RowIndexMap%set(key(shiftE + m), value=indexList) - - deallocate(indexList) - end do - end do - end do - end subroutine - - subroutine AddMagneticFieldIndices(RowIndexMap, field, shiftH, shiftE1, shiftE2, dir1, dir2) - type(fhash_tbl), intent(inout) :: RowIndexMap - type(limit_t), intent(in) :: field - integer, intent(in) :: shiftH, shiftE1, shiftE2 - character(len=1), intent(in) :: dir1, dir2 - - integer :: i, j, k, m, m_shift1, m_shift2 - integer :: Nx, Ny, Nz - integer, allocatable :: temp(:), indexList(:) - integer, allocatable :: aux1(:), aux2(:), aux3(:), aux4(:) - - Nx = field%Nx + 2 - Ny = field%Ny + 2 - Nz = field%Nz + 2 - - do i = 1, Nx - do j = 1, Ny - do k = 1, Nz - m = (i*Ny + j)*Nz + k - - select case (dir1) - case ('i') - m_shift1 = ((i + 1)*Ny + j)*Nz + k - case ('j') - m_shift1 = (i*Ny + (j + 1))*Nz + k - case ('k') - m_shift1 = (i*Ny + j)*Nz + (k + 1) - end select - - select case (dir2) - case ('i') - m_shift2 = ((i + 1)*Ny + j)*Nz + k - case ('j') - m_shift2 = (i*Ny + (j + 1))*Nz + k - case ('k') - m_shift2 = (i*Ny + j)*Nz + (k + 1) - end select - - call RowIndexMap%get(key(shiftE1 + m), aux1) - call RowIndexMap%get(key(shiftE1 + m_shift1), aux2) - call RowIndexMap%get(key(shiftE2 + m), aux3) - call RowIndexMap%get(key(shiftE2 + m_shift2), aux4) - - integer :: totalSize - totalSize = size(aux1) + size(aux2) + size(aux3) + size(aux4) - allocate(temp(totalSize)) - temp(1:size(aux1)) = aux1 - temp(size(aux1)+1:size(aux1)+size(aux2)) = aux2 - temp(size(aux1)+size(aux2)+1:size(aux1)+size(aux2)+size(aux3)) = aux3 - temp(size(aux1)+size(aux2)+size(aux3)+1:) = aux4 - - call RemoveDuplicates(temp, indexList) - - - call RowIndexMap%set(key(shiftH + m), value=indexList) - - deallocate(temp, indexList, aux1, aux2, aux3, aux4) - end do - end do - end do - end subroutine + ! type (bounds_t), intent( IN) :: b + ! type(field_array_t), allocatable, intent(OUT) :: FieldListOutput(:) ! Aquí necesito cambiar el tipo de variable de los outputs para tener en cuenta que con el input i, se generan varios outputs + ! allocate(FieldListOutput(66)) + + ! call GenerateInputFieldsBasis(b, FieldListInput) + + ! integer :: i + + ! do i = 1, size(FieldListInput) + ! ! Acá es necesario realizar el paso temporal y extraer los campos usando el timestepping/resuming, en todo caso si la función es general, se llama fuera del case y se almacena dependiendo + ! ! del caso. + ! select case (trim(FieldListInput(i)%field_type)) + ! case ("Ex") + ! call Advance_Ex() + ! call Advance_Hy() + ! call Advance_Hz() + ! case ("Ey") + ! call Advance_Ey() + ! call Advance_Hx() + ! call Advance_Hz() + ! case ("Ez") + ! call Advance_Ez() + ! call Advance_Hx() + ! call Advance_Hy() + ! case ("Hx") + ! call Advance_Ex() + ! call Advance_Ey() + ! Call Advance_Ez() + ! call Advance_Hx() + ! case ("Hy") + ! call Advance_Hy() + ! case ("Hz") + ! call Advance_Hz() + ! end select + ! end do + + ! end subroutine + + ! subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, dirM1, dirM2) + ! type(fhash_tbl_t), intent(inout) :: RowIndexMap + ! type(limit_t), intent(in) :: field + ! integer, intent(in) :: shiftE, shiftM1, shiftM2 + ! character(len=1), intent(in) :: dirM1, dirM2 + + ! integer :: i, j, k, m, m_shift1, m_shift2 + ! integer, allocatable :: indexList(:) + ! integer :: Nx, Ny, Nz + + ! Nx = field%Nx + 2 + ! Ny = field%Ny + 2 + ! Nz = field%Nz + 2 + + ! do i = 1, Nx - 2 + ! do j = 1, Ny - 2 + ! do k = 1, Nz - 2 + ! m = (i*Ny + j)*Nz + k + + ! select case (dirM1) + ! case ('i') + ! m_shift1 = ((i - 1)*Ny + j)*Nz + k + ! case ('j') + ! m_shift1 = (i*Ny + (j - 1))*Nz + k + ! case ('k') + ! m_shift1 = (i*Ny + j)*Nz + (k - 1) + ! end select + + ! select case (dirM2) + ! case ('i') + ! m_shift2 = ((i - 1)*Ny + j)*Nz + k + ! case ('j') + ! m_shift2 = (i*Ny + (j - 1))*Nz + k + ! case ('k') + ! m_shift2 = (i*Ny + j)*Nz + (k - 1) + ! end select + + ! allocate(indexList(5)) + ! indexList(1) = shiftE + m + ! indexList(2) = shiftM1 + m + ! indexList(3) = shiftM1 + m_shift2 + ! indexList(4) = shiftM2 + m + ! indexList(5) = shiftM2 + m_shift1 + + ! call RowIndexMap%set(key(shiftE + m), value=indexList) + + ! deallocate(indexList) + ! end do + ! end do + ! end do + ! end subroutine + + ! subroutine AddMagneticFieldIndices(RowIndexMap, field, shiftH, shiftE1, shiftE2, dir1, dir2) + ! type(fhash_tbl_t), intent(inout) :: RowIndexMap + ! type(limit_t), intent(in) :: field + ! integer, intent(in) :: shiftH, shiftE1, shiftE2 + ! character(len=1), intent(in) :: dir1, dir2 + + ! integer :: i, j, k, m, m_shift1, m_shift2 + ! integer :: Nx, Ny, Nz + ! integer, allocatable :: temp(:), indexList(:) + ! integer, allocatable :: aux1(:), aux2(:), aux3(:), aux4(:) + ! integer :: totalSize + + ! Nx = field%Nx + 2 + ! Ny = field%Ny + 2 + ! Nz = field%Nz + 2 + + ! do i = 1, Nx - 2 + ! do j = 1, Ny - 2 + ! do k = 1, Nz - 2 + ! m = (i*Ny + j)*Nz + k + + ! select case (dir1) + ! case ('i') + ! m_shift1 = ((i + 1)*Ny + j)*Nz + k + ! case ('j') + ! m_shift1 = (i*Ny + (j + 1))*Nz + k + ! case ('k') + ! m_shift1 = (i*Ny + j)*Nz + (k + 1) + ! end select + + ! select case (dir2) + ! case ('i') + ! m_shift2 = ((i + 1)*Ny + j)*Nz + k + ! case ('j') + ! m_shift2 = (i*Ny + (j + 1))*Nz + k + ! case ('k') + ! m_shift2 = (i*Ny + j)*Nz + (k + 1) + ! end select + + ! call RowIndexMap%get(key(shiftE1 + m), aux1) + ! call RowIndexMap%get(key(shiftE1 + m_shift1), aux2) + ! call RowIndexMap%get(key(shiftE2 + m), aux3) + ! call RowIndexMap%get(key(shiftE2 + m_shift2), aux4) + + ! totalSize = size(aux1) + size(aux2) + size(aux3) + size(aux4) + ! allocate(temp(totalSize)) + ! temp(1:size(aux1)) = aux1 + ! temp(size(aux1)+1:size(aux1)+size(aux2)) = aux2 + ! temp(size(aux1)+size(aux2)+1:size(aux1)+size(aux2)+size(aux3)) = aux3 + ! temp(size(aux1)+size(aux2)+size(aux3)+1:) = aux4 + + ! call RemoveDuplicates(temp, indexList) + + + ! call RowIndexMap%set(key(shiftH + m), value=indexList) + + ! deallocate(temp, indexList, aux1, aux2, aux3, aux4) + ! end do + ! end do + ! end do + ! end subroutine + + ! subroutine AddBoundaryIndices(RowIndexMap, sggBorder, field, shiftField, dir): + ! type(fhash_tbl_t), intent(inout) :: RowIndexMap + ! type(Border_t), intent(in) :: sggBorder + ! type(limit_t), intent(in) :: field + + ! integer, intent(in) :: shiftField + ! character(len=1), intent(in) :: dir + + ! !Hx Down + ! if (sggBorder%IsDownPMC) then + ! if (layoutnumber == 0) Hx( : , : ,C(iHx)%ZI-1)=-Hx( : , : ,C(iHx)%ZI) + ! endif + ! !Hx Up + ! if (sggBorder%IsUpPMC) then + ! if (layoutnumber == size-1) Hx( : , : ,C(iHx)%ZE+1)=-Hx( : , : ,C(iHx)%ZE) + ! endif + ! !Hx Left + ! if (sggBorder%IsLeftPMC) then + ! Hx( : ,C(iHx)%YI-1, : )=-Hx( : ,C(iHx)%YI, : ) + ! endif + ! !Hx Right + ! if (sggBorder%IsRightPMC) then + ! Hx( : ,C(iHx)%YE+1, : )=-Hx( : ,C(iHx)%YE, : ) + ! endif + ! !Hy Back + ! if (sggBorder%IsBackPMC) then + ! Hy(C(iHy)%XI-1, : , : )=-Hy(C(iHy)%XI, : , : ) + ! endif + ! !Hy Front + ! if (sggBorder%IsFrontPMC) then + ! Hy(C(iHy)%XE+1, : , : )=-Hy(C(iHy)%XE, : , : ) + ! endif + ! !Hy Down + ! if (sggBorder%IsDownPMC) then + ! if (layoutnumber == 0) Hy( : , : ,C(iHy)%ZI-1)=-Hy( : , : ,C(iHy)%ZI) + ! endif + ! !Hy Up + ! if (sggBorder%IsUpPMC) then + ! if (layoutnumber == size-1) Hy( : , : ,C(iHy)%ZE+1)=-Hy( : , : ,C(iHy)%ZE) + ! endif + ! ! + ! !Hz Back + ! if (sggBorder%IsBackPMC) then + ! Hz(C(iHz)%XI-1, : , : )=-Hz(C(iHz)%XI, : , : ) + ! endif + ! !Hz Front + ! if (sggBorder%IsFrontPMC) then + ! Hz(C(iHz)%XE+1, : , : )=-Hz(C(iHz)%XE, : , : ) + ! endif + ! !Hz Left + ! if (sggBorder%IsLeftPMC) then + ! Hz( : ,C(iHz)%YI-1, : )=-Hz( : ,C(iHz)%YI, : ) + ! endif + ! !Hz Right + ! if (sggBorder%IsRightPMC) then + ! Hz( : ,C(iHz)%YE+1, : )=-Hz( : ,C(iHz)%YE, : ) + ! endif + + ! end subroutine - subroutine RemoveDuplicates(inputArray, outputArray) - integer, intent(in) :: inputArray(:) - integer, allocatable, intent(out) :: outputArray(:) - integer :: i, j, n - logical :: found - integer, allocatable :: temp(:) - - allocate(temp(size(inputArray))) - n = 0 - - do i = 1, size(inputArray) - found = .false. - do j = 1, n - if (temp(j) == inputArray(i)) then - found = .true. - exit - end if - end do - if (.not. found) then - n = n + 1 - temp(n) = inputArray(i) - end if - end do - - allocate(outputArray(n)) - outputArray = temp(1:n) - deallocate(temp) - end subroutine - - subroutine GenerateRowIndexMap(b, RowIndexMap) - - type(bounds_t), intent(IN) :: b - type(fhash_tbl), intent(OUT) :: RowIndexMap - integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz - - shiftEx = 0 - shiftEy = b%sweepEx%Nx * b%sweepEx%Ny * b%sweepEx%Nz - shiftEz = shiftEy + b%sweepEy%Nx * b%sweepEy%Ny * b%sweepEy%Nz - shiftHx = shiftEz + b%sweepEz%Nx * b%sweepEz%Ny * b%sweepEz%Nz - shiftHy = shiftHx + b%sweepHx%Nx * b%sweepHx%Ny * b%sweepHx%Nz - shiftHz = shiftHy + b%sweepHy%Nx * b%sweepHy%Ny * b%sweepHy%Nz - - call AddElectricFieldIndices(RowIndexMap, b%sweepEx, shiftEx, shiftHy, shiftHz, 'k', 'j') - call AddElectricFieldIndices(RowIndexMap, b%sweepEy, shiftEy, shiftHx, shiftHz, 'k', 'i') - call AddElectricFieldIndices(RowIndexMap, b%sweepEz, shiftEz, shiftHx, shiftHy, 'j', 'i') - - ! Before the magnetic fields, it is necessary to create the map of indices related to the boundary conditions - - call AddMagneticFieldIndices(RowIndexMap, b%sweepHx, shiftHx, shiftEy, shiftEz, 'k', 'j') - call AddMagneticFieldIndices(RowIndexMap, b%sweepHy, shiftHy, shiftEx, shiftEz, 'k', 'i') - call AddMagneticFieldIndices(RowIndexMap, b%sweepHz, shiftHz, shiftEx, shiftEy, 'j', 'i') - - ! And also, it seems to be boundary conditions for the magnetic fields, so we need to add them as well - - - end subroutine \ No newline at end of file +! subroutine RemoveDuplicates(inputArray, outputArray) +! integer, intent(in) :: inputArray(:) +! integer, allocatable, intent(out) :: outputArray(:) +! integer :: i, j, n +! logical :: found +! integer, allocatable :: temp(:) + +! allocate(temp(size(inputArray))) +! n = 0 + +! do i = 1, size(inputArray) +! found = .false. +! do j = 1, n +! if (temp(j) == inputArray(i)) then +! found = .true. +! exit +! end if +! end do +! if (.not. found) then +! n = n + 1 +! temp(n) = inputArray(i) +! end if +! end do + +! allocate(outputArray(n)) +! outputArray = temp(1:n) +! deallocate(temp) +! end subroutine + +! subroutine GenerateRowIndexMap(b, RowIndexMap) + +! type(bounds_t), intent(IN) :: b +! type(fhash_tbl_t), intent(OUT) :: RowIndexMap +! integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz + +! shiftEx = 0 +! shiftEy = b%Ex%Nx * b%Ex%Ny * b%Ex%Nz +! shiftEz = shiftEy + b%Ey%Nx * b%Ey%Ny * b%Ey%Nz +! shiftHx = shiftEz + b%Ez%Nx * b%Ez%Ny * b%Ez%Nz +! shiftHy = shiftHx + b%Hx%Nx * b%Hx%Ny * b%Hx%Nz +! shiftHz = shiftHy + b%Hy%Nx * b%Hy%Ny * b%Hy%Nz + +! call AddElectricFieldIndices(RowIndexMap, b%sweepEx, shiftEx, shiftHy, shiftHz, 'k', 'j') +! call AddElectricFieldIndices(RowIndexMap, b%sweepEy, shiftEy, shiftHx, shiftHz, 'k', 'i') +! call AddElectricFieldIndices(RowIndexMap, b%sweepEz, shiftEz, shiftHx, shiftHy, 'j', 'i') + +! ! Before the magnetic fields, it is necessary to create the map of indices related to the boundary conditions + +! call AddMagneticFieldIndices(RowIndexMap, b%sweepHx, shiftHx, shiftEy, shiftEz, 'k', 'j') +! call AddMagneticFieldIndices(RowIndexMap, b%sweepHy, shiftHy, shiftEx, shiftEz, 'k', 'i') +! call AddMagneticFieldIndices(RowIndexMap, b%sweepHz, shiftHz, shiftEx, shiftEy, 'j', 'i') + +! ! And also, it seems to be boundary conditions for the magnetic fields, so we need to add them as well + + +! end subroutine + +end module \ No newline at end of file From c0d6fff55ccdfb10ca2ca2cb39d099cb0642bbd5 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Mon, 21 Jul 2025 13:01:51 +0200 Subject: [PATCH 40/56] Created tests to verify the correct operation of the generation of input basis for the electrical and magnetical fields for the evolution operator --- src_json_parser/CMakeLists.txt | 1 + test/smbjson/CMakeLists.txt | 1 + test/smbjson/smbjson_tests.h | 8 ++ test/smbjson/test_evolution_operator.F90 | 128 ++++++++++++++++++++--- 4 files changed, 126 insertions(+), 12 deletions(-) diff --git a/src_json_parser/CMakeLists.txt b/src_json_parser/CMakeLists.txt index ebbe2386..8b93862c 100755 --- a/src_json_parser/CMakeLists.txt +++ b/src_json_parser/CMakeLists.txt @@ -20,6 +20,7 @@ add_library(smbjson "mesh.F90" "parser_tools.F90" "nfdetypes_extension.F90" + "../src_main_pub/evolution_operator.F90" ) target_link_libraries(smbjson PRIVATE jsonfortran semba-types semba-reports fhash) \ No newline at end of file diff --git a/test/smbjson/CMakeLists.txt b/test/smbjson/CMakeLists.txt index 40387afe..3ac03a29 100644 --- a/test/smbjson/CMakeLists.txt +++ b/test/smbjson/CMakeLists.txt @@ -16,6 +16,7 @@ add_library (smbjson_test_fortran "test_read_sphere.F90" "test_read_airplane.F90" "test_read_lumped_fixture.F90" + "test_evolution_operator.F90" ) if(SEMBA_FDTD_ENABLE_MTLN) target_sources(smbjson_test_fortran PRIVATE diff --git a/test/smbjson/smbjson_tests.h b/test/smbjson/smbjson_tests.h index f1d5a25f..af0ffd3d 100644 --- a/test/smbjson/smbjson_tests.h +++ b/test/smbjson/smbjson_tests.h @@ -29,6 +29,10 @@ extern "C" int test_read_large_airplane_mtln(); extern "C" int test_read_lumped_fixture(); extern "C" int test_read_unshielded_multiwires_multipolar_expansion(); +extern "C" int test_evolution_operator_dimension_Field_basis(); +extern "C" int test_evolution_operator_poisition_E_basis(); +extern "C" int test_evolution_operator_position_H_basis(); + TEST(smbjson, idchildtable_fhash) {EXPECT_EQ(0, test_idchildtable_fhash()); } TEST(smbjson, idchildtable_add_get) {EXPECT_EQ(0, test_idchildtable()); } @@ -49,6 +53,10 @@ TEST(smbjson, read_sphere) { EXPECT_EQ(0, test_read_sphere()); } TEST(smbjson, read_airplane) { EXPECT_EQ(0, test_read_airplane()); } TEST(smbjson, read_lumped_fixture) { EXPECT_EQ(0, test_read_lumped_fixture()); } +TEST(smbjson, evolutionOperator_BasisDimension) { EXPECT_EQ(0, test_evolution_operator_dimension_Field_basis()); } +TEST(smbjson, evolutionOperator_PositionEBasis) { EXPECT_EQ(0, test_evolution_operator_poisition_E_basis()); } +TEST(smbjson, evolutionOperator_PositionHBasis) { EXPECT_EQ(0, test_evolution_operator_position_H_basis()); } + #ifdef CompileWithMTLN TEST(smbjson, read_towelhanger) { EXPECT_EQ(0, test_read_towelhanger()); } TEST(smbjson, read_holland1981) { EXPECT_EQ(0, test_read_holland1981()); } diff --git a/test/smbjson/test_evolution_operator.F90 b/test/smbjson/test_evolution_operator.F90 index bce0264e..dabab126 100644 --- a/test/smbjson/test_evolution_operator.F90 +++ b/test/smbjson/test_evolution_operator.F90 @@ -1,38 +1,142 @@ -integer function test_evolution_operator_numberOfField_basis() bind (C) result(err) +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 implicit none - type(evolution_operator) :: evolOp + 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 - call evolOp%GenerateInputFieldsBasis() - if (evolOp%numberOfField_basis /= 66) err = err + 1 + 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 -integer function test_evolution_operator_oneStep() bind (C) result(err) + 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_poisition_E_basis() bind(C, name="test_evolution_operator_poisition_E_basis") result(err) use smbjson use smbjson_testingTools use evolution_operator implicit none - type(evolution_operator) :: evolOp + 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 evolOp%GenerateOperator() + call GenerateElectricalInputBasis(M_E, dim1, dim2, M_ee, M_eo, M_oe, M_oo) - ExternalField_t :: field + 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 - expected_field = smbjson%step(field) - result_field = evolOp%step(field, 1) + 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 - if (any(expected_field%field /= result_field%field)) then + 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_oneStep +end function test_evolution_operator_poisition_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_oneStep() bind (C) result(err) +! use smbjson +! use smbjson_testingTools +! use evolution_operator + +! implicit none + +! type(evolution_operator) :: evolOp + +! err = 0 + +! call evolOp%GenerateOperator() + +! ExternalField_t :: field + +! expected_field = smbjson%step(field) +! result_field = evolOp%step(field, 1) + +! if (any(expected_field%field /= result_field%field)) then +! err = err + 1 +! end if + +! end function test_evolution_operator_oneStep From aa3aacc2280e89473033c7a1e4621f63c4a0f835 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Thu, 24 Jul 2025 13:47:04 +0200 Subject: [PATCH 41/56] Add AddElectricFieldIndices subroutine and corresponding test case for E indices mapping. To do: fix the correct storage in the fhash map and make an actual test --- src_main_pub/evolution_operator.F90 | 193 +++++++++++++++++------ test/smbjson/smbjson_tests.h | 2 + test/smbjson/test_evolution_operator.F90 | 28 +++- 3 files changed, 170 insertions(+), 53 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index a705b7b2..358dbd7c 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -14,9 +14,13 @@ module evolution_operator character(len=2) :: field_type ! 'Ex', 'Ey', 'Ez', 'Hx', etc. end type + type :: int_array + integer, allocatable :: data(:) + end type + private - public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis + public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices contains @@ -248,57 +252,142 @@ subroutine GenerateInputFieldsBasis(b, FieldList) ! end subroutine - ! subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, dirM1, dirM2) - ! type(fhash_tbl_t), intent(inout) :: RowIndexMap - ! type(limit_t), intent(in) :: field - ! integer, intent(in) :: shiftE, shiftM1, shiftM2 - ! character(len=1), intent(in) :: dirM1, dirM2 - - ! integer :: i, j, k, m, m_shift1, m_shift2 - ! integer, allocatable :: indexList(:) - ! integer :: Nx, Ny, Nz - - ! Nx = field%Nx + 2 - ! Ny = field%Ny + 2 - ! Nz = field%Nz + 2 - - ! do i = 1, Nx - 2 - ! do j = 1, Ny - 2 - ! do k = 1, Nz - 2 - ! m = (i*Ny + j)*Nz + k - - ! select case (dirM1) - ! case ('i') - ! m_shift1 = ((i - 1)*Ny + j)*Nz + k - ! case ('j') - ! m_shift1 = (i*Ny + (j - 1))*Nz + k - ! case ('k') - ! m_shift1 = (i*Ny + j)*Nz + (k - 1) - ! end select - - ! select case (dirM2) - ! case ('i') - ! m_shift2 = ((i - 1)*Ny + j)*Nz + k - ! case ('j') - ! m_shift2 = (i*Ny + (j - 1))*Nz + k - ! case ('k') - ! m_shift2 = (i*Ny + j)*Nz + (k - 1) - ! end select - - ! allocate(indexList(5)) - ! indexList(1) = shiftE + m - ! indexList(2) = shiftM1 + m - ! indexList(3) = shiftM1 + m_shift2 - ! indexList(4) = shiftM2 + m - ! indexList(5) = shiftM2 + m_shift1 - - ! call RowIndexMap%set(key(shiftE + m), value=indexList) - - ! deallocate(indexList) - ! end do - ! end do - ! end do - ! end subroutine + subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, dirM1, dirM2) + type(fhash_tbl_t), intent(inout) :: RowIndexMap + type(limit_t), intent(in) :: field + integer, intent(in) :: shiftE, shiftM1, shiftM2 + character(len=1), intent(in) :: dirM1, dirM2 + + integer :: i, j, k, m, m_shift1, m_shift2 + integer :: Nx, Ny, Nz + + type(int_array) :: wrapper + integer, allocatable :: indexList(:) + integer :: countIndex, positionList + + Nx = field%Nx + Ny = field%Ny + Nz = field%Nz + + do i = 1, Nx + do j = 1, Ny + do k = 1, Nz + m = ((i - 1)*Ny + (j - 1))*Nz + k + countIndex = 1 + positionList = 1 + + select case (dirM1) + case ('i') + if (i > 1 .and. i < Nx) then + m_shift1 = ((i - 2)*Ny + (j - 1))*Nz + k + countIndex = countIndex + 2 + else if (i == 1) then + m_shift1 = -1 + countIndex = countIndex + 1 + else + m_shift1 = -2 + countIndex = countIndex + 1 + end if + case ('j') + if (j > 1 .and. j < Ny) then + m_shift1 = ((i - 1)*Ny + (j - 2))*Nz + k + countIndex = countIndex + 2 + else if (j == 1) then + m_shift1 = -1 + countIndex = countIndex + 1 + else + m_shift1 = -2 + countIndex = countIndex + 1 + end if + case ('k') + if (k > 1 .and. k < Nz) then + m_shift1 = ((i - 1)*Ny + (j - 1))*Nz + (k - 1) + countIndex = countIndex + 2 + else if (k == 1) then + m_shift1 = -1 + countIndex = countIndex + 1 + else + m_shift1 = -2 + countIndex = countIndex + 1 + end if + end select + + select case (dirM2) + case ('i') + if (i > 1 .and. i < Nx) then + m_shift2 = ((i - 2)*Ny + (j - 1))*Nz + k + countIndex = countIndex + 2 + else if (i == 1) then + m_shift2 = -1 + countIndex = countIndex + 1 + else + m_shift2 = -2 + countIndex = countIndex + 1 + end if + case ('j') + if (j > 1 .and. j < Ny) then + m_shift2 = ((i - 1)*Ny + (j - 2))*Nz + k + countIndex = countIndex + 2 + else if (j == 1) then + m_shift2 = -1 + countIndex = countIndex + 1 + else + m_shift2 = -2 + countIndex = countIndex + 1 + end if + case ('k') + if (k > 1 .and. k < Nz) then + m_shift2 = ((i - 1)*Ny + (j - 1))*Nz + (k - 1) + countIndex = countIndex + 2 + else if (k == 1) then + m_shift2 = -1 + countIndex = countIndex + 1 + else + m_shift2 = -2 + countIndex = countIndex + 1 + end if + end select + + ! Allocate the indexList with the size of countIndex + allocate(indexList(countIndex)) + + indexList(positionList) = shiftE + m + positionList = positionList + 1 + + if (m_shift2 /= -1 .and. m_shift2 /= -2) then + indexList(positionList) = shiftM1 + m + indexList(positionList + 1) = shiftM1 + m_shift2 + positionList = positionList + 2 + else if (m_shift2 == -1) then ! Border at the beginning + indexList(positionList) = shiftM1 + m + positionList = positionList + 1 + else ! Border at the end + indexList(positionList) = shiftM1 + m_shift2 + positionList = positionList + 1 + end if + + + if (m_shift1 /= -1 .and. m_shift1 /= -2) then + indexList(positionList) = shiftM2 + m + indexList(positionList + 1) = shiftM2 + m_shift1 + positionList = positionList + 2 + else if (m_shift1 == -1) then ! Border at the beginning + indexList(positionList) = shiftM2 + m + positionList = positionList + 1 + else ! Border at the end + indexList(positionList) = shiftM2 + m_shift1 + positionList = positionList + 1 + end if + + wrapper%data = indexList + call RowIndexMap%set(key(shiftE + m), wrapper) + + + deallocate(indexList) + end do + end do + end do + end subroutine ! subroutine AddMagneticFieldIndices(RowIndexMap, field, shiftH, shiftE1, shiftE2, dir1, dir2) ! type(fhash_tbl_t), intent(inout) :: RowIndexMap diff --git a/test/smbjson/smbjson_tests.h b/test/smbjson/smbjson_tests.h index af0ffd3d..988bc0f4 100644 --- a/test/smbjson/smbjson_tests.h +++ b/test/smbjson/smbjson_tests.h @@ -32,6 +32,7 @@ extern "C" int test_read_unshielded_multiwires_multipolar_expansion(); extern "C" int test_evolution_operator_dimension_Field_basis(); extern "C" int test_evolution_operator_poisition_E_basis(); extern "C" int test_evolution_operator_position_H_basis(); +extern "C" int test_evolution_operator_E_indices_map(); TEST(smbjson, idchildtable_fhash) {EXPECT_EQ(0, test_idchildtable_fhash()); } TEST(smbjson, idchildtable_add_get) {EXPECT_EQ(0, test_idchildtable()); } @@ -56,6 +57,7 @@ TEST(smbjson, read_lumped_fixture) { EXPECT_EQ(0, test_read_lumped_fixture TEST(smbjson, evolutionOperator_BasisDimension) { EXPECT_EQ(0, test_evolution_operator_dimension_Field_basis()); } TEST(smbjson, evolutionOperator_PositionEBasis) { EXPECT_EQ(0, test_evolution_operator_poisition_E_basis()); } TEST(smbjson, evolutionOperator_PositionHBasis) { EXPECT_EQ(0, test_evolution_operator_position_H_basis()); } +TEST(smbjson, evolutionOperator_EIndicesMap) { EXPECT_EQ(0, test_evolution_operator_E_indices_map()); } #ifdef CompileWithMTLN TEST(smbjson, read_towelhanger) { EXPECT_EQ(0, test_read_towelhanger()); } diff --git a/test/smbjson/test_evolution_operator.F90 b/test/smbjson/test_evolution_operator.F90 index dabab126..083056e8 100644 --- a/test/smbjson/test_evolution_operator.F90 +++ b/test/smbjson/test_evolution_operator.F90 @@ -1,7 +1,8 @@ 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 evolution_operator + use fhash, only: fhash_tbl_t, key => fhash_key implicit none @@ -117,6 +118,31 @@ 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 + + implicit none + + integer :: i, j, k + type(bounds_t) :: bounds + type(fhash_tbl_t) :: RowIndexMap + + bounds%Ex%NX = 2 + bounds%Ex%NY = 3 + bounds%Ex%NZ = 3 + + err = 0 + + call AddElectricFieldIndices(RowIndexMap, bounds%Ex, 0, 0, 0, 'k', 'j') + + if (0 /= 0) then + err = err + 1 + end if + +end function test_evolution_operator_E_indices_map + ! integer function test_evolution_operator_oneStep() bind (C) result(err) ! use smbjson ! use smbjson_testingTools From b6172d6ae291290a821121e768cdde921b4b0a1d Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Fri, 25 Jul 2025 12:33:35 +0200 Subject: [PATCH 42/56] Created get function to extract the information from the fhash tbl with int_array type --- src_main_pub/evolution_operator.F90 | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 358dbd7c..5a5e0a18 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -5,7 +5,7 @@ module evolution_operator use fdetypes use Report - use fhash, only: fhash_tbl_t, key => fhash_key + use fhash, key => fhash_key implicit none @@ -20,7 +20,7 @@ module evolution_operator private - public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices + public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, fhash_get_int_array, int_array contains @@ -380,7 +380,7 @@ subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, end if wrapper%data = indexList - call RowIndexMap%set(key(shiftE + m), wrapper) + call RowIndexMap%set(key(shiftE + m), value=wrapper) deallocate(indexList) @@ -568,4 +568,27 @@ subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, ! end subroutine + 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 + end module \ No newline at end of file From 1040c140adafe40a78f46e6c970144159d82ae43 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Fri, 25 Jul 2025 12:34:04 +0200 Subject: [PATCH 43/56] Enhance test for electric field indices mapping by verifying the integrity of the RowIndexMap and checking neighbor counts in the grid. --- test/smbjson/test_evolution_operator.F90 | 49 +++++++++++++++++++++++- 1 file changed, 48 insertions(+), 1 deletion(-) diff --git a/test/smbjson/test_evolution_operator.F90 b/test/smbjson/test_evolution_operator.F90 index 083056e8..aa9c14a0 100644 --- a/test/smbjson/test_evolution_operator.F90 +++ b/test/smbjson/test_evolution_operator.F90 @@ -122,22 +122,69 @@ integer function test_evolution_operator_E_indices_map() bind(C, name="test_evol 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 = 3 err = 0 + ElementsInMap = 0 call AddElectricFieldIndices(RowIndexMap, bounds%Ex, 0, 0, 0, 'k', 'j') - if (0 /= 0) then + 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 From c7b628f8ddeeda14f58eca99cee05bc060a372a3 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Mon, 8 Sep 2025 09:59:50 +0200 Subject: [PATCH 44/56] Add AddMagneticFieldIndices subroutine and corresponding test case for H indices mapping --- src_main_pub/evolution_operator.F90 | 237 +++++++++-------------- test/smbjson/smbjson_tests.h | 2 + test/smbjson/test_evolution_operator.F90 | 84 ++++++-- 3 files changed, 157 insertions(+), 166 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 5a5e0a18..6a6a7b1a 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -20,7 +20,7 @@ module evolution_operator private - public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, fhash_get_int_array, int_array + public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array contains @@ -389,156 +389,97 @@ subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, end do end subroutine - ! subroutine AddMagneticFieldIndices(RowIndexMap, field, shiftH, shiftE1, shiftE2, dir1, dir2) - ! type(fhash_tbl_t), intent(inout) :: RowIndexMap - ! type(limit_t), intent(in) :: field - ! integer, intent(in) :: shiftH, shiftE1, shiftE2 - ! character(len=1), intent(in) :: dir1, dir2 - - ! integer :: i, j, k, m, m_shift1, m_shift2 - ! integer :: Nx, Ny, Nz - ! integer, allocatable :: temp(:), indexList(:) - ! integer, allocatable :: aux1(:), aux2(:), aux3(:), aux4(:) - ! integer :: totalSize - - ! Nx = field%Nx + 2 - ! Ny = field%Ny + 2 - ! Nz = field%Nz + 2 - - ! do i = 1, Nx - 2 - ! do j = 1, Ny - 2 - ! do k = 1, Nz - 2 - ! m = (i*Ny + j)*Nz + k - - ! select case (dir1) - ! case ('i') - ! m_shift1 = ((i + 1)*Ny + j)*Nz + k - ! case ('j') - ! m_shift1 = (i*Ny + (j + 1))*Nz + k - ! case ('k') - ! m_shift1 = (i*Ny + j)*Nz + (k + 1) - ! end select - - ! select case (dir2) - ! case ('i') - ! m_shift2 = ((i + 1)*Ny + j)*Nz + k - ! case ('j') - ! m_shift2 = (i*Ny + (j + 1))*Nz + k - ! case ('k') - ! m_shift2 = (i*Ny + j)*Nz + (k + 1) - ! end select - - ! call RowIndexMap%get(key(shiftE1 + m), aux1) - ! call RowIndexMap%get(key(shiftE1 + m_shift1), aux2) - ! call RowIndexMap%get(key(shiftE2 + m), aux3) - ! call RowIndexMap%get(key(shiftE2 + m_shift2), aux4) - - ! totalSize = size(aux1) + size(aux2) + size(aux3) + size(aux4) - ! allocate(temp(totalSize)) - ! temp(1:size(aux1)) = aux1 - ! temp(size(aux1)+1:size(aux1)+size(aux2)) = aux2 - ! temp(size(aux1)+size(aux2)+1:size(aux1)+size(aux2)+size(aux3)) = aux3 - ! temp(size(aux1)+size(aux2)+size(aux3)+1:) = aux4 - - ! call RemoveDuplicates(temp, indexList) - - - ! call RowIndexMap%set(key(shiftH + m), value=indexList) - - ! deallocate(temp, indexList, aux1, aux2, aux3, aux4) - ! end do - ! end do - ! end do - ! end subroutine + subroutine AddMagneticFieldIndices(RowIndexMap, field, shiftH, shiftE1, shiftE2, dir1, dir2) + type(fhash_tbl_t), intent(inout) :: RowIndexMap + type(limit_t), intent(in) :: field + integer, intent(in) :: shiftH, shiftE1, shiftE2 + character(len=1), intent(in) :: dir1, dir2 - ! subroutine AddBoundaryIndices(RowIndexMap, sggBorder, field, shiftField, dir): - ! type(fhash_tbl_t), intent(inout) :: RowIndexMap - ! type(Border_t), intent(in) :: sggBorder - ! type(limit_t), intent(in) :: field - - ! integer, intent(in) :: shiftField - ! character(len=1), intent(in) :: dir - - ! !Hx Down - ! if (sggBorder%IsDownPMC) then - ! if (layoutnumber == 0) Hx( : , : ,C(iHx)%ZI-1)=-Hx( : , : ,C(iHx)%ZI) - ! endif - ! !Hx Up - ! if (sggBorder%IsUpPMC) then - ! if (layoutnumber == size-1) Hx( : , : ,C(iHx)%ZE+1)=-Hx( : , : ,C(iHx)%ZE) - ! endif - ! !Hx Left - ! if (sggBorder%IsLeftPMC) then - ! Hx( : ,C(iHx)%YI-1, : )=-Hx( : ,C(iHx)%YI, : ) - ! endif - ! !Hx Right - ! if (sggBorder%IsRightPMC) then - ! Hx( : ,C(iHx)%YE+1, : )=-Hx( : ,C(iHx)%YE, : ) - ! endif - ! !Hy Back - ! if (sggBorder%IsBackPMC) then - ! Hy(C(iHy)%XI-1, : , : )=-Hy(C(iHy)%XI, : , : ) - ! endif - ! !Hy Front - ! if (sggBorder%IsFrontPMC) then - ! Hy(C(iHy)%XE+1, : , : )=-Hy(C(iHy)%XE, : , : ) - ! endif - ! !Hy Down - ! if (sggBorder%IsDownPMC) then - ! if (layoutnumber == 0) Hy( : , : ,C(iHy)%ZI-1)=-Hy( : , : ,C(iHy)%ZI) - ! endif - ! !Hy Up - ! if (sggBorder%IsUpPMC) then - ! if (layoutnumber == size-1) Hy( : , : ,C(iHy)%ZE+1)=-Hy( : , : ,C(iHy)%ZE) - ! endif - ! ! - ! !Hz Back - ! if (sggBorder%IsBackPMC) then - ! Hz(C(iHz)%XI-1, : , : )=-Hz(C(iHz)%XI, : , : ) - ! endif - ! !Hz Front - ! if (sggBorder%IsFrontPMC) then - ! Hz(C(iHz)%XE+1, : , : )=-Hz(C(iHz)%XE, : , : ) - ! endif - ! !Hz Left - ! if (sggBorder%IsLeftPMC) then - ! Hz( : ,C(iHz)%YI-1, : )=-Hz( : ,C(iHz)%YI, : ) - ! endif - ! !Hz Right - ! if (sggBorder%IsRightPMC) then - ! Hz( : ,C(iHz)%YE+1, : )=-Hz( : ,C(iHz)%YE, : ) - ! endif + integer :: i, j, k, m, m_shift1, m_shift2 + integer :: Nx, Ny, Nz + integer, allocatable :: temp(:), indexList(:) + type(int_array) :: aux1, aux2, aux3, aux4, wrapper + integer :: totalSize - ! end subroutine + Nx = field%Nx + Ny = field%Ny + Nz = field%Nz + + do i = 1, Nx + do j = 1, Ny + do k = 1, Nz + m = ((i - 1)*Ny + (j - 1))*Nz + k + + select case (dir1) + case ('i') + m_shift1 = (i*Ny + (j - 1))*Nz + k + case ('j') + m_shift1 = ((i - 1)*Ny + j)*Nz + k + case ('k') + m_shift1 = ((i - 1)*Ny + (j - 1))*Nz + (k + 1) + end select + + select case (dir2) + case ('i') + m_shift2 = (i*Ny + (j - 1))*Nz + k + case ('j') + m_shift2 = ((i - 1)*Ny + j)*Nz + k + case ('k') + m_shift2 = ((i - 1)*Ny + (j - 1))*Nz + (k + 1) + end select + + call fhash_get_int_array(RowIndexMap, key(shiftE1 + m), aux1) + call fhash_get_int_array(RowIndexMap, key(shiftE1 + m_shift1), aux2) + call fhash_get_int_array(RowIndexMap, key(shiftE2 + m), aux3) + call fhash_get_int_array(RowIndexMap, key(shiftE2 + m_shift2), aux4) + + totalSize = size(aux1%data) + size(aux2%data) + size(aux3%data) + size(aux4%data) + allocate(temp(totalSize)) + temp(1:size(aux1%data)) = aux1%data + temp(size(aux1%data)+1:size(aux1%data)+size(aux2%data)) = aux2%data + temp(size(aux1%data)+size(aux2%data)+1:size(aux1%data)+size(aux2%data)+size(aux3%data)) = aux3%data + temp(size(aux1%data)+size(aux2%data)+size(aux3%data)+1:) = aux4%data + + call RemoveDuplicates(temp, indexList) + + wrapper%data = indexList + + call RowIndexMap%set(key(shiftH + m), value=wrapper) + + deallocate(temp, indexList) + 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 :: temp(:) - -! allocate(temp(size(inputArray))) -! n = 0 - -! do i = 1, size(inputArray) -! found = .false. -! do j = 1, n -! if (temp(j) == inputArray(i)) then -! found = .true. -! exit -! end if -! end do -! if (.not. found) then -! n = n + 1 -! temp(n) = inputArray(i) -! end if -! end do - -! allocate(outputArray(n)) -! outputArray = temp(1:n) -! deallocate(temp) -! end subroutine + subroutine RemoveDuplicates(inputArray, outputArray) + integer, intent(in) :: inputArray(:) + integer, allocatable, intent(out) :: outputArray(:) + integer :: i, j, n + logical :: found + integer, allocatable :: temp(:) + + allocate(temp(size(inputArray))) + n = 0 + + do i = 1, size(inputArray) + found = .false. + do j = 1, n + if (temp(j) == inputArray(i)) then + found = .true. + exit + end if + end do + if (.not. found) then + n = n + 1 + temp(n) = inputArray(i) + end if + end do + + allocate(outputArray(n)) + outputArray = temp(1:n) + deallocate(temp) + end subroutine ! subroutine GenerateRowIndexMap(b, RowIndexMap) diff --git a/test/smbjson/smbjson_tests.h b/test/smbjson/smbjson_tests.h index 988bc0f4..7d2d4544 100644 --- a/test/smbjson/smbjson_tests.h +++ b/test/smbjson/smbjson_tests.h @@ -33,6 +33,7 @@ extern "C" int test_evolution_operator_dimension_Field_basis(); extern "C" int test_evolution_operator_poisition_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(); TEST(smbjson, idchildtable_fhash) {EXPECT_EQ(0, test_idchildtable_fhash()); } TEST(smbjson, idchildtable_add_get) {EXPECT_EQ(0, test_idchildtable()); } @@ -58,6 +59,7 @@ TEST(smbjson, evolutionOperator_BasisDimension) { EXPECT_EQ(0, test_evolu TEST(smbjson, evolutionOperator_PositionEBasis) { EXPECT_EQ(0, test_evolution_operator_poisition_E_basis()); } TEST(smbjson, evolutionOperator_PositionHBasis) { EXPECT_EQ(0, test_evolution_operator_position_H_basis()); } TEST(smbjson, evolutionOperator_EIndicesMap) { EXPECT_EQ(0, test_evolution_operator_E_indices_map()); } +TEST(smbjson, evolutionOperator_HIndicesMap) { EXPECT_EQ(0, test_evolution_operator_H_indices_map()); } #ifdef CompileWithMTLN TEST(smbjson, read_towelhanger) { EXPECT_EQ(0, test_read_towelhanger()); } diff --git a/test/smbjson/test_evolution_operator.F90 b/test/smbjson/test_evolution_operator.F90 index aa9c14a0..455ee41c 100644 --- a/test/smbjson/test_evolution_operator.F90 +++ b/test/smbjson/test_evolution_operator.F90 @@ -190,26 +190,74 @@ integer function test_evolution_operator_E_indices_map() bind(C, name="test_evol end function test_evolution_operator_E_indices_map -! integer function test_evolution_operator_oneStep() bind (C) result(err) -! use smbjson -! use smbjson_testingTools -! use evolution_operator - -! implicit none - -! type(evolution_operator) :: evolOp - -! err = 0 +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 -! call evolOp%GenerateOperator() + implicit none -! ExternalField_t :: field + integer :: i, j, k + integer :: m + type(bounds_t) :: bounds + type(fhash_tbl_t) :: RowIndexMap + type(int_array) :: wrapper + integer :: ElementsInMap -! expected_field = smbjson%step(field) -! result_field = evolOp%step(field, 1) + bounds%Hx%NX = 2 + bounds%Hx%NY = 3 + bounds%Hx%NZ = 3 -! if (any(expected_field%field /= result_field%field)) then -! err = err + 1 -! end if + err = 0 + ElementsInMap = 0 -! end function test_evolution_operator_oneStep + ! To verify the H indices map, first I need to create the map of all the Electic fields + + call AddMagneticFieldIndices(RowIndexMap, bounds%Hx, 0, 0, 0, 'k', 'j') + + ! 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(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%Hx%Ny) then + ! if (k == 1 .or. k == bounds%Hx%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%Hx%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%Hx%NX * bounds%Hx%NY * bounds%Hx%NZ) then + ! err = err + 1 + ! end if +end function test_evolution_operator_H_indices_map From 49650d895f5dbcdef6c513dd368bb04fe012c2b3 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Tue, 9 Sep 2025 13:47:26 +0200 Subject: [PATCH 45/56] Refactor AddElectricFieldIndices and AddMagneticFieldIndices subroutines for improved index mapping. --- src_main_pub/evolution_operator.F90 | 78 +++++++------ test/smbjson/test_evolution_operator.F90 | 142 +++++++++++++++-------- 2 files changed, 138 insertions(+), 82 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 6a6a7b1a..207d6b2e 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -252,62 +252,67 @@ subroutine GenerateInputFieldsBasis(b, FieldList) ! end subroutine - subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, dirM1, dirM2) + subroutine AddElectricFieldIndices(RowIndexMap, Efield, H1field, H2field, shiftE, shiftM1, shiftM2, dirM1, dirM2) type(fhash_tbl_t), intent(inout) :: RowIndexMap - type(limit_t), intent(in) :: field + type(limit_t), intent(in) :: Efield, H1field, H2field integer, intent(in) :: shiftE, shiftM1, shiftM2 character(len=1), intent(in) :: dirM1, dirM2 - integer :: i, j, k, m, m_shift1, m_shift2 + integer :: i, j, k, m, m_H1, m_H2, m_shift1, m_shift2, m_aux1, m_aux2 integer :: Nx, Ny, Nz type(int_array) :: wrapper integer, allocatable :: indexList(:) integer :: countIndex, positionList - Nx = field%Nx - Ny = field%Ny - Nz = field%Nz + Nx = Efield%Nx + Ny = Efield%Ny + Nz = Efield%Nz do i = 1, Nx do j = 1, Ny do k = 1, Nz m = ((i - 1)*Ny + (j - 1))*Nz + k + m_H1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + k + m_H2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + k countIndex = 1 positionList = 1 select case (dirM1) case ('i') if (i > 1 .and. i < Nx) then - m_shift1 = ((i - 2)*Ny + (j - 1))*Nz + k + m_shift1 = ((i - 2)*H1field%Ny + (j - 1))*H1field%Nz + k countIndex = countIndex + 2 else if (i == 1) then m_shift1 = -1 countIndex = countIndex + 1 else m_shift1 = -2 + m_aux1 = ((i - 2)*H1field%Ny + (j - 1))*H1field%Nz + k countIndex = countIndex + 1 end if case ('j') if (j > 1 .and. j < Ny) then - m_shift1 = ((i - 1)*Ny + (j - 2))*Nz + k + m_shift1 = ((i - 1)*H1field%Ny + (j - 2))*H1field%Nz + k countIndex = countIndex + 2 else if (j == 1) then m_shift1 = -1 countIndex = countIndex + 1 else m_shift1 = -2 + m_aux1 = ((i - 1)*H1field%Ny + (j - 2))*H1field%Nz + k countIndex = countIndex + 1 end if case ('k') if (k > 1 .and. k < Nz) then - m_shift1 = ((i - 1)*Ny + (j - 1))*Nz + (k - 1) + m_shift1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + (k - 1) countIndex = countIndex + 2 else if (k == 1) then m_shift1 = -1 countIndex = countIndex + 1 else m_shift1 = -2 + m_aux1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + (k - 1) countIndex = countIndex + 1 end if end select @@ -315,35 +320,38 @@ subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, select case (dirM2) case ('i') if (i > 1 .and. i < Nx) then - m_shift2 = ((i - 2)*Ny + (j - 1))*Nz + k + m_shift2 = ((i - 2)*H2field%Ny + (j - 1))*H2field%Nz + k countIndex = countIndex + 2 else if (i == 1) then m_shift2 = -1 countIndex = countIndex + 1 else m_shift2 = -2 + m_aux2 = ((i - 2)*H2field%Ny + (j - 1))*H2field%Nz + k countIndex = countIndex + 1 end if case ('j') if (j > 1 .and. j < Ny) then - m_shift2 = ((i - 1)*Ny + (j - 2))*Nz + k + m_shift2 = ((i - 1)*H2field%Ny + (j - 2))*H2field%Nz + k countIndex = countIndex + 2 else if (j == 1) then m_shift2 = -1 countIndex = countIndex + 1 else m_shift2 = -2 + m_aux2 = ((i - 1)*H2field%Ny + (j - 2))*H2field%Nz + k countIndex = countIndex + 1 end if case ('k') if (k > 1 .and. k < Nz) then - m_shift2 = ((i - 1)*Ny + (j - 1))*Nz + (k - 1) + m_shift2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + (k - 1) countIndex = countIndex + 2 else if (k == 1) then m_shift2 = -1 countIndex = countIndex + 1 else m_shift2 = -2 + m_aux2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + (k - 1) countIndex = countIndex + 1 end if end select @@ -355,27 +363,27 @@ subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, positionList = positionList + 1 if (m_shift2 /= -1 .and. m_shift2 /= -2) then - indexList(positionList) = shiftM1 + m - indexList(positionList + 1) = shiftM1 + m_shift2 + indexList(positionList) = shiftM2 + m_H2 + indexList(positionList + 1) = shiftM2 + m_shift2 positionList = positionList + 2 else if (m_shift2 == -1) then ! Border at the beginning - indexList(positionList) = shiftM1 + m + indexList(positionList) = shiftM2 + m_H2 positionList = positionList + 1 else ! Border at the end - indexList(positionList) = shiftM1 + m_shift2 + indexList(positionList) = shiftM2 + m_aux2 positionList = positionList + 1 end if if (m_shift1 /= -1 .and. m_shift1 /= -2) then - indexList(positionList) = shiftM2 + m - indexList(positionList + 1) = shiftM2 + m_shift1 + indexList(positionList) = shiftM1 + m_H1 + indexList(positionList + 1) = shiftM1 + m_shift1 positionList = positionList + 2 else if (m_shift1 == -1) then ! Border at the beginning - indexList(positionList) = shiftM2 + m + indexList(positionList) = shiftM1 + m_H1 positionList = positionList + 1 else ! Border at the end - indexList(positionList) = shiftM2 + m_shift1 + indexList(positionList) = shiftM1 + m_aux1 positionList = positionList + 1 end if @@ -389,48 +397,50 @@ subroutine AddElectricFieldIndices(RowIndexMap, field, shiftE, shiftM1, shiftM2, end do end subroutine - subroutine AddMagneticFieldIndices(RowIndexMap, field, shiftH, shiftE1, shiftE2, dir1, dir2) + subroutine AddMagneticFieldIndices(RowIndexMap, Hfield, E1field, E2field, shiftH, shiftE1, shiftE2, dir1, dir2) type(fhash_tbl_t), intent(inout) :: RowIndexMap - type(limit_t), intent(in) :: field + type(limit_t), intent(in) :: Hfield, E1field, E2field integer, intent(in) :: shiftH, shiftE1, shiftE2 character(len=1), intent(in) :: dir1, dir2 - integer :: i, j, k, m, m_shift1, m_shift2 + integer :: i, j, k, m, m_E1, m_E2, m_shift1, m_shift2 integer :: Nx, Ny, Nz integer, allocatable :: temp(:), indexList(:) type(int_array) :: aux1, aux2, aux3, aux4, wrapper integer :: totalSize - Nx = field%Nx - Ny = field%Ny - Nz = field%Nz + Nx = Hfield%Nx + Ny = Hfield%Ny + Nz = Hfield%Nz do i = 1, Nx do j = 1, Ny do k = 1, Nz m = ((i - 1)*Ny + (j - 1))*Nz + k + m_E1 = ((i - 1)*E1field%Ny + (j - 1))*E1field%Nz + k + m_E2 = ((i - 1)*E2field%Ny + (j - 1))*E2field%Nz + k select case (dir1) case ('i') - m_shift1 = (i*Ny + (j - 1))*Nz + k + m_shift1 = (i*E1field%Ny + (j - 1))*E1field%Nz + k case ('j') - m_shift1 = ((i - 1)*Ny + j)*Nz + k + m_shift1 = ((i - 1)*E1field%Ny + j)*E1field%Nz + k case ('k') - m_shift1 = ((i - 1)*Ny + (j - 1))*Nz + (k + 1) + m_shift1 = ((i - 1)*E1field%Ny + (j - 1))*E1field%Nz + (k + 1) end select select case (dir2) case ('i') - m_shift2 = (i*Ny + (j - 1))*Nz + k + m_shift2 = (i*E2field%Ny + (j - 1))*E2field%Nz + k case ('j') - m_shift2 = ((i - 1)*Ny + j)*Nz + k + m_shift2 = ((i - 1)*E2field%Ny + j)*E2field%Nz + k case ('k') - m_shift2 = ((i - 1)*Ny + (j - 1))*Nz + (k + 1) + m_shift2 = ((i - 1)*E2field%Ny + (j - 1))*E2field%Nz + (k + 1) end select - call fhash_get_int_array(RowIndexMap, key(shiftE1 + m), aux1) + call fhash_get_int_array(RowIndexMap, key(shiftE1 + m_E1), aux1) call fhash_get_int_array(RowIndexMap, key(shiftE1 + m_shift1), aux2) - call fhash_get_int_array(RowIndexMap, key(shiftE2 + m), aux3) + call fhash_get_int_array(RowIndexMap, key(shiftE2 + m_E2), aux3) call fhash_get_int_array(RowIndexMap, key(shiftE2 + m_shift2), aux4) totalSize = size(aux1%data) + size(aux2%data) + size(aux3%data) + size(aux4%data) diff --git a/test/smbjson/test_evolution_operator.F90 b/test/smbjson/test_evolution_operator.F90 index 455ee41c..17b8fcae 100644 --- a/test/smbjson/test_evolution_operator.F90 +++ b/test/smbjson/test_evolution_operator.F90 @@ -135,12 +135,20 @@ integer function test_evolution_operator_E_indices_map() bind(C, name="test_evol bounds%Ex%NX = 2 bounds%Ex%NY = 3 - bounds%Ex%NZ = 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, 0, 0, 0, 'k', 'j') + 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 @@ -204,60 +212,98 @@ integer function test_evolution_operator_H_indices_map() bind(C, name="test_evol 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 Electic fields - call AddMagneticFieldIndices(RowIndexMap, bounds%Hx, 0, 0, 0, 'k', 'j') - - ! 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(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%Hx%Ny) then - ! if (k == 1 .or. k == bounds%Hx%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%Hx%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%Hx%NX * bounds%Hx%NY * bounds%Hx%NZ) then - ! err = err + 1 - ! end if + 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 From 503754d475a5ec6d10a99f8660afc2dbe2dbecdd Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Tue, 9 Sep 2025 15:22:43 +0200 Subject: [PATCH 46/56] Minor refactoring --- src_main_pub/evolution_operator.F90 | 227 ++++++++++++++-------------- 1 file changed, 113 insertions(+), 114 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 207d6b2e..9dbcdc6f 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -252,211 +252,210 @@ subroutine GenerateInputFieldsBasis(b, FieldList) ! end subroutine - subroutine AddElectricFieldIndices(RowIndexMap, Efield, H1field, H2field, shiftE, shiftM1, shiftM2, dirM1, dirM2) + 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) :: shiftE, shiftM1, shiftM2 - character(len=1), intent(in) :: dirM1, dirM2 + integer, intent(in) :: startingIndex_Efield, startingIndex_H1field, startingIndex_H2field + character(len=1), intent(in) :: shiftDirection_H1, shiftDirection_H2 - integer :: i, j, k, m, m_H1, m_H2, m_shift1, m_shift2, m_aux1, m_aux2 - integer :: Nx, Ny, Nz + 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 - Nx = Efield%Nx - Ny = Efield%Ny - Nz = Efield%Nz - do i = 1, Nx - do j = 1, Ny - do k = 1, Nz - m = ((i - 1)*Ny + (j - 1))*Nz + k - m_H1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + k - m_H2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + k + 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 (dirM1) + + select case (shiftDirection_H1) case ('i') - if (i > 1 .and. i < Nx) then - m_shift1 = ((i - 2)*H1field%Ny + (j - 1))*H1field%Nz + k + 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 - m_shift1 = -1 + indexShift_H1 = -1 countIndex = countIndex + 1 else - m_shift1 = -2 - m_aux1 = ((i - 2)*H1field%Ny + (j - 1))*H1field%Nz + k + 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 < Ny) then - m_shift1 = ((i - 1)*H1field%Ny + (j - 2))*H1field%Nz + k + 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 - m_shift1 = -1 + indexShift_H1 = -1 countIndex = countIndex + 1 else - m_shift1 = -2 - m_aux1 = ((i - 1)*H1field%Ny + (j - 2))*H1field%Nz + k + 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 < Nz) then - m_shift1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + (k - 1) + 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 - m_shift1 = -1 + indexShift_H1 = -1 countIndex = countIndex + 1 else - m_shift1 = -2 - m_aux1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + (k - 1) + indexShift_H1 = -2 + auxiliarIndexShift_H1 = ((i - 1)*H1field%Ny + (j - 1))*H1field%Nz + (k - 1) countIndex = countIndex + 1 end if end select - select case (dirM2) + select case (shiftDirection_H2) case ('i') - if (i > 1 .and. i < Nx) then - m_shift2 = ((i - 2)*H2field%Ny + (j - 1))*H2field%Nz + k + 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 - m_shift2 = -1 + indexShift_H2 = -1 countIndex = countIndex + 1 else - m_shift2 = -2 - m_aux2 = ((i - 2)*H2field%Ny + (j - 1))*H2field%Nz + k + 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 < Ny) then - m_shift2 = ((i - 1)*H2field%Ny + (j - 2))*H2field%Nz + k + 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 - m_shift2 = -1 + indexShift_H2 = -1 countIndex = countIndex + 1 else - m_shift2 = -2 - m_aux2 = ((i - 1)*H2field%Ny + (j - 2))*H2field%Nz + k + 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 < Nz) then - m_shift2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + (k - 1) + 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 - m_shift2 = -1 + indexShift_H2 = -1 countIndex = countIndex + 1 else - m_shift2 = -2 - m_aux2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + (k - 1) + indexShift_H2 = -2 + auxiliarIndexShift_H2 = ((i - 1)*H2field%Ny + (j - 1))*H2field%Nz + (k - 1) countIndex = countIndex + 1 end if end select - ! Allocate the indexList with the size of countIndex - allocate(indexList(countIndex)) - indexList(positionList) = shiftE + m + allocate(indexList(countIndex)) + indexList(positionList) = startingIndex_Efield + combinedIndex_E positionList = positionList + 1 - if (m_shift2 /= -1 .and. m_shift2 /= -2) then - indexList(positionList) = shiftM2 + m_H2 - indexList(positionList + 1) = shiftM2 + m_shift2 + + 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 (m_shift2 == -1) then ! Border at the beginning - indexList(positionList) = shiftM2 + m_H2 + 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) = shiftM2 + m_aux2 + indexList(positionList) = startingIndex_H2field + auxiliarIndexShift_H2 positionList = positionList + 1 end if - - if (m_shift1 /= -1 .and. m_shift1 /= -2) then - indexList(positionList) = shiftM1 + m_H1 - indexList(positionList + 1) = shiftM1 + m_shift1 + 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 (m_shift1 == -1) then ! Border at the beginning - indexList(positionList) = shiftM1 + m_H1 + 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) = shiftM1 + m_aux1 + indexList(positionList) = startingIndex_H1field + auxiliarIndexShift_H1 positionList = positionList + 1 end if - wrapper%data = indexList - call RowIndexMap%set(key(shiftE + m), value=wrapper) - + 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, shiftH, shiftE1, shiftE2, dir1, dir2) + 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) :: shiftH, shiftE1, shiftE2 - character(len=1), intent(in) :: dir1, dir2 - - integer :: i, j, k, m, m_E1, m_E2, m_shift1, m_shift2 - integer :: Nx, Ny, Nz - integer, allocatable :: temp(:), indexList(:) - type(int_array) :: aux1, aux2, aux3, aux4, wrapper - integer :: totalSize - - Nx = Hfield%Nx - Ny = Hfield%Ny - Nz = Hfield%Nz - - do i = 1, Nx - do j = 1, Ny - do k = 1, Nz - m = ((i - 1)*Ny + (j - 1))*Nz + k - m_E1 = ((i - 1)*E1field%Ny + (j - 1))*E1field%Nz + k - m_E2 = ((i - 1)*E2field%Ny + (j - 1))*E2field%Nz + k - - select case (dir1) + 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') - m_shift1 = (i*E1field%Ny + (j - 1))*E1field%Nz + k + indexShift_E1 = ( i *E1field%Ny + (j - 1))*E1field%Nz + k case ('j') - m_shift1 = ((i - 1)*E1field%Ny + j)*E1field%Nz + k + indexShift_E1 = ((i - 1)*E1field%Ny + j )*E1field%Nz + k case ('k') - m_shift1 = ((i - 1)*E1field%Ny + (j - 1))*E1field%Nz + (k + 1) + indexShift_E1 = ((i - 1)*E1field%Ny + (j - 1))*E1field%Nz + (k + 1) end select - select case (dir2) + select case (shiftDirection_E2) case ('i') - m_shift2 = (i*E2field%Ny + (j - 1))*E2field%Nz + k + indexShift_E2 = ( i *E2field%Ny + (j - 1))*E2field%Nz + k case ('j') - m_shift2 = ((i - 1)*E2field%Ny + j)*E2field%Nz + k + indexShift_E2 = ((i - 1)*E2field%Ny + j )*E2field%Nz + k case ('k') - m_shift2 = ((i - 1)*E2field%Ny + (j - 1))*E2field%Nz + (k + 1) + indexShift_E2 = ((i - 1)*E2field%Ny + (j - 1))*E2field%Nz + (k + 1) end select - call fhash_get_int_array(RowIndexMap, key(shiftE1 + m_E1), aux1) - call fhash_get_int_array(RowIndexMap, key(shiftE1 + m_shift1), aux2) - call fhash_get_int_array(RowIndexMap, key(shiftE2 + m_E2), aux3) - call fhash_get_int_array(RowIndexMap, key(shiftE2 + m_shift2), aux4) + 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) - totalSize = size(aux1%data) + size(aux2%data) + size(aux3%data) + size(aux4%data) - allocate(temp(totalSize)) - temp(1:size(aux1%data)) = aux1%data - temp(size(aux1%data)+1:size(aux1%data)+size(aux2%data)) = aux2%data - temp(size(aux1%data)+size(aux2%data)+1:size(aux1%data)+size(aux2%data)+size(aux3%data)) = aux3%data - temp(size(aux1%data)+size(aux2%data)+size(aux3%data)+1:) = aux4%data - call RemoveDuplicates(temp, indexList) + relatedIndices_maximumSize = size(relatedIndices_E1%data) + size(relatedIndices_E1_shift%data) + size(relatedIndices_E2%data) + size(relatedIndices_E2_shift%data) + allocate(fullIndexList(relatedIndices_maximumSize)) - wrapper%data = indexList + 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(shiftH + m), value=wrapper) + call RowIndexMap%set(key(startingIndex_Hfield + combinedIndex_H), value=wrapper) - deallocate(temp, indexList) + deallocate(fullIndexList, uniqueIndexList) end do end do end do @@ -467,28 +466,28 @@ subroutine RemoveDuplicates(inputArray, outputArray) integer, allocatable, intent(out) :: outputArray(:) integer :: i, j, n logical :: found - integer, allocatable :: temp(:) + integer, allocatable :: fullIndexList(:) - allocate(temp(size(inputArray))) + allocate(fullIndexList(size(inputArray))) n = 0 do i = 1, size(inputArray) found = .false. do j = 1, n - if (temp(j) == inputArray(i)) then + if (fullIndexList(j) == inputArray(i)) then found = .true. exit end if end do if (.not. found) then n = n + 1 - temp(n) = inputArray(i) + fullIndexList(n) = inputArray(i) end if end do allocate(outputArray(n)) - outputArray = temp(1:n) - deallocate(temp) + outputArray = fullIndexList(1:n) + deallocate(fullIndexList) end subroutine ! subroutine GenerateRowIndexMap(b, RowIndexMap) From 16299254ef712d1b4c11641e5d4d2bd8723d8ac5 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Tue, 9 Sep 2025 16:16:52 +0200 Subject: [PATCH 47/56] Minor, changed location of evolution operator and mor tests --- CMakeLists.txt | 1 + src_json_parser/CMakeLists.txt | 1 - test/CMakeLists.txt | 4 ++++ test/fdtd_tests.cpp | 2 ++ test/mor/CMakeLists.txt | 20 +++++++++++++++++++ test/mor/mor_tests.cpp | 1 + test/mor/mor_tests.h | 14 +++++++++++++ .../test_evolution_operator.F90 | 0 test/smbjson/CMakeLists.txt | 1 - test/smbjson/smbjson_tests.h | 11 ---------- 10 files changed, 42 insertions(+), 13 deletions(-) create mode 100644 test/mor/CMakeLists.txt create mode 100644 test/mor/mor_tests.cpp create mode 100644 test/mor/mor_tests.h rename test/{smbjson => mor}/test_evolution_operator.F90 (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index e483fd1b..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() diff --git a/src_json_parser/CMakeLists.txt b/src_json_parser/CMakeLists.txt index 8b93862c..ebbe2386 100755 --- a/src_json_parser/CMakeLists.txt +++ b/src_json_parser/CMakeLists.txt @@ -20,7 +20,6 @@ add_library(smbjson "mesh.F90" "parser_tools.F90" "nfdetypes_extension.F90" - "../src_main_pub/evolution_operator.F90" ) target_link_libraries(smbjson PRIVATE jsonfortran semba-types semba-reports fhash) \ No newline at end of file diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index c3295458..ba2d511a 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -17,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" ) @@ -24,6 +27,7 @@ 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 diff --git a/test/fdtd_tests.cpp b/test/fdtd_tests.cpp index 77e77ec7..b7a315b3 100644 --- a/test/fdtd_tests.cpp +++ b/test/fdtd_tests.cpp @@ -8,6 +8,8 @@ #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..22246dc7 --- /dev/null +++ b/test/mor/mor_tests.h @@ -0,0 +1,14 @@ +#include + +extern "C" int test_evolution_operator_dimension_Field_basis(); +extern "C" int test_evolution_operator_poisition_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(); + +TEST(mor, evolutionOperator_BasisDimension) { EXPECT_EQ(0, test_evolution_operator_dimension_Field_basis()); } +TEST(mor, evolutionOperator_PositionEBasis) { EXPECT_EQ(0, test_evolution_operator_poisition_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()); } + diff --git a/test/smbjson/test_evolution_operator.F90 b/test/mor/test_evolution_operator.F90 similarity index 100% rename from test/smbjson/test_evolution_operator.F90 rename to test/mor/test_evolution_operator.F90 diff --git a/test/smbjson/CMakeLists.txt b/test/smbjson/CMakeLists.txt index 3ac03a29..40387afe 100644 --- a/test/smbjson/CMakeLists.txt +++ b/test/smbjson/CMakeLists.txt @@ -16,7 +16,6 @@ add_library (smbjson_test_fortran "test_read_sphere.F90" "test_read_airplane.F90" "test_read_lumped_fixture.F90" - "test_evolution_operator.F90" ) if(SEMBA_FDTD_ENABLE_MTLN) target_sources(smbjson_test_fortran PRIVATE diff --git a/test/smbjson/smbjson_tests.h b/test/smbjson/smbjson_tests.h index 7d2d4544..9d763dec 100644 --- a/test/smbjson/smbjson_tests.h +++ b/test/smbjson/smbjson_tests.h @@ -29,11 +29,6 @@ extern "C" int test_read_large_airplane_mtln(); extern "C" int test_read_lumped_fixture(); extern "C" int test_read_unshielded_multiwires_multipolar_expansion(); -extern "C" int test_evolution_operator_dimension_Field_basis(); -extern "C" int test_evolution_operator_poisition_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(); TEST(smbjson, idchildtable_fhash) {EXPECT_EQ(0, test_idchildtable_fhash()); } TEST(smbjson, idchildtable_add_get) {EXPECT_EQ(0, test_idchildtable()); } @@ -55,12 +50,6 @@ TEST(smbjson, read_sphere) { EXPECT_EQ(0, test_read_sphere()); } TEST(smbjson, read_airplane) { EXPECT_EQ(0, test_read_airplane()); } TEST(smbjson, read_lumped_fixture) { EXPECT_EQ(0, test_read_lumped_fixture()); } -TEST(smbjson, evolutionOperator_BasisDimension) { EXPECT_EQ(0, test_evolution_operator_dimension_Field_basis()); } -TEST(smbjson, evolutionOperator_PositionEBasis) { EXPECT_EQ(0, test_evolution_operator_poisition_E_basis()); } -TEST(smbjson, evolutionOperator_PositionHBasis) { EXPECT_EQ(0, test_evolution_operator_position_H_basis()); } -TEST(smbjson, evolutionOperator_EIndicesMap) { EXPECT_EQ(0, test_evolution_operator_E_indices_map()); } -TEST(smbjson, evolutionOperator_HIndicesMap) { EXPECT_EQ(0, test_evolution_operator_H_indices_map()); } - #ifdef CompileWithMTLN TEST(smbjson, read_towelhanger) { EXPECT_EQ(0, test_read_towelhanger()); } TEST(smbjson, read_holland1981) { EXPECT_EQ(0, test_read_holland1981()); } From 2b4a3776b98d51c4ee18e730ea5716e31ea78259 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Wed, 10 Sep 2025 10:15:04 +0200 Subject: [PATCH 48/56] Add GenerateRowIndexMap to public interface and implement test for indices mapping. Created test to begin the construction of the evolution operator and comparison with the full solver --- src_main_pub/evolution_operator.F90 | 39 +++++----- test/mor/mor_tests.h | 5 +- test/mor/test_evolution_operator.F90 | 106 +++++++++++++++++++++++++++ 3 files changed, 128 insertions(+), 22 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 9dbcdc6f..ed63d5c9 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -20,7 +20,7 @@ module evolution_operator private - public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array + public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap contains @@ -490,33 +490,30 @@ subroutine RemoveDuplicates(inputArray, outputArray) deallocate(fullIndexList) end subroutine -! subroutine GenerateRowIndexMap(b, RowIndexMap) + subroutine GenerateRowIndexMap(bounds, RowIndexMap) -! type(bounds_t), intent(IN) :: b -! type(fhash_tbl_t), intent(OUT) :: RowIndexMap -! integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz + type(bounds_t), intent(IN) :: bounds + type(fhash_tbl_t), intent(OUT) :: RowIndexMap + integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz -! shiftEx = 0 -! shiftEy = b%Ex%Nx * b%Ex%Ny * b%Ex%Nz -! shiftEz = shiftEy + b%Ey%Nx * b%Ey%Ny * b%Ey%Nz -! shiftHx = shiftEz + b%Ez%Nx * b%Ez%Ny * b%Ez%Nz -! shiftHy = shiftHx + b%Hx%Nx * b%Hx%Ny * b%Hx%Nz -! shiftHz = shiftHy + b%Hy%Nx * b%Hy%Ny * b%Hy%Nz + 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, b%sweepEx, shiftEx, shiftHy, shiftHz, 'k', 'j') -! call AddElectricFieldIndices(RowIndexMap, b%sweepEy, shiftEy, shiftHx, shiftHz, 'k', 'i') -! call AddElectricFieldIndices(RowIndexMap, b%sweepEz, shiftEz, shiftHx, shiftHy, 'j', 'i') -! ! Before the magnetic fields, it is necessary to create the map of indices related to the boundary conditions + 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, b%sweepHx, shiftHx, shiftEy, shiftEz, 'k', 'j') -! call AddMagneticFieldIndices(RowIndexMap, b%sweepHy, shiftHy, shiftEx, shiftEz, 'k', 'i') -! call AddMagneticFieldIndices(RowIndexMap, b%sweepHz, shiftHz, shiftEx, shiftEy, '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') -! ! And also, it seems to be boundary conditions for the magnetic fields, so we need to add them as well - -! end subroutine + end subroutine subroutine fhash_get_int_array(tbl, k, val) type(fhash_tbl_t), intent(in) :: tbl diff --git a/test/mor/mor_tests.h b/test/mor/mor_tests.h index 22246dc7..5218baf0 100644 --- a/test/mor/mor_tests.h +++ b/test/mor/mor_tests.h @@ -5,10 +5,13 @@ extern "C" int test_evolution_operator_poisition_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_comparison_with_solver(); TEST(mor, evolutionOperator_BasisDimension) { EXPECT_EQ(0, test_evolution_operator_dimension_Field_basis()); } TEST(mor, evolutionOperator_PositionEBasis) { EXPECT_EQ(0, test_evolution_operator_poisition_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_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 index 17b8fcae..0fd6ad10 100644 --- a/test/mor/test_evolution_operator.F90 +++ b/test/mor/test_evolution_operator.F90 @@ -307,3 +307,109 @@ integer function test_evolution_operator_H_indices_map() bind(C, name="test_evol 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_comparison_with_solver() bind(C, name="test_evolution_operator_comparison_with_solver") 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 + + bounds%Ex%NX = 50 + bounds%Ex%NY = 4 + bounds%Ex%NZ = 4 + + bounds%Ey%NX = 51 + bounds%Ey%NY = 3 + bounds%Ey%NZ = 4 + + bounds%Ez%NX = 51 + bounds%Ez%NY = 4 + bounds%Ez%NZ = 3 + + bounds%Hx%NX = bounds%Ex%Nx + 1 + bounds%Hx%NY = bounds%Ex%Ny - 1 + bounds%Hx%NZ = bounds%Ex%Nz - 1 + + bounds%Hy%NX = bounds%Ey%Nx - 1 + bounds%Hy%NY = bounds%Ey%Ny + 1 + bounds%Hy%NZ = bounds%Ey%Nz - 1 + + bounds%Hz%NX = bounds%Ez%Nx - 1 + bounds%Hz%NY = bounds%Ez%Ny - 1 + bounds%Hz%NZ = bounds%Ez%Nz + 1 + + err = 0 + + ! Generate the evolution operator with the basis, the map and one step with the solver + ! I can make a function with these three steps inside the evolution operator module + call GenerateRowIndexMap(bounds, RowIndexMap) + + ! With the evolution operator and the initial excitation, I can generate for example five steps and then compare with the full solver + + end function test_evolution_operator_comparison_with_solver \ No newline at end of file From b138d93f0bfd051e2206c90f3542ad4d7b827c9a Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Wed, 10 Sep 2025 12:45:59 +0200 Subject: [PATCH 49/56] Add get_field_bounds_from_json subroutine and corresponding test case for JSON input handling --- .gitignore | 2 + src_main_pub/evolution_operator.F90 | 38 ++++++++++++++++++- test/mor/mor_tests.h | 3 ++ test/mor/test_evolution_operator.F90 | 28 ++++++++++++++ testData/input_examples/grid_50x3x3.fdtd.json | 33 ++++++++++++++++ 5 files changed, 103 insertions(+), 1 deletion(-) create mode 100644 testData/input_examples/grid_50x3x3.fdtd.json 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/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index ed63d5c9..4d3347c0 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -4,6 +4,8 @@ module evolution_operator use Solver_mod use fdetypes use Report + use SEMBA_FDTD_mod + use system_testingTools_mod use fhash, key => fhash_key @@ -20,7 +22,7 @@ module evolution_operator private - public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap + public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap, get_field_bounds_from_json contains @@ -538,4 +540,38 @@ subroutine fhash_get_int_array(tbl, k, val) end select end subroutine + subroutine get_field_bounds_from_json(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 + end module \ No newline at end of file diff --git a/test/mor/mor_tests.h b/test/mor/mor_tests.h index 5218baf0..53864851 100644 --- a/test/mor/mor_tests.h +++ b/test/mor/mor_tests.h @@ -7,6 +7,7 @@ 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_comparison_with_solver(); +extern "C" int test_evolution_operator_read_bounds_from_json(); TEST(mor, evolutionOperator_BasisDimension) { EXPECT_EQ(0, test_evolution_operator_dimension_Field_basis()); } TEST(mor, evolutionOperator_PositionEBasis) { EXPECT_EQ(0, test_evolution_operator_poisition_E_basis()); } @@ -14,4 +15,6 @@ TEST(mor, evolutionOperator_PositionHBasis) { EXPECT_EQ(0, test_evolution 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_ReadFieldBoundsFromJson) { EXPECT_EQ(0, test_evolution_operator_read_bounds_from_json()); } + 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 index 0fd6ad10..d625bf98 100644 --- a/test/mor/test_evolution_operator.F90 +++ b/test/mor/test_evolution_operator.F90 @@ -368,6 +368,34 @@ integer function test_evolution_operator_indices_map_all_fields() bind(C, name=" end function test_evolution_operator_indices_map_all_fields + integer function test_evolution_operator_read_bounds_from_json() bind(C, name="test_evolution_operator_read_bounds_from_json") 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_json(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_json + integer function test_evolution_operator_comparison_with_solver() bind(C, name="test_evolution_operator_comparison_with_solver") result(err) use smbjson use smbjson_testingTools 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 From 87b40ce58070c1b5f0ec82b678266a74c575a9db Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Wed, 10 Sep 2025 16:39:50 +0200 Subject: [PATCH 50/56] Created routine to get the output fields of the basis for the evolution operator using the solver class --- src_main_pub/evolution_operator.F90 | 126 +++++++++++++++++++--------- 1 file changed, 87 insertions(+), 39 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 4d3347c0..f6ca9cfb 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -5,7 +5,7 @@ module evolution_operator use fdetypes use Report use SEMBA_FDTD_mod - use system_testingTools_mod + use smbjson_testingTools use fhash, key => fhash_key @@ -214,45 +214,93 @@ subroutine GenerateInputFieldsBasis(b, FieldList) end subroutine - ! subroutine GenerateOutputFields(b, FieldList) + subroutine GenerateOutputFields(input_file_json, fieldListOutput, input_flags_no_json) - ! type (bounds_t), intent( IN) :: b - ! type(field_array_t), allocatable, intent(OUT) :: FieldListOutput(:) ! Aquí necesito cambiar el tipo de variable de los outputs para tener en cuenta que con el input i, se generan varios outputs - ! allocate(FieldListOutput(66)) - - ! call GenerateInputFieldsBasis(b, FieldListInput) - - ! integer :: i - - ! do i = 1, size(FieldListInput) - ! ! Acá es necesario realizar el paso temporal y extraer los campos usando el timestepping/resuming, en todo caso si la función es general, se llama fuera del case y se almacena dependiendo - ! ! del caso. - ! select case (trim(FieldListInput(i)%field_type)) - ! case ("Ex") - ! call Advance_Ex() - ! call Advance_Hy() - ! call Advance_Hz() - ! case ("Ey") - ! call Advance_Ey() - ! call Advance_Hx() - ! call Advance_Hz() - ! case ("Ez") - ! call Advance_Ez() - ! call Advance_Hx() - ! call Advance_Hy() - ! case ("Hx") - ! call Advance_Ex() - ! call Advance_Ey() - ! Call Advance_Ez() - ! call Advance_Hx() - ! case ("Hy") - ! call Advance_Hy() - ! case ("Hz") - ! call Advance_Hz() - ! end select - ! end do - - ! end subroutine + character (len=*), intent(in) :: input_file_json + character (len=*), optional, intent(in) :: input_flags_no_json + type(field_array_t), allocatable, intent(OUT) :: fieldListOutput(:) + + type(field_array_t), allocatable :: fieldListInput(:) + type (bounds_t) :: bounds + type(semba_fdtd_t) :: semba + type(solver_t) :: solver + + character(len=:), allocatable :: filename + integer :: i, j, k, basis_index + integer, dimension(3) :: dims + + filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//input_file_json + + call semba%init(input_flags_no_json // ' ' // 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_json(bounds, semba%fullsize) + call GenerateInputFieldsBasis(bounds, fieldListInput) + + allocate(fieldListOutput(size(fieldListInput))) + + do basis_index = 1, size(fieldListInput) + ! Here now i need to acces each element and for each non-zero element, add that element to the set values function from the solver to do one step + ! also, i need to identify the type of the field to specify in the step function + dims = shape(fieldListInput(i)%data) + + do i = 1, dims(1) + do j = 1, dims(2) + do k = 1, dims(3) + select case (fieldListInput(basis_index)%field_type) + case ('Ex') + call solver%set_field_value(iEx, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) + case ('Ey') + call solver%set_field_value(iEy, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) + case ('Ez') + call solver%set_field_value(iEz, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) + case ('Hx') + call solver%set_field_value(iHx, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) + case ('Hy') + call solver%set_field_value(iHy, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) + case ('Hz') + call solver%set_field_value(iHz, [i,i], [j,j], [k,k], fieldListInput(basis_index)%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) + select case (fieldListInput(basis_index)%field_type) + case ('Ex') + fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iEx, i, j, k) + case ('Ey') + fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iEy, i, j, k) + case ('Ez') + fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iEz, i, j, k) + case ('Hx') + fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iHx, i, j, k) + case ('Hy') + fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iHy, i, j, k) + case ('Hz') + fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iHz, i, j, k) + end select + end do + end do + end do + + call solver%set_field_value(iEx, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) + call solver%set_field_value(iEy, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) + call solver%set_field_value(iEz, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) + call solver%set_field_value(iHx, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) + call solver%set_field_value(iHy, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) + call solver%set_field_value(iHz, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) + 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 From e317b3e937619b04501d218f70a901b71cc98bf0 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Fri, 12 Sep 2025 14:56:45 +0200 Subject: [PATCH 51/56] Refactor evolution operator data structures and add output field generation functionality. --- src_main_pub/evolution_operator.F90 | 168 ++++++++++--------- test/mor/mor_tests.h | 2 + testData/input_examples/grid_3x3x3.fdtd.json | 33 ++++ 3 files changed, 120 insertions(+), 83 deletions(-) create mode 100644 testData/input_examples/grid_3x3x3.fdtd.json diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index f6ca9cfb..8584c6c1 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -12,7 +12,7 @@ module evolution_operator implicit none type :: field_array_t - real(RKIND), pointer, dimension(:,:,:) :: data + real(RKIND), allocatable, dimension(:,:,:) :: data character(len=2) :: field_type ! 'Ex', 'Ey', 'Ez', 'Hx', etc. end type @@ -22,7 +22,7 @@ module evolution_operator private - public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap, get_field_bounds_from_json + public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap, get_field_bounds_from_json, GenerateOutputFields, field_array_t contains @@ -103,28 +103,28 @@ subroutine GenerateInputFieldsBasis(b, FieldList) type(field_array_t), allocatable, intent(OUT) :: FieldList(:) ! Generating the basis for the electical fields - real (kind = RKIND), dimension ( 0 : b%Ex%NX-1 , 0 : b%Ex%NY-1 , 0 : b%Ex%NZ-1 ) :: Ex - real (kind = RKIND), dimension ( 0 : b%Ey%NX-1 , 0 : b%Ey%NY-1 , 0 : b%Ey%NZ-1 ) :: Ey - real (kind = RKIND), dimension ( 0 : b%Ez%NX-1 , 0 : b%Ez%NY-1 , 0 : b%Ez%NZ-1 ) :: Ez + 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 ( 0 : b%HX%NX-1 , 0 : b%HX%NY-1 , 0 : b%HX%NZ-1 ) :: Hx - real (kind = RKIND), dimension ( 0 : b%Hy%NX-1 , 0 : b%Hy%NY-1 , 0 : b%Hy%NZ-1 ) :: Hy - real (kind = RKIND), dimension ( 0 : b%Hz%NX-1 , 0 : b%Hz%NY-1 , 0 : b%Hz%NZ-1 ) :: Hz + 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), allocatable, dimension(:,:,:) :: Ex_ee - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ex_eo - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ex_oe - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ex_oo - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ey_ee - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ey_eo - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ey_oe - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ey_oo - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ez_ee - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ez_eo - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ez_oe - real (kind = RKIND), allocatable, dimension(:,:,:) :: Ez_oo + 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 @@ -207,31 +207,30 @@ subroutine GenerateInputFieldsBasis(b, FieldList) do i3 = 1, 2 idx = idx + 1 FieldList(idx)%data = Hz_m(i1, i2, i3, :, :, :) - + FieldList(idx)%field_type = 'Hz' end do end do end do end subroutine - subroutine GenerateOutputFields(input_file_json, fieldListOutput, input_flags_no_json) + subroutine GenerateOutputFields(input_flags_no_json, input_file_json, fieldInput, fieldOutput) character (len=*), intent(in) :: input_file_json character (len=*), optional, intent(in) :: input_flags_no_json - type(field_array_t), allocatable, intent(OUT) :: fieldListOutput(:) - - type(field_array_t), allocatable :: fieldListInput(:) + + type(field_array_t), intent(in) :: fieldInput + type(field_array_t), intent(out) :: fieldOutput + type (bounds_t) :: bounds type(semba_fdtd_t) :: semba type(solver_t) :: solver - character(len=:), allocatable :: filename - integer :: i, j, k, basis_index + integer :: i, j, k integer, dimension(3) :: dims - filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//input_file_json - call semba%init(input_flags_no_json // ' ' // filename) + call semba%init(input_flags_no_json // ' ' // input_file_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,& @@ -240,66 +239,69 @@ subroutine GenerateOutputFields(input_file_json, fieldListOutput, input_flags_no call get_field_bounds_from_json(bounds, semba%fullsize) - call GenerateInputFieldsBasis(bounds, fieldListInput) - - allocate(fieldListOutput(size(fieldListInput))) - - do basis_index = 1, size(fieldListInput) - ! Here now i need to acces each element and for each non-zero element, add that element to the set values function from the solver to do one step - ! also, i need to identify the type of the field to specify in the step function - dims = shape(fieldListInput(i)%data) - - do i = 1, dims(1) - do j = 1, dims(2) - do k = 1, dims(3) - select case (fieldListInput(basis_index)%field_type) - case ('Ex') - call solver%set_field_value(iEx, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) - case ('Ey') - call solver%set_field_value(iEy, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) - case ('Ez') - call solver%set_field_value(iEz, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) - case ('Hx') - call solver%set_field_value(iHx, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) - case ('Hy') - call solver%set_field_value(iHy, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) - case ('Hz') - call solver%set_field_value(iHz, [i,i], [j,j], [k,k], fieldListInput(basis_index)%data(i,j,k)) - end select - end do + + + dims = shape(fieldInput%data) + + allocate(fieldOutput%data( & + size(fieldInput%data, 1), & + size(fieldInput%data, 2), & + size(fieldInput%data, 3))) + + fieldOutput%data = 0.0_RKIND + + do i = 1, dims(1) + do j = 1, dims(2) + do k = 1, dims(3) + select case (fieldInput%field_type) + case ('Ex') + call solver%set_field_value(iEx, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) + case ('Ey') + call solver%set_field_value(iEy, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) + case ('Ez') + call solver%set_field_value(iEz, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) + case ('Hx') + call solver%set_field_value(iHx, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) + case ('Hy') + call solver%set_field_value(iHy, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) + case ('Hz') + call solver%set_field_value(iHz, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%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) - select case (fieldListInput(basis_index)%field_type) - case ('Ex') - fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iEx, i, j, k) - case ('Ey') - fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iEy, i, j, k) - case ('Ez') - fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iEz, i, j, k) - case ('Hx') - fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iHx, i, j, k) - case ('Hy') - fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iHy, i, j, k) - case ('Hz') - fieldListOutput(basis_index)%data(i, j, k) = solver%get_field_value(iHz, i, j, k) - end select - end do + call solver%step(semba%sgg, semba%eps0, semba%mu0, semba%SINPML_FULLSIZE, semba%tag_numbers) + + ! This is wrong, for example with Ex as imput, we should have Ex, Hy and Hz as output + do i = 1, dims(1) + do j = 1, dims(2) + do k = 1, dims(3) + select case (fieldInput%field_type) + case ('Ex') + fieldOutput%data(i, j, k) = solver%get_field_value(iEx, i-1, j-1, k-1) + case ('Ey') + fieldOutput%data(i, j, k) = solver%get_field_value(iEy, i-1, j-1, k-1) + case ('Ez') + fieldOutput%data(i, j, k) = solver%get_field_value(iEz, i-1, j-1, k-1) + case ('Hx') + fieldOutput%data(i, j, k) = solver%get_field_value(iHx, i-1, j-1, k-1) + case ('Hy') + fieldOutput%data(i, j, k) = solver%get_field_value(iHy, i-1, j-1, k-1) + case ('Hz') + fieldOutput%data(i, j, k) = solver%get_field_value(iHz, i-1, j-1, k-1) + end select end do end do - - call solver%set_field_value(iEx, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) - call solver%set_field_value(iEy, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) - call solver%set_field_value(iEz, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) - call solver%set_field_value(iHx, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) - call solver%set_field_value(iHy, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) - call solver%set_field_value(iHz, [1,dims(1)], [1,dims(2)], [1,dims(3)], 0.0) end do + + 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 subroutine AddElectricFieldIndices(RowIndexMap, Efield, H1field, H2field, startingIndex_Efield, startingIndex_H1field, startingIndex_H2field, shiftDirection_H1, shiftDirection_H2) diff --git a/test/mor/mor_tests.h b/test/mor/mor_tests.h index 53864851..92580603 100644 --- a/test/mor/mor_tests.h +++ b/test/mor/mor_tests.h @@ -8,6 +8,7 @@ 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_comparison_with_solver(); extern "C" int test_evolution_operator_read_bounds_from_json(); +extern "C" int test_evolution_operator_get_field_outputs(); TEST(mor, evolutionOperator_BasisDimension) { EXPECT_EQ(0, test_evolution_operator_dimension_Field_basis()); } TEST(mor, evolutionOperator_PositionEBasis) { EXPECT_EQ(0, test_evolution_operator_poisition_E_basis()); } @@ -16,5 +17,6 @@ TEST(mor, evolutionOperator_EIndicesMap) { EXPECT_EQ(0, test_evolution 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_ReadFieldBoundsFromJson) { EXPECT_EQ(0, test_evolution_operator_read_bounds_from_json()); } +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/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 From 42099f3a400ed6e3ada95004e3ba9d4ddd9f184d Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Mon, 15 Sep 2025 12:20:12 +0200 Subject: [PATCH 52/56] Add GenerateColumnIndexMap subroutine and corresponding tests for column index mapping and consistency checks --- src_main_pub/evolution_operator.F90 | 56 +++++++++- test/mor/mor_tests.h | 4 + test/mor/test_evolution_operator.F90 | 156 +++++++++++++++++++++++++++ 3 files changed, 215 insertions(+), 1 deletion(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 8584c6c1..c48ba0cf 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -23,6 +23,7 @@ module evolution_operator private public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap, get_field_bounds_from_json, GenerateOutputFields, field_array_t + public :: GenerateColumnIndexMap contains @@ -565,7 +566,60 @@ subroutine GenerateRowIndexMap(bounds, RowIndexMap) call AddMagneticFieldIndices(RowIndexMap, bounds%Hz, bounds%Ex, bounds%Ey, shiftHz, shiftEx, shiftEy, 'j', 'i') - end subroutine + 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 diff --git a/test/mor/mor_tests.h b/test/mor/mor_tests.h index 92580603..af12b97f 100644 --- a/test/mor/mor_tests.h +++ b/test/mor/mor_tests.h @@ -6,9 +6,11 @@ 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_json(); extern "C" int test_evolution_operator_get_field_outputs(); +extern "C" int test_evolution_operator_chaeck_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_poisition_E_basis()); } @@ -16,6 +18,8 @@ TEST(mor, evolutionOperator_PositionHBasis) { EXPECT_EQ(0, test_evolution 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_chaeck_map_consistency()); } TEST(mor, evolutionOperator_ReadFieldBoundsFromJson) { EXPECT_EQ(0, test_evolution_operator_read_bounds_from_json()); } TEST(mor, evolutionOperator_GetFieldOutputs) { EXPECT_EQ(0, test_evolution_operator_get_field_outputs()); } diff --git a/test/mor/test_evolution_operator.F90 b/test/mor/test_evolution_operator.F90 index d625bf98..65c10c18 100644 --- a/test/mor/test_evolution_operator.F90 +++ b/test/mor/test_evolution_operator.F90 @@ -368,6 +368,141 @@ integer function test_evolution_operator_indices_map_all_fields() bind(C, name=" 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_chaeck_map_consistency() bind(C, name="test_evolution_operator_chaeck_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_chaeck_map_consistency + integer function test_evolution_operator_read_bounds_from_json() bind(C, name="test_evolution_operator_read_bounds_from_json") result(err) use smbjson use smbjson_testingTools @@ -396,6 +531,27 @@ integer function test_evolution_operator_read_bounds_from_json() bind(C, name="t end function test_evolution_operator_read_bounds_from_json + 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(field_array_t) :: fieldInput, fieldOutput + real(RKIND), dimension(3,4,4) :: M_Ex, M_ee, M_eo, M_oe, M_oo + + character(len=*),parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'grid_3x3x3.fdtd.json' + + call GenerateElectricalInputBasis(M_Ex, 2, 3, M_ee, M_eo, M_oe, M_oo) + fieldInput%data = M_ee + fieldInput%field_type = 'Ex' + + call GenerateOutputFields('-i', filename, fieldInput, fieldOutput) + + 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 From 12781edf0a383ea527d76c724cd73399a05914c6 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Mon, 15 Sep 2025 16:02:12 +0200 Subject: [PATCH 53/56] Add GenerateEvolutionOperator. Need to be tested and change the storage using a sparse matrix library --- src_main_pub/evolution_operator.F90 | 166 ++++++++++++++++++++++++++- test/mor/test_evolution_operator.F90 | 9 +- 2 files changed, 164 insertions(+), 11 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index c48ba0cf..9bad66d3 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -23,7 +23,7 @@ module evolution_operator private public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap, get_field_bounds_from_json, GenerateOutputFields, field_array_t - public :: GenerateColumnIndexMap + public :: GenerateColumnIndexMap, GenerateEvolutionOperator contains @@ -186,9 +186,9 @@ subroutine GenerateInputFieldsBasis(b, FieldList) do i1 = 1, 2 do i2 = 1, 3 do i3 = 1, 3 - idx = idx + 1 FieldList(idx)%data = Hx_m(i1, i2, i3, :, :, :) FieldList(idx)%field_type = 'Hx' + idx = idx + 1 end do end do end do @@ -196,9 +196,9 @@ subroutine GenerateInputFieldsBasis(b, FieldList) do i1 = 1, 3 do i2 = 1, 2 do i3 = 1, 3 - idx = idx + 1 FieldList(idx)%data = Hy_m(i1, i2, i3, :, :, :) FieldList(idx)%field_type = 'Hy' + idx = idx + 1 end do end do end do @@ -206,9 +206,9 @@ subroutine GenerateInputFieldsBasis(b, FieldList) do i1 = 1, 3 do i2 = 1, 3 do i3 = 1, 2 - idx = idx + 1 FieldList(idx)%data = Hz_m(i1, i2, i3, :, :, :) FieldList(idx)%field_type = 'Hz' + idx = idx + 1 end do end do end do @@ -678,4 +678,162 @@ subroutine get_field_bounds_from_json(field_bounds, fullsize) field_bounds%Hz%NZ = field_bounds%Ez%Nz + 1 end subroutine + subroutine GenerateEvolutionOperator(input_flags_no_json, input_file_json, evolutionOperator) + + character (len=*), intent(in) :: input_file_json + character (len=*), optional, intent(in) :: input_flags_no_json + 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 + type(semba_fdtd_t) :: semba + type(solver_t) :: solver + + integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz + integer :: i, j, k, m, totalElements, fieldIdx + integer :: i_rel, j_rel, k_rel, m_rel, wrapperIdx + real(kind = RKIND) :: fieldValue + integer, dimension(3) :: dims + + + call semba%init(input_flags_no_json // ' ' // input_file_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 get_field_bounds_from_json(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 + + 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) + case ('Ey') + call fhash_get_int_array(ColIndexMap, key(shiftEy + m), wrapper) + case ('Ez') + call fhash_get_int_array(ColIndexMap, key(shiftEz + m), wrapper) + case ('Hx') + call fhash_get_int_array(ColIndexMap, key(shiftHx + m), wrapper) + case ('Hy') + call fhash_get_int_array(ColIndexMap, key(shiftHy + m), wrapper) + case ('Hz') + call fhash_get_int_array(ColIndexMap, key(shiftHz + m), wrapper) + end select + + do wrapperIdx = 1, size(wrapper%data) + m_rel = wrapper%data(wrapperIdx) + + select case (fieldInputList(fieldIdx)%field_type) + case ('Ex') + 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) + case ('Ey') + 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) + case ('Ez') + 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) + case ('Hx') + 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) + case ('Hy') + 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) + case ('Hz') + 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 select + + evolutionOperator(m_rel, m) = fieldValue + end do + + end do + end do + end do + + 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 do + end subroutine + end module \ No newline at end of file diff --git a/test/mor/test_evolution_operator.F90 b/test/mor/test_evolution_operator.F90 index 65c10c18..7f36d67d 100644 --- a/test/mor/test_evolution_operator.F90 +++ b/test/mor/test_evolution_operator.F90 @@ -539,16 +539,11 @@ integer function test_evolution_operator_get_field_outputs() bind(C, name="test_ implicit none - type(field_array_t) :: fieldInput, fieldOutput - real(RKIND), dimension(3,4,4) :: M_Ex, M_ee, M_eo, M_oe, M_oo + real(RKIND), allocatable, dimension(:, :) :: evolOp character(len=*),parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'grid_3x3x3.fdtd.json' - - call GenerateElectricalInputBasis(M_Ex, 2, 3, M_ee, M_eo, M_oe, M_oo) - fieldInput%data = M_ee - fieldInput%field_type = 'Ex' - call GenerateOutputFields('-i', filename, fieldInput, fieldOutput) + call GenerateEvolutionOperator('-i', filename, evolOp) end function test_evolution_operator_get_field_outputs From a0407a12a5bba75fc8d4e95114eed1f8289b4aa6 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Mon, 22 Sep 2025 15:53:33 +0200 Subject: [PATCH 54/56] Add state evolution routines and update test for field outputs. The output doesn't correspond to the theory, the evolution operator is not well defined --- src_main_pub/evolution_operator.F90 | 117 ++++++++++++++++++++++++++- test/mor/test_evolution_operator.F90 | 45 ++++++++++- 2 files changed, 159 insertions(+), 3 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 9bad66d3..86fa5dc0 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -23,7 +23,7 @@ module evolution_operator private public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap, get_field_bounds_from_json, GenerateOutputFields, field_array_t - public :: GenerateColumnIndexMap, GenerateEvolutionOperator + public :: GenerateColumnIndexMap, GenerateEvolutionOperator, EvolveState, EvolveStateMultipleSteps, GenerateStateFromFields, GenerateFieldArrayFromState contains @@ -836,4 +836,119 @@ subroutine GenerateEvolutionOperator(input_flags_no_json, input_file_json, evolu 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(input_flags_no_json, input_file_json, initialState, finalState) + + character (len=*), intent(in) :: input_file_json + character (len=*), optional, intent(in) :: input_flags_no_json + 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(input_flags_no_json, input_file_json, evolutionOperator) + allocate(finalState(size(initialState))) + + finalState = matmul(evolutionOperator, initialState) + + end subroutine + + subroutine EvolveStateMultipleSteps(input_flags_no_json, input_file_json, nSteps, initialState, finalState) + + character (len=*), intent(in) :: input_file_json + character (len=*), optional, intent(in) :: input_flags_no_json + 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(input_flags_no_json, input_file_json, 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 + end module \ No newline at end of file diff --git a/test/mor/test_evolution_operator.F90 b/test/mor/test_evolution_operator.F90 index 7f36d67d..4fffa78c 100644 --- a/test/mor/test_evolution_operator.F90 +++ b/test/mor/test_evolution_operator.F90 @@ -539,11 +539,52 @@ integer function test_evolution_operator_get_field_outputs() bind(C, name="test_ implicit none - real(RKIND), allocatable, dimension(:, :) :: evolOp + type(bounds_t) :: bounds + type(semba_fdtd_t) :: semba + type(field_array_t), allocatable :: fieldArrayInput(:), fieldArrayOutput(:) + real(RKIND), allocatable :: initialState(:), finalState(:) character(len=*),parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'grid_3x3x3.fdtd.json' + + err = 0 + + call semba%init(trim('-i '//filename)) + call get_field_bounds_from_json(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 + + fieldArrayInput(1)%data(2,2,2) = 1.0_RKIND + + + call GenerateStateFromFields(fieldArrayInput, initialState) + call EvolveState('-i', filename, initialState, finalState) + call GenerateFieldArrayFromState(finalState, fieldArrayInput, fieldArrayOutput) - call GenerateEvolutionOperator('-i', filename, evolOp) end function test_evolution_operator_get_field_outputs From 8f5dbe4a9516e97a507e5a055f62baf6fb4049f4 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Tue, 23 Sep 2025 10:26:57 +0200 Subject: [PATCH 55/56] Refactor evolution operator to correctly shift indices and update field value assignments in the EvolveState routine. Enhance tests for output field validation. --- src_main_pub/evolution_operator.F90 | 26 +++++++++++-------- test/mor/test_evolution_operator.F90 | 38 +++++++++++++++++++++++++++- 2 files changed, 53 insertions(+), 11 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 86fa5dc0..6f986813 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -693,7 +693,7 @@ subroutine GenerateEvolutionOperator(input_flags_no_json, input_file_json, evolu type(solver_t) :: solver integer :: shiftEx, shiftEy, shiftEz, shiftHx, shiftHy, shiftHz - integer :: i, j, k, m, totalElements, fieldIdx + 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 @@ -725,6 +725,7 @@ subroutine GenerateEvolutionOperator(input_flags_no_json, input_file_json, evolu allocate(evolutionOperator(totalElements, totalElements)) evolutionOperator = 0.0_RKIND + fieldValue = 0.0_RKIND call GenerateColumnIndexMap(bounds, ColIndexMap) call GenerateInputFieldsBasis(bounds, fieldInputList) @@ -765,61 +766,66 @@ subroutine GenerateEvolutionOperator(input_flags_no_json, input_file_json, evolu 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) - select case (fieldInputList(fieldIdx)%field_type) - case ('Ex') + 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) - case ('Ey') + 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) - case ('Ez') + 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) - case ('Hx') + 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) - case ('Hy') + 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) - case ('Hz') + 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 select + end if - evolutionOperator(m_rel, m) = fieldValue + evolutionOperator(m_rel, m_shifted) = fieldValue end do end do diff --git a/test/mor/test_evolution_operator.F90 b/test/mor/test_evolution_operator.F90 index 4fffa78c..be608a4d 100644 --- a/test/mor/test_evolution_operator.F90 +++ b/test/mor/test_evolution_operator.F90 @@ -543,6 +543,7 @@ integer function test_evolution_operator_get_field_outputs() bind(C, name="test_ type(semba_fdtd_t) :: semba 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' @@ -578,13 +579,48 @@ integer function test_evolution_operator_get_field_outputs() bind(C, name="test_ 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('-i', filename, 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 From d8b8002ef72105c4e586dd6dc29cdd5a1f0e21b8 Mon Sep 17 00:00:00 2001 From: ashybabashyba Date: Tue, 23 Sep 2025 11:58:37 +0200 Subject: [PATCH 56/56] Refactor evolution operator module to improve function signatures and enhance test cases. Finished first test of comparison between evolution operator and full solver. Correct typos in function names and update references to use 'semba' instead of 'json' for consistency. --- src_main_pub/evolution_operator.F90 | 149 +++++---------------------- test/mor/mor_tests.h | 12 +-- test/mor/test_evolution_operator.F90 | 113 +++++++++++++------- 3 files changed, 111 insertions(+), 163 deletions(-) diff --git a/src_main_pub/evolution_operator.F90 b/src_main_pub/evolution_operator.F90 index 6f986813..05d2f797 100644 --- a/src_main_pub/evolution_operator.F90 +++ b/src_main_pub/evolution_operator.F90 @@ -22,8 +22,8 @@ module evolution_operator private - public :: GenerateElectricalInputBasis, GenerateMagneticalInputBasis, AddElectricFieldIndices, AddMagneticFieldIndices, fhash_get_int_array, int_array, GenerateRowIndexMap, get_field_bounds_from_json, GenerateOutputFields, field_array_t - public :: GenerateColumnIndexMap, GenerateEvolutionOperator, EvolveState, EvolveStateMultipleSteps, GenerateStateFromFields, GenerateFieldArrayFromState + 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 @@ -215,96 +215,6 @@ subroutine GenerateInputFieldsBasis(b, FieldList) end subroutine - subroutine GenerateOutputFields(input_flags_no_json, input_file_json, fieldInput, fieldOutput) - - character (len=*), intent(in) :: input_file_json - character (len=*), optional, intent(in) :: input_flags_no_json - - type(field_array_t), intent(in) :: fieldInput - type(field_array_t), intent(out) :: fieldOutput - - type (bounds_t) :: bounds - type(semba_fdtd_t) :: semba - type(solver_t) :: solver - - integer :: i, j, k - integer, dimension(3) :: dims - - - call semba%init(input_flags_no_json // ' ' // input_file_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 get_field_bounds_from_json(bounds, semba%fullsize) - - - dims = shape(fieldInput%data) - - allocate(fieldOutput%data( & - size(fieldInput%data, 1), & - size(fieldInput%data, 2), & - size(fieldInput%data, 3))) - - fieldOutput%data = 0.0_RKIND - - do i = 1, dims(1) - do j = 1, dims(2) - do k = 1, dims(3) - select case (fieldInput%field_type) - case ('Ex') - call solver%set_field_value(iEx, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) - case ('Ey') - call solver%set_field_value(iEy, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) - case ('Ez') - call solver%set_field_value(iEz, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) - case ('Hx') - call solver%set_field_value(iHx, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) - case ('Hy') - call solver%set_field_value(iHy, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%data(i,j,k)) - case ('Hz') - call solver%set_field_value(iHz, [i-1,i-1], [j-1,j-1], [k-1,k-1], fieldInput%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) - - ! This is wrong, for example with Ex as imput, we should have Ex, Hy and Hz as output - do i = 1, dims(1) - do j = 1, dims(2) - do k = 1, dims(3) - select case (fieldInput%field_type) - case ('Ex') - fieldOutput%data(i, j, k) = solver%get_field_value(iEx, i-1, j-1, k-1) - case ('Ey') - fieldOutput%data(i, j, k) = solver%get_field_value(iEy, i-1, j-1, k-1) - case ('Ez') - fieldOutput%data(i, j, k) = solver%get_field_value(iEz, i-1, j-1, k-1) - case ('Hx') - fieldOutput%data(i, j, k) = solver%get_field_value(iHx, i-1, j-1, k-1) - case ('Hy') - fieldOutput%data(i, j, k) = solver%get_field_value(iHy, i-1, j-1, k-1) - case ('Hz') - fieldOutput%data(i, j, k) = solver%get_field_value(iHz, i-1, j-1, k-1) - end select - end do - end do - end do - - 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 - 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 @@ -644,7 +554,7 @@ subroutine fhash_get_int_array(tbl, k, val) end select end subroutine - subroutine get_field_bounds_from_json(field_bounds, fullsize) + 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 @@ -678,10 +588,10 @@ subroutine get_field_bounds_from_json(field_bounds, fullsize) field_bounds%Hz%NZ = field_bounds%Ez%Nz + 1 end subroutine - subroutine GenerateEvolutionOperator(input_flags_no_json, input_file_json, evolutionOperator) + subroutine GenerateEvolutionOperator(semba, solver, evolutionOperator) - character (len=*), intent(in) :: input_file_json - character (len=*), optional, intent(in) :: input_flags_no_json + 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(:) @@ -689,25 +599,15 @@ subroutine GenerateEvolutionOperator(input_flags_no_json, input_file_json, evolu type (bounds_t) :: bounds type(fhash_tbl_t) :: ColIndexMap - type(semba_fdtd_t) :: semba - type(solver_t) :: solver 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 semba%init(input_flags_no_json // ' ' // input_file_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 get_field_bounds_from_json(bounds, semba%fullsize) + call get_field_bounds_from_sembaFullsize(bounds, semba%fullsize) shiftEx = 0 shiftEy = 0 + bounds%Ex%Nx * bounds%Ex%Ny * bounds%Ex%Nz @@ -832,12 +732,7 @@ subroutine GenerateEvolutionOperator(input_flags_no_json, input_file_json, evolu end do end do - 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) + call ResetSolverFields(solver) end do end subroutine @@ -884,27 +779,27 @@ subroutine GenerateStateFromFields(fieldArray, stateVector) end subroutine - subroutine EvolveState(input_flags_no_json, input_file_json, initialState, finalState) + subroutine EvolveState(semba, solver, initialState, finalState) - character (len=*), intent(in) :: input_file_json - character (len=*), optional, intent(in) :: input_flags_no_json + 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(input_flags_no_json, input_file_json, evolutionOperator) + call GenerateEvolutionOperator(semba, solver, evolutionOperator) allocate(finalState(size(initialState))) finalState = matmul(evolutionOperator, initialState) end subroutine - subroutine EvolveStateMultipleSteps(input_flags_no_json, input_file_json, nSteps, initialState, finalState) + subroutine EvolveStateMultipleSteps(semba, solver, nSteps, initialState, finalState) - character (len=*), intent(in) :: input_file_json - character (len=*), optional, intent(in) :: input_flags_no_json + 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 @@ -913,7 +808,7 @@ subroutine EvolveStateMultipleSteps(input_flags_no_json, input_file_json, nSteps real (kind = RKIND), allocatable, dimension(:) :: tempState integer :: step - call GenerateEvolutionOperator(input_flags_no_json, input_file_json, evolutionOperator) + call GenerateEvolutionOperator(semba, solver, evolutionOperator) tempState = initialState allocate(finalState(size(initialState))) @@ -957,4 +852,16 @@ subroutine GenerateFieldArrayFromState(stateVector, fieldArrayInput, fieldArrayO 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/test/mor/mor_tests.h b/test/mor/mor_tests.h index af12b97f..25ac95b8 100644 --- a/test/mor/mor_tests.h +++ b/test/mor/mor_tests.h @@ -1,26 +1,26 @@ #include extern "C" int test_evolution_operator_dimension_Field_basis(); -extern "C" int test_evolution_operator_poisition_E_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_json(); +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_chaeck_map_consistency(); +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_poisition_E_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_chaeck_map_consistency()); } -TEST(mor, evolutionOperator_ReadFieldBoundsFromJson) { EXPECT_EQ(0, test_evolution_operator_read_bounds_from_json()); } +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 index be608a4d..0c669b68 100644 --- a/test/mor/test_evolution_operator.F90 +++ b/test/mor/test_evolution_operator.F90 @@ -29,7 +29,7 @@ integer function test_evolution_operator_dimension_Field_basis() bind (C, name=" end function test_evolution_operator_dimension_Field_basis -integer function test_evolution_operator_poisition_E_basis() bind(C, name="test_evolution_operator_poisition_E_basis") result(err) +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 @@ -65,7 +65,7 @@ integer function test_evolution_operator_poisition_E_basis() bind(C, name="test_ err = err + 1 end if -end function test_evolution_operator_poisition_E_basis +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 @@ -248,7 +248,7 @@ integer function test_evolution_operator_H_indices_map() bind(C, name="test_evol err = 0 ElementsInMap = 0 - ! To verify the H indices map, first I need to create the map of all the Electic fields + ! 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') @@ -427,7 +427,7 @@ integer function test_evolution_operator_column_map_creation() bind(C, name="tes end function test_evolution_operator_column_map_creation - integer function test_evolution_operator_chaeck_map_consistency() bind(C, name="test_evolution_operator_chaeck_map_consistency") result(err) + 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 @@ -501,9 +501,9 @@ integer function test_evolution_operator_chaeck_map_consistency() bind(C, name=" end do end do - end function test_evolution_operator_chaeck_map_consistency + end function test_evolution_operator_check_map_consistency - integer function test_evolution_operator_read_bounds_from_json() bind(C, name="test_evolution_operator_read_bounds_from_json") result(err) + 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 @@ -519,7 +519,7 @@ integer function test_evolution_operator_read_bounds_from_json() bind(C, name="t err = 0 call semba%init(trim('-i '//filename)) - call get_field_bounds_from_json(bounds, semba%fullsize) + 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 @@ -529,7 +529,7 @@ integer function test_evolution_operator_read_bounds_from_json() bind(C, name="t 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_json + 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 @@ -541,6 +541,7 @@ integer function test_evolution_operator_get_field_outputs() bind(C, name="test_ 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 @@ -550,7 +551,13 @@ integer function test_evolution_operator_get_field_outputs() bind(C, name="test_ err = 0 call semba%init(trim('-i '//filename)) - call get_field_bounds_from_json(bounds, semba%fullsize) + 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)) @@ -584,7 +591,7 @@ integer function test_evolution_operator_get_field_outputs() bind(C, name="test_ call GenerateStateFromFields(fieldArrayInput, initialState) - call EvolveState('-i', filename, initialState, finalState) + 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 @@ -628,44 +635,78 @@ integer function test_evolution_operator_comparison_with_solver() bind(C, name=" use smbjson use smbjson_testingTools use evolution_operator - use fhash, key => fhash_key + use SEMBA_FDTD_mod implicit none - integer :: m type(bounds_t) :: bounds - type(fhash_tbl_t) :: RowIndexMap + 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 - bounds%Ex%NX = 50 - bounds%Ex%NY = 4 - bounds%Ex%NZ = 4 + character(len=*),parameter :: filename = PATH_TO_TEST_DATA//INPUT_EXAMPLES//'grid_3x3x3.fdtd.json' - bounds%Ey%NX = 51 - bounds%Ey%NY = 3 - bounds%Ey%NZ = 4 + err = 0 - bounds%Ez%NX = 51 - bounds%Ez%NY = 4 - bounds%Ez%NZ = 3 + ! 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) - bounds%Hx%NX = bounds%Ex%Nx + 1 - bounds%Hx%NY = bounds%Ex%Ny - 1 - bounds%Hx%NZ = bounds%Ex%Nz - 1 + call get_field_bounds_from_sembaFullsize(bounds, semba%fullsize) - bounds%Hy%NX = bounds%Ey%Nx - 1 - bounds%Hy%NY = bounds%Ey%Ny + 1 - bounds%Hy%NZ = bounds%Ey%Nz - 1 + ! Creating an initial field array with all the fields with zeros + allocate(fieldArrayInput(6)) - bounds%Hz%NX = bounds%Ez%Nx - 1 - bounds%Hz%NY = bounds%Ez%Ny - 1 - bounds%Hz%NZ = bounds%Ez%Nz + 1 + fieldArrayInput(1)%field_type = 'Ex' + allocate(fieldArrayInput(1)%data(bounds%Ex%Nx, bounds%Ex%Ny, bounds%Ex%Nz)) + fieldArrayInput(1)%data = 0.0_RKIND - err = 0 + fieldArrayInput(2)%field_type = 'Ey' + allocate(fieldArrayInput(2)%data(bounds%Ey%Nx, bounds%Ey%Ny, bounds%Ey%Nz)) + fieldArrayInput(2)%data = 0.0_RKIND - ! Generate the evolution operator with the basis, the map and one step with the solver - ! I can make a function with these three steps inside the evolution operator module - call GenerateRowIndexMap(bounds, RowIndexMap) + 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) - ! With the evolution operator and the initial excitation, I can generate for example five steps and then compare with the full solver + ! 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