你已经派生过 tem3dfdtd-open
镜像自地址
https://gitee.com/sunhf/tem3dfdtd-open.git
已同步 2025-08-03 03:16:53 +08:00
38 行
1.6 KiB
Fortran
38 行
1.6 KiB
Fortran
!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
|
|
|
|
!function description
|
|
!this subroutine is used to allocate dynamic memory to the selected array.
|
|
!all allocatable variables which can be allocated automaticly after getting
|
|
!the input parameters file are allocated here.
|
|
!2016-10-30 by Huaifeng Sun
|
|
|
|
SUBROUTINE ALLOCATEMEMORY
|
|
USE CONSTANTPARAMETERS
|
|
USE ELECTROMAGNETIC_VARIABLES
|
|
USE RES_MODEL_PARAMETER
|
|
USE TIME_PARAMETER
|
|
IMPLICIT NONE
|
|
INTEGER ERR
|
|
!分配ELECTROMAGNETIC_VARIABLES中的数组
|
|
WRITE(*,*)'Allocating memory... ...'
|
|
ALLOCATE(EX(NX,NYB,NZB), EY(NXB,NY,NZB), EZ(NXB,NYB,NZ), STAT=ERR)
|
|
ALLOCATE(HX(NXB,NY,0:NZ), HY(NX,NYB,0:NZ), HZ(NX,NY,NZB), STAT=ERR)
|
|
!分配RES_MODEL_PARAMETER中的数组
|
|
ALLOCATE(CCSIG(NX,NY,NZ), STAT=ERR)
|
|
!分配TIME_PARAMETER中的数组
|
|
ALLOCATE(CTIME(NSTOP), STAT=ERR)
|
|
ALLOCATE(DELT(0:NSTOP), STAT=ERR)
|
|
allocate(Eps_r(nstop),Cq(nstop))
|
|
allocate(is_ex_in_source(nx,2:nyb-1),is_ey_in_source(2:nx,ny))
|
|
allocate(RecHzFile(NumRecHeights+1,NumRecLines),RecHEFile(NumRecHeights+1,NumRecLines))
|
|
allocate(RecFile(NumRecHeights+1,NumRecLines),RecFilePid(NumRecHeights+1,NumRecLines))
|
|
allocate(RecHzFilePid(NumRecHeights+1,NumRecLines),RecHEFilePid(NumRecHeights+1,NumRecLines))
|
|
allocate(Height(NumRecHeights))
|
|
allocate(Coordix3(Nx),Coordiy3(Ny),Coordiz3(Nzb))
|
|
!THIS IS THE ARRAY FOR NON-UNIFORM GRID
|
|
ALLOCATE(CDELX(NX),CDELY(NY),CDELZ(NZ),STAT=ERR)
|
|
RETURN
|
|
ENDSUBROUTINE ALLOCATEMEMORY
|