210 行
7.6 KiB
Fortran
210 行
7.6 KiB
Fortran
!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
|
|
!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 |