📄 elmlib.f90
字号:
END IF
END DO
RETURN
END
SUBROUTINE ElmInf( ielem, iswth )
!........
! 模块功能
! 从总体信息中获得单元信息.
!........
USE CtrlData
USE MeshData
USE ElmtData
USE GlobData
USE SolvData
IMPLICIT DOUBLE PRECISION( a-h, o-z )
ALLOCATABLE tmatx(:,:), vmatx(:)
IF( nhstr .GT. 0 ) THEN
DO ihstr = 1, nhstr
histe( ihstr ) = histr( ihstr, ielem )
END DO
END IF
IF( nstrh .GT. 0 ) THEN
DO istrh = 1, nstrh
strhe( istrh ) = strsh( istrh, ielem )
END DO
END IF
DO inode = 1, nnode
lnode( inode ) = lnods( inode, ielem )
ipoin = IABS( lnods( inode, ielem ) )
IF( ipoin .GT. 0 ) THEN
tempe( inode ) = temps( ipoin )
DO idime = 1, ndime
coren( idime, inode ) = coord( idime, ipoin )
END DO
DO idofn = 1, ndofn
idofs = ( ipoin - 1 ) * mdofn + idofn
idofe = ( inode - 1 ) * ndofn + idofn
dishe( idofe ) = disph( idofs, kload )
dispe( idofe ) = disps( idofs, kload )
dspie( idofe ) = dspis( idofs, kload )
dispt( idofe ) = distm( idofs, kload )
dishe( idofe ) = disph( idofs, kload )
IF( iswth .EQ. 13 ) dispe( idofe ) = vslvs( idofs )
END DO
IF( ntypc .EQ. 2 ) THEN
DO idofn = 1, ndofn
idofs = ( ipoin - 1 ) * mdofn + idofn
idofe = ( inode - 1 ) * ndofn + idofn
accen( idofe ) = accel( idofs, kload )
accet( idofe ) = acctm( idofs, kload )
velen( idofe ) = veloc( idofs, kload )
velet( idofe ) = veltm( idofs, kload )
END DO
END IF
ELSE
tempe( inode ) = 0.0D0
DO idime = 1, ndime
coren( idime, inode ) = 0.0D0
END DO
DO idofn = 1, ndofn
idofe = ( inode - 1 ) * ndofn + idofn
dispe( idofe ) = 0.0D0
dspie( idofe ) = 0.0D0
dishe( idofe ) = 0.0D0
dispt( idofe ) = 0.0D0
dishe( idofe ) = 0.0D0
IF( ntypc .EQ. 2 ) THEN
accen( idofe ) = 0.0D0
velen( idofe ) = 0.0D0
accet( idofe ) = 0.0D0
velet( idofe ) = 0.0D0
END IF
END DO
END IF
END DO
IF( nslnt .LE. 0 ) RETURN
ALLOCATE( tmatx( mdofn, mdofn ), vmatx( mdofn ), STAT = ierro )
IF( ierro .NE. 0 ) nerrc = 35656
IF( nerrc .GT. 0 ) RETURN
DO inode = 1, nnode
label = 0
ipoin = IABS( lnode( inode ) )
DO idofn = 1, mdofn
DO jdofn = 1, mdofn
tmatx( idofn, jdofn ) = 0.0D0
END DO
tmatx( idofn, idofn ) = 1.0D0
END DO
IF( ipoin .GT. 0 ) THEN
DO islnt = 1, nslnt
jpoin = lslnt( 1, islnt )
jdofn = lslnt( 2, islnt )
IF( ipoin .EQ. jpoin ) THEN
label = label + 1
DO idofn = 1, mdofn
tmatx( jdofn, idofn ) = vslnt( idofn, islnt )
END DO
ELSE IF( jpoin .LT. 0 ) THEN
idime =-ipoin
IF( DABS( coord( idime, ipoin ) ) .LT. 1.0D-10 ) THEN
label = label + 1
DO idofn = 1, mdofn
tmatx( jdofn, idofn ) = vslnt( idofn, islnt )
END DO
END IF
END IF
END DO
IF( label .GT. 0 ) THEN
CALL Invers( tmatx, mdofn, mdofn, nerrc )
DO idofn = 1, ndofn
vmatx( idofn ) = 0.0D0
DO jdofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + jdofn
vmatx( idofn ) = vmatx( idofn ) + &
tmatx( idofn, jdofn ) * dispe( locat )
END DO
END DO
DO idofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + idofn
dispe( locat ) = vmatx( idofn )
END DO
DO idofn = 1, ndofn
vmatx( idofn ) = 0.0D0
DO jdofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + jdofn
vmatx( idofn ) = vmatx( idofn ) + &
tmatx( idofn, jdofn ) * dspie( locat )
END DO
END DO
DO idofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + idofn
dspie( locat ) = vmatx( idofn )
END DO
DO idofn = 1, ndofn
vmatx( idofn ) = 0.0D0
DO jdofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + jdofn
vmatx( idofn ) = vmatx( idofn ) + &
tmatx( idofn, jdofn ) * dishe( locat )
END DO
END DO
DO idofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + idofn
dishe( locat ) = vmatx( idofn )
END DO
DO idofn = 1, ndofn
vmatx( idofn ) = 0.0D0
DO jdofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + jdofn
vmatx( idofn ) = vmatx( idofn ) + &
tmatx( idofn, jdofn ) * dispt( locat )
END DO
END DO
DO idofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + idofn
dispt( locat ) = vmatx( idofn )
END DO
IF( ntypc .EQ. 2 ) THEN
DO idofn = 1, ndofn
vmatx( idofn ) = 0.0D0
DO jdofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + jdofn
vmatx( idofn ) = vmatx( idofn ) + &
tmatx( idofn, jdofn ) * velen( locat )
END DO
END DO
DO idofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + idofn
velen( locat ) = vmatx( idofn )
END DO
DO idofn = 1, ndofn
vmatx( idofn ) = 0.0D0
DO jdofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + jdofn
vmatx( idofn ) = vmatx( idofn ) + &
tmatx( idofn, jdofn ) * accen( locat )
END DO
END DO
DO idofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + idofn
accen( locat ) = vmatx( idofn )
END DO
DO idofn = 1, ndofn
vmatx( idofn ) = 0.0D0
DO jdofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + jdofn
vmatx( idofn ) = vmatx( idofn ) + &
tmatx( idofn, jdofn ) * velet( locat )
END DO
END DO
DO idofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + idofn
velet( locat ) = vmatx( idofn )
END DO
DO idofn = 1, ndofn
vmatx( idofn ) = 0.0D0
DO jdofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + jdofn
vmatx( idofn ) = vmatx( idofn ) + &
tmatx( idofn, jdofn ) * accet( locat )
END DO
END DO
DO idofn = 1, ndofn
locat = ( inode - 1 ) * ndofn + idofn
accet( locat ) = vmatx( idofn )
END DO
END IF
END IF
END IF
END DO
DEALLOCATE( tmatx, vmatx )
RETURN
END
SUBROUTINE NodDof
USE CtrlData
USE MeshData
USE GlobData
USE ElmtData
IMPLICIT DOUBLE PRECISION( a-h, o-z )
DO ipoin = 1, npoin
ldofs( ipoin ) = 0
END DO
DO ielem = 1, nelem
imats = lmats( ielem )
itype = lprps( 1, imats )
CALL ElmPar( ielem )
DO inode = 1, nnode
ipoin = lnods( inode, ielem )
ipoin = IABS( ipoin )
IF( ipoin .GT. 0 ) THEN
IF( ndofn .GT. ldofs( ipoin ) ) ldofs( ipoin ) = ndofn
END IF
END DO
END DO
RETURN
END
SUBROUTINE ElmPar( ielem )
!........
! 模块功能
! 确定单元的有效参数: 有效节点, 有效自由度数, 有效材料参数.
!........
USE CtrlData
USE MeshData
USE ElmtData
IMPLICIT DOUBLE PRECISION( a-h, o-z )
iswth = 8
! iload = kload
! kload = 1
nnode = mnode
ndofn = mdofn
imats = lmats( ielem )
CALL ElmOpt( imats, iswth )
IF( nnode .GT. mnode ) nnode = mnode
IF( ndofn .GT. mdofn ) nerrc = 21435
IF( nerrc .GT. 0 ) RETURN
ndofe = nnode * ndofn
! kload = iload
RETURN
END
SUBROUTINE Invers( matrx, mdime, ndime, nerrc )
!........
! 模块功能
! 高斯-若当法求逆矩阵
!........
! 说明
! 算法参考<<数值方法>>, 易大义等编著, 浙江科技出版社, 1984
!........
IMPLICIT DOUBLE PRECISION( a-h, o-z )
DOUBLE PRECISION matrx( mdime, mdime )
ALLOCATABLE lwork(:), vmatx(:)
ALLOCATE( lwork( ndime ), vmatx( ndime ), STAT = nerrc )
IF( nerrc .NE. 0 ) THEN
nerrc = 324678
RETURN
END IF
DO idime = 1, ndime
lwork( idime ) = idime
END DO
DO idime = 1, ndime
!.........选主元.
kmaxi = 0
vmaxi = 0.0D0
DO jdime = idime, ndime
vwork = DABS( matrx( jdime, idime ) )
IF( vwork .GT. DABS( vmaxi ) ) THEN
vmaxi = matrx( jdime, idime )
kmaxi = jdime
END IF
END DO
IF( DABS( vmaxi ) .LT. 1.0D-20 ) THEN
DEALLOCATE( lwork )
nerrc = 439657
RETURN
END IF
!.........如果有必要, 换行.
IF( kmaxi .NE. idime ) THEN
DO jdime = 1, ndime
vwork = matrx( idime, jdime )
matrx( idime, jdime ) = matrx( kmaxi, jdime )
matrx( kmaxi, jdime ) = vwork
END DO
iwork = lwork( idime )
lwork( idime ) = lwork( kmaxi )
lwork( kmaxi ) = iwork
END IF
vmaxi = 1.0D0 / vmaxi
matrx( idime, idime ) = vmaxi
DO jdime = 1, ndime
IF( jdime .NE. idime ) &
matrx( jdime, idime ) =-matrx( jdime, idime ) * vmaxi
END DO
!.........消元计算.
DO jdime = 1, ndime
DO kdime = 1, ndime
IF( jdime .NE. idime .AND. kdime .NE. idime ) THEN
matrx( jdime, kdime ) = matrx( jdime, kdime ) + &
matrx( jdime, idime ) * matrx( idime, kdime )
END IF
END DO
END DO
!.........计算主行.
DO jdime = 1, ndime
IF( idime .NE. jdime ) &
matrx( idime, jdime ) = matrx( idime, jdime ) * vmaxi
END DO
END DO
!.......交换矩阵中的列.
DO idime = 1, ndime
DO jdime = 1, ndime
kdime = lwork( jdime )
vmatx( kdime ) = matrx( idime, jdime )
END DO
DO jdime = 1, ndime
matrx( idime, jdime ) = vmatx( jdime )
END DO
END DO
DEALLOCATE( lwork, vmatx )
RETURN
END
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -