📄 data.f90
字号:
MODULE CtrlData
!........
! 模块内容：
! 本模块包含程序运算过程中的所有控制参数，并负责对它们初始化。
!........
IMPLICIT DOUBLE PRECISION( a-h, o-z )
CHARACTER * 70 title
INTEGER ntypc, nerrc, nlnkc, nprnc, nchkc, nuntc, mswth
INTEGER npoin, nelem, ndime, mdofn, nmats, ndofs, nfmtc
INTEGER nbufs, ndsks, nmode, mnode, nstat, nstrh
INTEGER nprop, nhstr, mdofe, ndofg, ndofp, kaitk
INTEGER nmssp, ndmpp, nstfp, mmssp, mdmpp, mstfp
INTEGER nload, mnodf, medgf, mplnf, nnodg, nnodp
INTEGER nslnt, mslnt, mnodg, mnodp, nexec, kload
INTEGER nfrcc, ndync, nupdc, nrsdc, nearc, nsmts
INTEGER narcc, nstfc, nmssc, ndmpc, necho, kpdis, kpstr
INTEGER nstpc, kstpc, kdofc, nreac, nincc, nshfc
DOUBLE PRECISION dtolc, ftolc, fcttm, fstep, tstep
DOUBLE PRECISION timec, fctor, alpha, belta, theta
DOUBLE PRECISION dstep
DIMENSION lsavc( 3 ), ldecc( 3 )
DIMENSION lsymc( 3 ), shift( 10 )
ALLOCATABLE wdofs(:)
SAVE title, dstep, lsavc, ldecc, lsymc, shift
SAVE ntypc, nerrc, nlnkc, nprnc, nchkc, nuntc
SAVE npoin, nelem, ndime, mdofn, nmats, ndofs
SAVE nbufs, ndsks, nmode, mnode, nstat, nstrh
SAVE nprop, nhstr, mdofe, ndofg, ndofp, kaitk
SAVE nmssp, ndmpp, nstfp, mmssp, mdmpp, mstfp
SAVE nload, mnodf, medgf, mplnf, nnodg, nnodp
SAVE nslnt, mslnt, mnodg, mnodp, nexec, kload
SAVE nfrcc, ndync, nupdc, nrsdc, nearc, nsmts
SAVE narcc, nstfc, nmssc, ndmpc, necho, kpdis, kpstr
SAVE nstpc, kstpc, kdofc, nreac, nincc, nshfc
SAVE dtolc, ftolc, fcttm, fstep, tstep, nfmtc
SAVE timec, fctor, alpha, belta, theta, wdofs
CONTAINS
SUBROUTINE InitMemory
USE dfwin
USE MSFLib
USE VFEAPGlobals
POINTER( pGetDiskSize, GetDiskSize )
POINTER( pGetMemorySize, GetMemorySize )
IF( ghInstVFEAPCom .NE. 0 ) THEN
pGetDiskSize = GetProcAddress( ghInstVFEAPCom, "GetDiskSize"C )
pGetMemorySize = GetProcAddress( ghInstVFEAPCom, "GetMemorySize"C )
IF( pGetMemorySize .NE. 0 ) nbufs = GetMemorySize()
IF( pGetDiskSize .NE. 0 ) ndsks = GetDiskSize()
END IF
IF( nbufs .LE. 0 ) nbufs = 128
IF( ndsks .LE. 0 ) ndsks = 256
nbufs = nbufs * 1024 * 1024 / 8
ndsks = ndsks * 1024 * 1024 / 8
END SUBROUTINE InitMemory
SUBROUTINE InitCtrl
kaitk = 0
nfrcc = 0
nincc = 0
nreac = 0
ndync = 0
nupdc = 0
nrsdc = 0
kpdis = 0
kpstr = 0
ndofc = 0
kstpc = 0
nstat = 0
nuntc = 0
nexec = 1
kload = 1
narcc = 1
nstfc = 1
nmssc = 1
ndmpc = 1
necho = 1
nshfc = 1
nearc = 0
nsmts = 0
mswth = 100
dtolc = 0.0D0
ftolc = 0.0D0
fcttm = 0.0D0
fstep = 0.0D0
timec = 0.0D0
fctor = 1.0D0
tstep = 1.0D0
dstep = 0.0D0
mmssp = nmssp
mstfp = nstfp
mdmpp = ndmpp
mslnt = nslnt
mnodg = nnodg + 1
mnodp = nnodp + 1
ndofg = nnodg * mdofn
ndofp = nnodp * mdofn
mdofe = mnode * mdofn
alpha = 1.0D0 / 2.0D0
belta = 1.0D0 / 4.0D0
theta = 7.0D0 / 5.0D0
IF( nload .EQ. 0 ) nload = 1
IF( mnodf .EQ. 0 ) mnodf = 1
IF( medgf .EQ. 0 ) medgf = 1
IF( mplnf .EQ. 0 ) mplnf = 1
IF( nmssp .EQ. 0 ) mmssp = 1
IF( nstfp .EQ. 0 ) mstfp = 1
IF( ndmpp .EQ. 0 ) mdmpp = 1
IF( nslnt .EQ. 0 ) mslnt = 1
IF( nnodg .EQ. 0 ) mnodg = 1
IF( nnodp .EQ. 0 ) mnodp = 1
ndofs = npoin * mdofn
DO imatx = 1, 3
lsavc( imatx ) = 0
ldecc( imatx ) = 0
END DO
lsavc( 1 ) = 1
IF( ntypc .GE. 1 ) lsavc( 2 ) = 1
IF( ntypc .GE. 4 ) lsavc( 3 ) = 1
IF( ntypc .GE. 4 ) ntypc = ntypc - 3
ALLOCATE( wdofs( mdofn ), STAT = ierro )
IF( ierro .GT. 0 ) nerrc = 6
IF( nerrc .NE. 0 ) RETURN
DO idofn = 1, mdofn
wdofs( idofn ) = 1.0D0
END DO
END SUBROUTINE InitCtrl
SUBROUTINE DelCtrl
IF( ALLOCATED( wdofs ) ) DEALLOCATE( wdofs )
END SUBROUTINE DelCtrl
END MODULE CtrlData
MODULE MacroData
!.......
! 模块内容：
! 本模块包含所有宏命令所需的数据，负责对它们初始化，并读入对应的数据。
!.......
IMPLICIT DOUBLE PRECISION( a-h, o-z )
CHARACTER * 15 macro
CHARACTER * 15 mrems
INTEGER mmacr, nmacr, kmacr, mcmds, mvars
ALLOCATABLE macro(:), mrems(:), lmacr(:,:), pmacr(:,:)
SAVE mmacr, nmacr, kmacr, mcmds
SAVE macro, mrems, lmacr, pmacr
CONTAINS
SUBROUTINE InitMacro
USE dfwin
USE MSFLib
USE CtrlData
USE VFEAPGlobals
CHARACTER * 256 namef
CHARACTER * 256 filen, direc
CHARACTER * 256 drive, exten
CHARACTER * 15 cmmnd, mcrem
POINTER( pGetMaxMacro, GetMaxMacro )
POINTER( pGetMaxVariable, GetMaxVariable )
IF( ghInstVFEAPCom .NE. 0 ) THEN
pGetMaxMacro = GetProcAddress( ghInstVFEAPCom, "GetMaxMacro"C )
pGetMaxVariable = GetProcAddress( ghInstVFEAPCom, "GetMaxVariable"C )
IF( pGetMaxVariable .NE. 0 ) mvars = GetMaxVariable()
IF( pGetMaxMacro .NE. 0 ) mmacr = GetMaxMacro()
END IF
IF( mmacr .LT. 100 ) mmacr = 100
IF( mvars .LT. 20 ) mvars = 20
i = GetModuleFileName( NULL, filen, 256 )
i = SplitPathQQ( filen, drive, direc, namef, exten )
namef = TRIM( drive ) // TRIM( direc ) // 'Macro.Set'
OPEN( 25, FILE = namef )
READ( 25, 2000 ) ncmds, mcmds
mcmds = mcmds + 2
kmacr = 1
ALLOCATE( macro( mcmds ), lmacr( 5, mmacr ), &
mrems( mcmds ), pmacr( 5, mmacr ), STAT = ierro )
IF( ierro .GT. 0 ) nerrc = 6
IF( nerrc .GT. 0 ) RETURN
CALL InitInteger( lmacr, mmacr * 5, 0 )
CALL InitFloat( pmacr, mmacr * 5, 0.0D0 )
DO icmds = 1, mcmds
macro( icmds ) = ' '
mrems( icmds ) = ' '
END DO
DO icmds = 1, ncmds
READ( 25, 2200 ) icomm, cmmnd, mcrem
IF( icomm .LE. 0 ) nerrc = 3016
IF( icomm .GT. mcmds - 2 ) nerrc = 3016
IF( nerrc .GT. 0 ) RETURN
macro( icomm ) = cmmnd
mrems( icomm ) = mcrem
END DO
CLOSE( 25 )
macro( mcmds - 1 ) = 'rem '
macro( mcmds ) = 'endmacro '
2000 FORMAT( 3I5 )
2200 FORMAT( I5, 1X, A15, A15 )
RETURN
END SUBROUTINE InitMacro
SUBROUTINE ShowMacro
USE CtrlData
icmds = lmacr( 1, kmacr )
IF( icmds .EQ. 0 ) THEN
CALL ShowMessage( '分析完成' )
ELSE
IF( necho .NE. 0 ) CALL ShowMessage( mrems( icmds ) )
END IF
RETURN
END SUBROUTINE ShowMacro
SUBROUTINE DelMacro
IF( ALLOCATED( macro ) ) DEALLOCATE( macro )
IF( ALLOCATED( mrems ) ) DEALLOCATE( mrems )
IF( ALLOCATED( lmacr ) ) DEALLOCATE( lmacr )
IF( ALLOCATED( pmacr ) ) DEALLOCATE( pmacr )
END SUBROUTINE DelMacro
END MODULE MacroData
MODULE MeshData
!........
! 模块内容：
! 本模块包含程序运算过程中的所有网格参数，并负责对它们初始化。
!........
IMPLICIT DOUBLE PRECISION( a-h, o-z )
ALLOCATABLE coord(:,:), lnods(:,:), basew(:)
ALLOCATABLE lslnt(:,:), vslnt(:,:), temps(:)
ALLOCATABLE lfixs(:,:), vfixs(:,:), llnks(:)
ALLOCATABLE props(:,:), lprps(:,:), lmats(:)
ALLOCATABLE axisw(:,:)
SAVE coord, lnods, lslnt, vslnt, lprps, basew
SAVE lfixs, vfixs, llnks, props, lmats, temps, axisw
CONTAINS
SUBROUTINE InitMesh
USE CtrlData
nmatp = mdofn + 3
IF( nerrc .GT. 0 ) RETURN
ALLOCATE( coord( ndime, npoin ), basew( ndime ), &
lfixs( mdofn, npoin ), lmats( nelem ), &
vfixs( mdofn, npoin ), temps( npoin ), &
props( nprop, nmats ), llnks( npoin ), &
vslnt( mdofn, mslnt ), lslnt( 2, mslnt ), &
axisw( ndime, ndime ), lprps( nmatp, nmats ), &
lnods( mnode, nelem ), STAT = ierro )
IF( ierro .GT. 0 ) nerrc = 3
IF( nerrc .GT. 0 ) RETURN
CALL InitFloat( basew, ndime, 0.0D0 )
CALL InitFloat( temps, npoin, 0.0D0 )
CALL InitFloat( axisw, ndime * ndime, 0.0D0 )
CALL InitFloat( coord, ndime * npoin, 9.9D9 )
CALL InitFloat( vslnt, mdofn * mslnt, 0.0D0 )
CALL InitFloat( vfixs, mdofn * npoin, 0.0D0 )
CALL InitFloat( props, nprop * nmats, 0.0D0 )
CALL InitInteger( lprps, nmatp * nmats, 0 )
CALL InitInteger( lnods, mnode * nelem, 0 )
CALL InitInteger( lslnt, 2 * mslnt, 0 )
CALL InitInteger( lfixs, mdofn * npoin, 0 )
CALL InitInteger( lmats, nelem, 0 )
CALL InitInteger( llnks, npoin, 0 )
END SUBROUTINE InitMesh
SUBROUTINE DelMesh
IF( ALLOCATED( coord ) ) DEALLOCATE( coord )
IF( ALLOCATED( lnods ) ) DEALLOCATE( lnods )
IF( ALLOCATED( lslnt ) ) DEALLOCATE( lslnt )
IF( ALLOCATED( vslnt ) ) DEALLOCATE( vslnt )
IF( ALLOCATED( lfixs ) ) DEALLOCATE( lfixs )
IF( ALLOCATED( temps ) ) DEALLOCATE( temps )
IF( ALLOCATED( vfixs ) ) DEALLOCATE( vfixs )
IF( ALLOCATED( props ) ) DEALLOCATE( props )
IF( ALLOCATED( lmats ) ) DEALLOCATE( lmats )
IF( ALLOCATED( llnks ) ) DEALLOCATE( llnks )
IF( ALLOCATED( lprps ) ) DEALLOCATE( lprps )
IF( ALLOCATED( basew ) ) DEALLOCATE( basew )
IF( ALLOCATED( axisw ) ) DEALLOCATE( axisw )
END SUBROUTINE DelMesh
END MODULE MeshData
MODULE ExtraMesh
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -