文件
tem3dfdtd-open/tem3dfdtd/lib/get_non_uniformgrid.f90
T
2026-08-14 20:51:58 +08:00

239 行
7.8 KiB
Fortran
原始文件 Blame 文件历史

此文件含有模棱两可的 Unicode 字符
此文件含有可能会与其他字符混淆的 Unicode 字符。 如果您是想特意这样的,可以安全地忽略该警告。 使用 Escape 按钮显示他们。
!Copyright (c) 2013 by https://git.em3d.cn/ under guide of Xiu Li(lixiu@chd.edu.cn)
!written by Huaifeng Sun(sunhuaifeng@email.sdu.edu.cn) and Xushan Lu(luxushan@gmail.com)
!Code distribution @ https://git.em3d.cn/
SUBROUTINE GET_NON_UNIFORMGRID
USE CONSTANTPARAMETERS
USE OMP_LIB
IMPLICIT NONE
INTEGER II
INTEGER MID_P,LEFT_P,RIGHT_P,UP_P,DOWN_P
REAL(KIND=8) CDELX_LENGTH,CDELY_LENGTH,CDELZ_LENGTH
WRITE(*,*)'Non-uniform grid meshing: core cells = ',GridSize,' m, expansion ratio SCALE_PAR = ',SCALE_PAR
! -------------------------mesh-z-------------------------------------------!
GridSize_MAX=GridSize*MAX_RATIO
do ii=nzs-UniGridNumZ1,nzs+UniGridNumZ2,1
Cdelz(ii)=GridSize
end do !Uniform mesh in an area equal to source length
do ii=nzs-UniGridNumZ1-1,1,-1
Cdelz(ii)=Cdelz(ii+1)*scale_par
if(Cdelz(ii).gt.GridSize_MAX)then
Cdelz(ii)=GridSize_MAX
end if
end do !Ununiform mesh in the air.
do ii=nzs+UniGridNumZ2+1,nz,1
Cdelz(ii)=Cdelz(ii-1)*scale_par
if(Cdelz(ii).gt.GridSize_MAX)then
Cdelz(ii)=GridSize_MAX
end if
end do !Ununiform mesh underground
! ----------------------------end of mesh------------------------------------!
! -------------------------------mesh x----------------------------------------!
IF(Logi_Sourcelenth) THEN !The number of grids occupied by the source is odd
if(SourceLength/GridSize.gt.51)then
do ii=nxs-(SourceLength/GridSize-1)/2,nxs+(SourceLength/GridSize-1)/2,1
Cdelx(ii)=GridSize
end do
do ii=nxs-(SourceLength/GridSize-1)/2-1,1,-1
Cdelx(ii)=Cdelx(ii+1)*scale_par
if(Cdelx(ii).gt.GridSize_MAX)then
Cdelx(ii)=GridSize_MAX
end if
end do
do ii=nxs+(SourceLength/GridSize-1)/2+1,nx,1
Cdelx(ii)=Cdelx(ii-1)*scale_par
if(Cdelx(ii).gt.GridSize_MAX)then
Cdelx(ii)=GridSize_MAX
end if
end do
else
do ii=nxs-UniGridNumX1,nxs+UniGridNumX2,1
Cdelx(ii)=GridSize
end do
do ii=nxs-UniGridNumX1-1,1,-1
Cdelx(ii)=Cdelx(ii+1)*scale_par
if(Cdelx(ii).gt.GridSize_MAX)then
Cdelx(ii)=GridSize_MAX
end if
end do
do ii=nxs+UniGridNumX2+1,nx,1
Cdelx(ii)=Cdelx(ii-1)*scale_par
if(Cdelx(ii).gt.GridSize_MAX)then
Cdelx(ii)=GridSize_MAX
endif
end do
ENDIF
ELSE !The number of grids occupied by the source is even
if(SourceLength/GridSize.gt.51)then
do ii=nxs-(SourceLength/GridSize-1)/2,nxs+1+(SourceLength/GridSize-1)/2,1
Cdelx(ii)=GridSize
end do
do ii=nxs-(SourceLength/GridSize-1)/2-1,1,-1
Cdelx(ii)=Cdelx(ii+1)*scale_par
if(Cdelx(ii).gt.GridSize_MAX)then
Cdelx(ii)=GridSize_MAX
end if
end do
do ii=nxs+(SourceLength/GridSize-1)/2+2,nx,1
Cdelx(ii)=Cdelx(ii-1)*scale_par
if(Cdelx(ii).gt.GridSize_MAX)then
Cdelx(ii)=GridSize_MAX
end if
end do
else
do ii=nxs-UniGridNumX1-1,nxs+UniGridNumX2,1
Cdelx(ii)=GridSize
end do
do ii=nxs-UniGridNumX1,1,-1
Cdelx(ii)=Cdelx(ii+1)*scale_par
if(Cdelx(ii).gt.GridSize_MAX)then
Cdelx(ii)=GridSize_MAX
end if
end do
do ii=nxs+UniGridNumX2+1,nx,1
Cdelx(ii)=Cdelx(ii-1)*scale_par
if(Cdelx(ii).gt.GridSize_MAX)then
Cdelx(ii)=GridSize_MAX
endif
end do
ENDIF
ENDIF
! -----------------------------end of mesh------------------------------------!
! --------------------------------mesh y----------------------------------------!
IF(Logi_Sourcelenth) THEN !The number of grids occupied by the source is odd
IF(SourceLength/GridSize.gt.51)then
do ii=nys-(SourceLength/GridSize-1)/2,nys+(SourceLength/GridSize-1)/2,1
Cdely(ii)=GridSize
enddo
do ii=nys-(SourceLength/GridSize-1)/2-1,1,-1
Cdely(ii)=Cdely(ii+1)*scale_par
if(Cdely(ii).gt.GridSize_MAX)then
Cdely(ii)=GridSize_MAX
end if
end do
do ii=nys+(SourceLength/GridSize-1)/2+1,ny,1
Cdely(ii)=Cdely(ii-1)*scale_par
if(Cdely(ii).gt.GridSize_MAX)then
Cdely(ii)=GridSize_MAX
endif
end do
else
do ii=nys-UniGridNumY1,nys+UniGridNumY2,1
Cdely(ii)=GridSize
end do
do ii=nys-UniGridNumY1-1,1,-1
Cdely(ii)=Cdely(ii+1)*scale_par
if(Cdely(ii).gt.GridSize_MAX)then
Cdely(ii)=GridSize_MAX
end if
end do
do ii=nys+UniGridNumY2+1,ny,1
Cdely(ii)=Cdely(ii-1)*scale_par
if(Cdely(ii).gt.GridSize_MAX)then
Cdely(ii)=GridSize_MAX
end if
end do
end if
ELSE !The number of grids occupied by the source is even
IF(SourceLength/GridSize.gt.51)then
do ii=nys-(SourceLength/GridSize-1)/2,nys+1+(SourceLength/GridSize-1)/2,1
Cdely(ii)=GridSize
enddo
do ii=nys-(SourceLength/GridSize-1)/2-1,1,-1
Cdely(ii)=Cdely(ii+1)*scale_par
if(Cdely(ii).gt.GridSize_MAX)then
Cdely(ii)=GridSize_MAX
end if
end do
do ii=nys+(SourceLength/GridSize-1)/2+2,ny,1
Cdely(ii)=Cdely(ii-1)*scale_par
if(Cdely(ii).gt.GridSize_MAX)then
Cdely(ii)=GridSize_MAX
endif
end do
else
do ii=nys-UniGridNumY1-1,nys+UniGridNumY2,1
Cdely(ii)=GridSize
end do
do ii=nys-UniGridNumY1,1,-1
Cdely(ii)=Cdely(ii+1)*scale_par
if(Cdely(ii).gt.GridSize_MAX)then
Cdely(ii)=GridSize_MAX
end if
end do
do ii=nys+UniGridNumY2+1,ny,1
Cdely(ii)=Cdely(ii-1)*scale_par
if(Cdely(ii).gt.GridSize_MAX)then
Cdely(ii)=GridSize_MAX
end if
end do
end if
ENDIF
! ------------------------------end of mesh-----------------------------------!
CDELX_LENGTH=SUM(CDELX)
CDELY_LENGTH=SUM(CDELY)
CDELZ_LENGTH=SUM(CDELZ)
WRITE(10005,*)'õģͳߴΪ'
WRITE(10005,*)'SUM_X=',CDELX_LENGTH
WRITE(10005,*)'SUM_Y=',CDELY_LENGTH
WRITE(10005,*)'SUM_Z=',CDELZ_LENGTH
WRITE(10005,*)'Ŵϵ=',SCALE_PAR
WRITE(10005,*)'ߴСߴ֮<=',MAX_RATIO
WRITE(10005,*)'XķǾߴΪ'
WRITE(10005,'(5F18.8)')CDELX
WRITE(10005,*)'YķǾߴΪ'
WRITE(10005,'(5F18.8)')CDELY
WRITE(10005,*)'ZķǾߴΪ'
WRITE(10005,'(5F18.8)')CDELZ
WRITE(*,*)'Model size:',CDELX_LENGTH,CDELY_LENGTH,CDELZ_LENGTH
ENDSUBROUTINE GET_NON_UNIFORMGRID
!===============================================================================================!
! GET_UNIFORM_GRID: 均匀网格剖分,用于 CPML 吸收边界。
! 参考实现(tem3dfdtd_第二版)中 CPML 采用的是均匀网格(SCALE_PAR=1.0,
! 扩展循环全部注释),因此这里按 Logic_PML 分流:Logic_PML=1 时调用本子程序
! (均匀网格 + CPML),Logic_PML=0 时调用 GET_NON_UNIFORMGRID(非均匀网格 + Dirichlet)。
!===============================================================================================!
SUBROUTINE GET_UNIFORM_GRID
USE CONSTANTPARAMETERS
IMPLICIT NONE
INTEGER II
REAL(KIND=8) CDELX_LENGTH,CDELY_LENGTH,CDELZ_LENGTH
WRITE(*,*)'Uniform grid meshing: all cells = ',GridSize,' m (required by the CPML absorbing boundary)'
! 均匀网格:所有网格尺寸均等于 GridSize
Cdelx=GridSize
Cdely=GridSize
Cdelz=GridSize
CDELX_LENGTH=SUM(CDELX)
CDELY_LENGTH=SUM(CDELY)
CDELZ_LENGTH=SUM(CDELZ)
WRITE(10005,*)'采用均匀网格剖分(配合 CPML 吸收边界):'
WRITE(10005,*)'SUM_X=',CDELX_LENGTH
WRITE(10005,*)'SUM_Y=',CDELY_LENGTH
WRITE(10005,*)'SUM_Z=',CDELZ_LENGTH
WRITE(10005,*)'均匀网格尺寸=',GridSize
WRITE(*,*)'Model size:',CDELX_LENGTH,CDELY_LENGTH,CDELZ_LENGTH
OPEN(400,FILE='CDELX.DAT',STATUS='UNKNOWN')
DO II=1,NX
WRITE(400,'(E13.6)')CDELX(II)
ENDDO
CLOSE(400)
OPEN(400,FILE='CDELY.DAT',STATUS='UNKNOWN')
DO II=1,NY
WRITE(400,'(E13.6)')CDELY(II)
ENDDO
CLOSE(400)
OPEN(400,FILE='CDELZ.DAT',STATUS='UNKNOWN')
DO II=1,NZ
WRITE(400,'(E13.6)')CDELZ(II)
ENDDO
CLOSE(400)
ENDSUBROUTINE GET_UNIFORM_GRID