📄 elmt002.f90
字号:
rmaxv = 0.0D0
rmaxe = 0.0D0
DO idime = 1, 4
DO jdime = 1, 4
swork( idime, jdime, 2 ) = ( &
twork( idime, jdime, 2 ) * 4.0D0 - &
twork( idime, jdime, 1 ) ) / 3.0D0
IF( kcoun .GT. 1 ) &
cwork( idime, jdime, 2 ) = ( &
swork( idime, jdime, 2 ) * 16.0D0 - &
swork( idime, jdime, 1 ) ) / 15.0D0
IF( kcoun .GT. 2 ) THEN
rwork( idime, jdime, 2 ) = ( &
cwork( idime, jdime, 2 ) * 64.0D0 - &
cwork( idime, jdime, 1 ) ) / 63.0D0
value = DABS( rwork( idime, jdime, 2 ) )
error = DABS( rwork( idime, jdime, 2 ) - &
rwork( idime, jdime, 1 ) )
IF( value .GT. rmaxv ) rmaxv = value
IF( error .GT. rmaxe ) rmaxe = error
END IF
END DO
END DO
IF( kcoun .GT. 2 ) THEN
value = rmaxe / rmaxv
IF( value .LT. 1.0D-3 ) iflag = 0
END IF
halfs = halfs / 2.0D0
nitem = nitem * 2
kcoun = kcoun + 1
END DO
DO idime = 1, 4
DO jdime = 1, 4
rmatx( idime, jdime ) = rwork( idime, jdime, 2 ) * denst * eleng
END DO
END DO
ELSE
const = DATAN( 1.0D0 ) * denst * eleng
DO idime = 1, 4
DO jdime = 1, 4
index = 8 - idime - jdime
rmatx( idime, jdime ) = ( F2( douti, doutj, index ) - &
F2( dinni, dinnj, index ) ) * &
const
END DO
END DO
const = const / ( 16.0D0 * eleng * eleng ) * ibeam
DO idime = 1, 3
DO jdime = 1, 3
index = 6 - idime - jdime
ipara = ( 4 - idime ) * ( 4 - jdime )
rmatx( idime, jdime ) = rmatx( idime, jdime ) + ( &
F4( douti, doutj, index ) - &
F4( dinni, dinnj, index ) ) * &
const * DFLOAT( ipara )
END DO
END DO
END IF
RETURN
END
SUBROUTINE Hmat002( hmatx, imats )
USE CtrlData
USE ElmtData
USE MeshData
IMPLICIT DOUBLE PRECISION( a-h, o-z )
DIMENSION hmatx( 4, 4 )
elast = props( 2, imats )
douti = props( 5, imats )
dinni = props( 6, imats )
doutj = props( 7, imats )
dinnj = props( 8, imats )
itype = props( 9, imats )
IF( itype .EQ. 4 ) const = DABS( props( 15, imats ) )
IF( itype .NE. 4 ) const = DABS( coren( 1, 2 ) - coren( 1, 1 ) )
const = elast * DATAN( 1.0D0 ) / ( 4.0D0 * const ** 3 )
DO idime = 1, 2
DO jdime = 1, 2
index = 4 - idime - jdime
hmatx( idime, jdime ) = ( F4( douti, doutj, index ) - &
F4( dinni, dinnj, index ) ) * &
const * 3 ** index
hmatx( idime + 2, jdime + 2 ) = 0.0D0
hmatx( idime + 2, jdime ) = 0.0D0
hmatx( idime, jdime + 2 ) = 0.0D0
END DO
END DO
RETURN
END
SUBROUTINE MultMtr( amatx, bmatx, cmatx, iswth, nmatx )
USE CtrlData
IMPLICIT DOUBLE PRECISION( a-h, o-z )
DIMENSION amatx( 4, 4 ), bmatx( 4, 4 )
DIMENSION cmatx( nmatx, nmatx )
IF( nmatx .LT. 4 ) THEN
nerrc = 139465
RETURN
END IF
IF( iswth .LT. 0 .OR. iswth .GT. 2 ) THEN
nerrc = 384396
RETURN
END IF
DO idime = 1, 4
DO jdime = 1, 4
cmatx( idime, jdime ) = 0.0D0
DO kdime = 1, 4
IF( iswth .EQ. 0 ) THEN
cmatx( idime, jdime ) = cmatx( idime, jdime ) + &
amatx( idime, kdime ) * bmatx( kdime, jdime )
ELSE IF( iswth .EQ. 1 ) THEN
cmatx( idime, jdime ) = cmatx( idime, jdime ) + &
amatx( kdime, idime ) * bmatx( kdime, jdime )
ELSE IF( iswth .EQ. 2 ) THEN
cmatx( idime, jdime ) = cmatx( idime, jdime ) + &
amatx( idime, kdime ) * bmatx( jdime, kdime )
END IF
END DO
END DO
END DO
RETURN
END
FUNCTION F1( d1, d2, n )
!........
! 函数计算F1
!........
IMPLICIT DOUBLE PRECISION( a-h, o-z )
F1 = ( d1 - d2 ) / ( n + 2 ) + d2 / ( n + 1 )
RETURN
END
FUNCTION F2( d1, d2, n )
!........
! 函数计算F2
!........
IMPLICIT DOUBLE PRECISION( a-h, o-z )
c1 = d1 - d2
F2 = c1 * c1 / DFLOAT( n + 3 ) + &
c1 * d2 / DFLOAT( n + 2 ) * 2.0D0 + &
d2 * d2 / DFLOAT( n + 1 )
RETURN
END
FUNCTION F3( d1, d2, n )
!........
! 函数计算F3
!........
IMPLICIT DOUBLE PRECISION( a-h, o-z )
c21 = d1 - d2
c22 = c21 * c21
c23 = c22 * c21
d21 = d2
d22 = d21 * d21
d23 = d22 * d21
F3 = c23 / DFLOAT( n + 4 ) + &
c22 * d21 * 3.0D0 / DFLOAT( n + 3 ) + &
c21 * d22 * 3.0D0 / DFLOAT( n + 2 ) + &
d23 / DFLOAT( n + 1 )
RETURN
END
FUNCTION F4( d1, d2, n )
!........
! 函数计算F4
!........
IMPLICIT DOUBLE PRECISION( a-h, o-z )
c21 = d1 - d2
c22 = c21 * c21
c23 = c22 * c21
c24 = c23 * c21
d21 = d2
d22 = d21 * d21
d23 = d22 * d21
d24 = d23 * d21
F4 = c24 / DFLOAT( n + 5 ) + &
c23 * d21 * 4.0D0 / DFLOAT( n + 4 ) + &
c22 * d22 * 6.0D0 / DFLOAT( n + 3 ) + &
c21 * d23 * 4.0D0 / DFLOAT( n + 2 ) + &
d24 / DFLOAT( n + 1 )
RETURN
END
SUBROUTINE Trans002( tmatx, eleng )
IMPLICIT DOUBLE PRECISION( a-h, o-z )
DIMENSION tmatx( 4, 4 )
tmatx( 1, 1 ) = 1.0D0
tmatx( 2, 1 ) = 0.0D0
tmatx( 3, 1 ) = 1.0D0
tmatx( 4, 1 ) = 0.0D0
tmatx( 1, 2 ) = 0.0D0
tmatx( 2, 2 ) = 1.0D0
tmatx( 3, 2 ) = eleng
tmatx( 4, 2 ) = 1.0D0
tmatx( 1, 3 ) = 0.0D0
tmatx( 2, 3 ) = 0.0D0
tmatx( 3, 3 ) = 0.0D0
tmatx( 4, 3 ) = 0.0D0
tmatx( 1, 4 ) = 0.0D0
tmatx( 2, 4 ) = 0.0D0
tmatx( 3, 4 ) = 0.0D0
tmatx( 4, 4 ) = 0.0D0
RETURN
END
SUBROUTINE CurveLamina002( xloca, vbend, vtors, imats )
USE CtrlData
USE MeshData
USE ElmtData
IMPLICIT DOUBLE PRECISION( a-h, o-z)
douti = props( 5, imats )
dinni = props( 6, imats )
doutj = props( 7, imats )
dinnj = props( 8, imats )
ibeam = props( 10, imats )
nlami = props( 11, imats )
thick = props( 12, imats )
const = props( 13, imats )
alpha = props( 14, imats )
cnsr1 = ( dinnj + xloca * ( dinni - dinnj ) ) / 2.0D0
cnsr2 = ( doutj + xloca * ( douti - doutj ) ) / 2.0D0
xcoor = ( 1.0D0 - xloca ) * DABS( coren( 1, 2 ) - coren( 1, 1 ) )
vbend = FI002( alpha, const, xcoor, cnsr2, nlami, thick ) - &
FI002( alpha, const, xcoor, cnsr1, nlami, thick )
vtors = FJ002( alpha, const, xcoor, cnsr2, nlami, thick ) - &
FJ002( alpha, const, xcoor, cnsr1, nlami, thick )
IF( ibeam .GT. 0 ) vtors =-vtors
RETURN
END
FUNCTION FI002( alpha, const, xcoor, radus, nlami, thick )
IMPLICIT DOUBLE PRECISION( a-h, o-z )
cnst1 = 0.0D0
IF( DABS( xcoor ) .GT. 1.0D-8 ) &
cnst1 = alpha * const * xcoor ** ( alpha - 1.0D0 )
cnst2 = cnst1 * radus
cnst3 = DSQRT( 1.0D0 + cnst2 * cnst2 )
IF( DABS( cnst1 ) .GT. 1.0D-8 ) THEN
part1 = cnst2 * cnst3
part2 = DLOG( cnst2 + cnst3 )
FI002 = ( part1 + part2 ) * nlami * thick / ( 2.0D0 * cnst1 )
ELSE
FI002 = nlami * thick * radus
END IF
END
FUNCTION FJ002( alpha, const, xcoor, radus, nlami, thick )
IMPLICIT DOUBLE PRECISION( a-h, o-z )
cnst1 = 0.0D0
IF( DABS( xcoor ) .GT. 1.0D-8 ) &
cnst1 = alpha * const * xcoor ** ( alpha - 1.0D0 )
cnst2 = cnst1 * radus
cnst3 = DSQRT( 1.0D0 + cnst2 * cnst2 )
IF( DABS( cnst1 ) .GT. 1.0D-8 ) THEN
part1 = ( 2.0D0 + 1.0D0 / ( cnst2 * cnst2 ) ) * cnst3
part2 = DLOG( cnst2 + cnst3 ) / ( cnst2 * cnst2 * cnst2 )
part3 = const * radus * xcoor ** alpha
part3 = nlami * thick * radus * part3 * part3 / 16.0D0
FJ002 = ( part1 - part2 ) * part3
ELSE
part1 = 1.0D0
IF( DABS( alpha ) .GT. 1.0D-5 ) part1 = xcoor ** alpha
part1 = const * part1 * radus
part2 = nlami * thick * radus / 6.0D0
FJ002 = part1 * part1 * part2
END IF
END
SUBROUTINE C2002( cmatx, xloca, eleng )
IMPLICIT DOUBLE PRECISION( a-h, o-z )
DIMENSION cmatx( 2, 4 )
cmatx( 1, 1 ) = xloca * xloca * xloca
cmatx( 1, 2 ) = xloca * xloca
cmatx( 1, 3 ) = xloca
cmatx( 1, 4 ) = 1.0D0
cmatx( 2, 1 ) =-xloca * xloca * 3.0D0 / eleng
cmatx( 2, 2 ) =-xloca * 2.0D0 / eleng
cmatx( 2, 3 ) =-1.0D0 / eleng
cmatx( 2, 4 ) = 0.0D0
RETURN
END
SUBROUTINE CurveR002( rmatx, cmatx, vbend, vtors, halfs )
IMPLICIT DOUBLE PRECISION( a-h, o-z )
DIMENSION cmatx( 2, 4 ), rmatx( 4, 4 )
DIMENSION tmatx( 2, 2 ), twork( 2, 4 )
tmatx( 1, 1 ) = vbend * halfs
tmatx( 1, 2 ) = 0.0D0
tmatx( 2, 1 ) = 0.0D0
tmatx( 2, 2 ) =-vtors * halfs
DO idime = 1, 2
DO jdime = 1, 4
twork( idime, jdime ) = 0.0D0
DO kdime = 1, 2
twork( idime, jdime ) = twork( idime, jdime ) + &
tmatx( idime, kdime ) * cmatx( kdime, jdime )
END DO
END DO
END DO
DO idime = 1, 4
DO jdime = 1, 4
DO kdime = 1, 2
rmatx( idime, jdime ) = rmatx( idime, jdime ) + &
cmatx( kdime, idime ) * twork( kdime, jdime )
END DO
END DO
END DO
END
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -