包含基于射线追踪的任意复杂界面计算
这个提交包含在：
@@ -1,34 +1,210 @@
|
||||
!Copyright (c) 2013 by tdem.org under guide of Xiu Li(lixiu@chd.edu.cn)
|
||||
!written by Huaifeng Sun(sunhuaifeng@gmail.com) and Xushan Lu(luxushan@gmail.com)
|
||||
!Code distribution @ tdem.org or sunhuaifeng.com
|
||||
!Copyright (c) 2022 by LEEE under guide of Huaifeng Sun(sunhuaifeng@gmail.com)
|
||||
!written by Xinyu Li(202335098@mail.sdu.edu.cn) and Qi Zhao(zhaoqi_326326@163.com)
|
||||
|
||||
SUBROUTINE RES_CONFIGURE
|
||||
!本子程序用于设置模型的电阻率参数
|
||||
USE CONSTANTPARAMETERS
|
||||
USE ELECTROMAGNETIC_VARIABLES
|
||||
USE RES_MODEL_PARAMETER
|
||||
USE TIME_PARAMETER
|
||||
USE OMP_LIB
|
||||
IMPLICIT NONE
|
||||
INTEGER II,III,i,j,k
|
||||
DO K=1,NZ
|
||||
DO J=1,NY
|
||||
DO I=1,NX
|
||||
CCSIG(I,J,K)=BACKGROUND_CONDUCTIVITY !Set the background value of conductivity.
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
II=SIZE(TAR_X1)
|
||||
DO III=1,II
|
||||
DO K=TAR_Z1(III),TAR_Z2(III)
|
||||
DO J=TAR_Y1(III),TAR_Y2(III)
|
||||
DO I=TAR_X1(III),TAR_X2(III)
|
||||
CCSIG(I,J,K)=TAR_CONDUCTIVITY(III) !Set the value of anomalous conductivity.
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
SIGMA_MIN=MINVAL(CCSIG)
|
||||
RETURN
|
||||
ENDSUBROUTINE RES_CONFIGURE
|
||||
!------------------------
|
||||
!This subroutine is used to set the resistivity parameters of the model
|
||||
USE CONSTANTPARAMETERS
|
||||
USE ELECTROMAGNETIC_VARIABLES
|
||||
USE RES_MODEL_PARAMETER
|
||||
USE TIME_PARAMETER
|
||||
USE OMP_LIB
|
||||
USE VTK_Fortran, ONLY: Struct_grid
|
||||
USE Precision, ONLY : i4k, r8k
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER :: i,ii,j,jj,k,kk,III
|
||||
REAL(KIND=8) :: TEMP_SIG,DELX1,DELY1,DELZ1
|
||||
|
||||
REAL*8 :: D
|
||||
INTEGER :: IRR_Terrain,IRR_Anomalous
|
||||
INTEGER(i4k), DIMENSION(3) :: dims
|
||||
INTEGER :: RANGEX,RANGEXB,RANGEY,RANGEYB,RANGEZ,RANGEZB,RangeStartX,RangeStartY,RangeStartZ
|
||||
REAL(r8k), DIMENSION(:), ALLOCATABLE :: temp_Coordix, temp_Coordiy, temp_Coordiz
|
||||
REAL(r8k), DIMENSION(:,:,:), ALLOCATABLE :: CCSIG_temp
|
||||
REAL*8 :: V0_1,V0_2,V0_3,V1_1,V1_2,V1_3,V2_1,V2_2,V2_3
|
||||
REAL*8 :: u,w,E
|
||||
REAL*8 :: dot00, dot01, dot02, dot11, dot12, divisor
|
||||
TYPE (Struct_grid) :: hexahedron !It is used to write a .vtk file
|
||||
|
||||
!>The terrain mesh file can be Complex_Terrain.dat or Complex_Terrain.stl.
|
||||
!!Which file is used was decided in GETDATA, here only the existence flag is checked.
|
||||
IF(Logic_TerrainDat .OR. Logic_TerrainStl)THEN
|
||||
IRR_Terrain=1
|
||||
ELSE
|
||||
IRR_Terrain=0
|
||||
ENDIF
|
||||
!>The anomalous body mesh file can be Complex_anomalous.dat or Complex_anomalous.stl.
|
||||
!!Which file is used was decided in GETDATA, here only the existence flag is checked.
|
||||
IF(Logic_AnomalousDat .OR. Logic_AnomalousStl)THEN
|
||||
IRR_Anomalous=1
|
||||
ELSE
|
||||
IRR_Anomalous=0
|
||||
ENDIF
|
||||
!======================================Get the coordinates of all terrain elements=============================================
|
||||
|
||||
IF (IRR_Terrain /= 0) then
|
||||
PRINT*,'Conformal mesh of terrain is complete!'
|
||||
CALL terrain_conformal
|
||||
print*,'Conformal mesh of terrain is finished'
|
||||
DEALLOCATE(orig_z,orig_y,orig_x)
|
||||
DEALLOCATE(vert0,vert1,vert2,edge1,edge2)
|
||||
DEALLOCATE(det_z,det_x,det_y)
|
||||
DEALLOCATE(u_z,u_x,u_y)
|
||||
DEALLOCATE(v_z,v_x,v_y)
|
||||
DEALLOCATE(t_z,t_x,t_y)
|
||||
DEALLOCATE(pvec_z,pvec_y,pvec_x)
|
||||
DEALLOCATE(tvec_z,tvec_y,tvec_x)
|
||||
DEALLOCATE(crosspoint_ZZ,crosspoint_XX,crosspoint_YY)
|
||||
DEALLOCATE(mmz_per,mmx_per,mmy_per)
|
||||
DEALLOCATE(Face_Triangle_NormVect)
|
||||
SIGMA_MIN = MIN(MINVAL(CCSIGX),MINVAL(CCSIGY),MINVAL(CCSIGZ))
|
||||
!=========================================================================================================
|
||||
ELSE
|
||||
print*,"*************This calculation does not consider undulating terrain.************"
|
||||
!> No terrain file found, assign uniform background conductivity and anomalies
|
||||
DO K=1,NZ
|
||||
DO J=1,NY
|
||||
DO I=1,NX
|
||||
CCSIG(I,J,K)=BACKGROUND_CONDUCTIVITY !Set the background value of conductivity.
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
||||
DO III=1,TEMP_II
|
||||
DO K=TAR_Z1(III),TAR_Z2(III)
|
||||
DO J=TAR_Y1(III),TAR_Y2(III)
|
||||
DO I=TAR_X1(III),TAR_X2(III)
|
||||
CCSIG(I,J,K)=TAR_CONDUCTIVITY(III) !Set the value of anomalous conductivity.
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
write(*,*)"*********************************"
|
||||
write(*,*)"The Non-undulating terrain is used"
|
||||
write(*,*)"*********************************"
|
||||
SIGMA_MIN=MINVAL(CCSIG)
|
||||
!print*,'SIGMA_MIN',SIGMA_MIN
|
||||
!======================================Transfer the conductivity into all edges=============================================
|
||||
!>assign conductivity values to all edges
|
||||
DO I=1,NX
|
||||
DO J=2,NYB-1
|
||||
DO K=2,NZB-1
|
||||
DELY1=(CDELY(J-1)+CDELY(J))/2.0D0
|
||||
DELZ1=(CDELZ(K-1)+CDELZ(K))/2.0D0
|
||||
|
||||
TEMP_SIG=CCSIG(I,J-1,K-1)*CDELY(J-1)*CDELZ(K-1)&
|
||||
&+CCSIG(I,J-1,K)*CDELY(J-1)*CDELZ(K)&
|
||||
&+CCSIG(I,J,K-1)*CDELY(J)*CDELZ(K-1)&
|
||||
&+CCSIG(I,J,K)*CDELY(J)*CDELZ(K)
|
||||
|
||||
CCSIGX( I,J,K )=TEMP_SIG/(4.0D0*DELY1*DELZ1)
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
||||
DO I=2,NXB-1
|
||||
DO J=1,NY
|
||||
DO K=2,NZB-1
|
||||
DELX1=(CDELX(I-1)+CDELX(I))/2.0D0
|
||||
DELZ1=(CDELZ(K-1)+CDELZ(K))/2.0D0
|
||||
|
||||
TEMP_SIG=CCSIG(I-1,J,K-1)*CDELX(I-1)*CDELZ(K-1)&
|
||||
&+CCSIG(I-1,J,K)*CDELX(I-1)*CDELZ(K)&
|
||||
&+CCSIG(I,J,K-1)*CDELX(I)*CDELZ(K-1)&
|
||||
&+CCSIG(I,J,K)*CDELX(I)*CDELZ(K)
|
||||
|
||||
CCSIGY( I,J,K )=TEMP_SIG/(4.0D0*DELX1*DELZ1)
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
||||
DO J=2,NYB-1
|
||||
DO I=2,NXB-1
|
||||
DO K=1,NZ
|
||||
DELX1=(CDELX(I-1)+CDELX(I))/2.0D0
|
||||
DELY1=(CDELY(J-1)+CDELY(J))/2.0D0
|
||||
|
||||
TEMP_SIG=CCSIG(I-1,J-1,K)*CDELX(I-1)*CDELY(J-1)&
|
||||
&+CCSIG(I-1,J,K)*CDELX(I-1)*CDELY(J)&
|
||||
&+CCSIG(I,J-1,K)*CDELX(I)*CDELY(J-1)&
|
||||
&+CCSIG(I,J,K)*CDELX(I)*CDELY(J)
|
||||
|
||||
CCSIGZ( I,J,K )=TEMP_SIG/(4.0D0*DELX1*DELY1)
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
|
||||
IF (IRR_Anomalous /= 0) then
|
||||
PRINT*,'Conformal mesh of anomalous body is complete!'
|
||||
CALL anomalous_conformal
|
||||
print*,'Conformal mesh of anomalous body is finished'
|
||||
ENDIF
|
||||
!===============================Write a .vtk file with the model conductivity==============================
|
||||
!===============================print conductivity_Z=======================================================
|
||||
RANGEX=X_max-X_min+5-1
|
||||
RANGEXB=RANGEX+1
|
||||
RANGEY=Y_max-Y_min+5
|
||||
RANGEYB=RANGEY+1
|
||||
RANGEZ=Z_max-Z_min+10
|
||||
RANGEZB=RANGEZ+1
|
||||
ALLOCATE(temp_Coordix(RANGEXB),temp_Coordiy(RANGEYB),temp_Coordiz(RANGEZB))
|
||||
ALLOCATE(CCSIG_temp(RANGEX, RANGEY, RANGEZ))
|
||||
dims = [ RANGEX, RANGEY, RANGEZ ]
|
||||
ii=0
|
||||
jj=0
|
||||
kk=0
|
||||
RangeStartX=NXS-INT(RANGEX/2)
|
||||
RangeStartY=NYS-INT(RANGEY/2)
|
||||
RangeStartZ=NZS-2
|
||||
DO ii=1,RANGEX
|
||||
DO jj=1,RANGEY
|
||||
DO kk=1,RANGEZ
|
||||
CCSIG_temp(ii,jj,kk)=CCSIGX(ii+RangeStartX,jj+RangeStartY,kk+RangeStartZ)
|
||||
! Choose edge conductivity for output:
|
||||
! CCSIGZ: z-direction edge conductivity
|
||||
! CCSIGY: y-direction edge conductivity
|
||||
! CCSIGX: x-direction edge conductivity
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
DO ii=1,RANGEXB
|
||||
temp_Coordix(ii) = ii
|
||||
ENDDO
|
||||
DO jj=1,RANGEYB
|
||||
temp_Coordiy(jj) = jj
|
||||
ENDDO
|
||||
DO kk=1,RANGEZB
|
||||
temp_Coordiz(kk) = kk
|
||||
ENDDO
|
||||
|
||||
CALL hexahedron%init( filename = "conductivity.vtk", dims = dims, Coord_x = temp_Coordix, Coord_y = temp_Coordiy, Coord_z = temp_Coordiz )
|
||||
CALL hexahedron%write
|
||||
CALL hexahedron%add( names = "conductivity",values=CCSIG_temp )
|
||||
CALL hexahedron%close
|
||||
DEALLOCATE(temp_Coordix,temp_Coordiy,temp_Coordiz,CCSIG_temp)
|
||||
!=========================================================================================
|
||||
RETURN
|
||||
ENDSUBROUTINE Res_Configure
|
||||
!-------------------------------------------------------------------------------
|
||||
! @brief Swap two crosspoint properties
|
||||
! @param[in,out] crosspoint_A first crosspoint
|
||||
! @param[in,out] crosspoint_B second crosspoint
|
||||
!-------------------------------------------------------------------------------
|
||||
SUBROUTINE SWAP(crosspoint_A,crosspoint_B)
|
||||
USE CONSTANTPARAMETERS
|
||||
TYPE(CrossPoint_Property),intent(inout) :: crosspoint_A, crosspoint_B
|
||||
TYPE(CrossPoint_Property) :: TEMP
|
||||
TEMP%Global_Coord%Coord_X=crosspoint_A%Global_Coord%Coord_X
|
||||
TEMP%Global_Coord%Coord_Y=crosspoint_A%Global_Coord%Coord_Y
|
||||
TEMP%Global_Coord%Coord_Z=crosspoint_A%Global_Coord%Coord_Z
|
||||
TEMP%Log_In=crosspoint_A%Log_In
|
||||
crosspoint_A%Global_Coord%Coord_X=crosspoint_B%Global_Coord%Coord_X
|
||||
crosspoint_A%Global_Coord%Coord_Y=crosspoint_B%Global_Coord%Coord_Y
|
||||
crosspoint_A%Global_Coord%Coord_Z=crosspoint_B%Global_Coord%Coord_Z
|
||||
crosspoint_A%Log_In=crosspoint_B%Log_In
|
||||
crosspoint_B%Global_Coord%Coord_X=TEMP%Global_Coord%Coord_X
|
||||
crosspoint_B%Global_Coord%Coord_Y=TEMP%Global_Coord%Coord_Y
|
||||
crosspoint_B%Global_Coord%Coord_Z=TEMP%Global_Coord%Coord_Z
|
||||
crosspoint_B%Log_In=TEMP%Log_In
|
||||
END SUBROUTINE
|
||||
在新工单中引用
屏蔽一个用户