📄 input.f90
字号:
DO inodf = 1, nnodf
knodf = knodf + 1
READ( 11, 2600, ERR = 200 ) ipoin, itype, &
( fwork( idofn ), idofn = 1, mdofn )
IF( nprnc .NE. 0 ) &
WRITE( 12, 2800 ) ipoin, itype, ( fwork( idofn ), &
idofn = 1, mdofn )
IF( ipoin .LE. 0 .OR. ipoin .GT. npoin ) THEN
WRITE( 12, 3000 ) ipoin
nerrc = 843676
RETURN
END IF
lnodf( 1, knodf ) = ipoin
lnodf( 2, knodf ) = itype
DO idofn = 1, mdofn
vnodf( idofn, knodf ) = fwork( idofn )
END DO
END DO
END IF
!.........读线分布载荷.
IF( nedgf .GT. 0 ) THEN
IF( nprnc .NE. 0 ) WRITE( 12, 3200 )
DO iedgf = 1, nedgf
ktype = 0
kedgf = kedgf + 1
WRITE( 12, 3400 ) iedgf
DO inodg = 1, nnodg
READ( 11, 2600, ERR = 400 ) ipoin, itype, &
( fwork( idofn ), idofn = 1, mdofn )
IF( nprnc .NE. 0 ) &
WRITE( 12, 2800 ) ipoin, itype, ( fwork( idofn ), &
idofn = 1, mdofn )
IF( ipoin .GT. npoin ) THEN
WRITE( 12, 3600 ) ipoin
nerrc = 843676
RETURN
END IF
IF( ktype .EQ. 0 ) THEN
ktype = itype
ELSE
IF( itype .NE. 0 .AND. itype .NE. ktype ) THEN
WRITE( 12, 3800 )
nerrc = 54868
RETURN
END IF
END IF
ledgf( inodg, kedgf ) = ipoin
DO idofn = 1, mdofn
locat = ( inodg - 1 ) * mdofn + idofn
vedgf( locat, kedgf ) = fwork( idofn )
END DO
END DO
ledgf( mnodg, kedgf ) = ktype
END DO
END IF
!.........读面分布载荷.
IF( nplnf .GT. 0 ) THEN
IF( nprnc .NE. 0 ) WRITE( 12, 4000 )
DO iplnf = 1, nplnf
ktype = 0
kplnf = kplnf + 1
WRITE( 12, 3400 ) iplnf
DO inodp = 1, nnodp
READ( 11, 2600, ERR = 400 ) ipoin, itype, &
( fwork( idofn ), idofn = 1, mdofn )
IF( nprnc .NE. 0 ) &
WRITE( 12, 2800 ) ipoin, itype, ( fwork( idofn ), &
idofn = 1, mdofn )
IF( ipoin .GT. npoin ) THEN
WRITE( 12, 4200 ) ipoin
nerrc = 843676
RETURN
END IF
IF( ktype .EQ. 0 ) THEN
ktype = itype
ELSE
IF( itype .NE. 0 .AND. itype .NE. ktype ) THEN
WRITE( 12, 4400 )
nerrc = 54868
RETURN
END IF
END IF
lplnf( inodp, kplnf ) = ipoin
DO idofn = 1, mdofn
locat = ( inodp - 1 ) * mdofn + idofn
vplnf( locat, kplnf ) = fwork( idofn )
END DO
END DO
lplnf( mnodp, kplnf ) = ktype
END DO
END IF
END DO
RETURN
200 WRITE( 12, 4600 )
nerrc = 1013
RETURN
400 WRITE( 12, 4800 )
nerrc = 1014
RETURN
600 WRITE( 12, 5000 )
nerrc = 1015
RETURN
2000 FORMAT( //20x, ' 载荷工况 ', I5 )
2200 FORMAT( 3I5 )
2400 FORMAT( //10x, ' = = = = 节 点 载 荷 = = = = ' // &
2x, ' 节点 类型 节 点 载 荷 值' )
2600 FORMAT( 2I5, 4F15.5 / ( 10X, 4F15.5 ) )
2800 FORMAT( 2x, 2I5, 3x, 4F15.5 / ( 15X, 4F15.5 ) )
3000 FORMAT( //2x, '致命错误: 节点力作用在无效的节点上 ', I5 )
3200 FORMAT( //10x, ' = = = = 线 分 布 载 荷 = = = =' / &
2x, ' 节点 类型 分 布 载 荷 值' )
3400 FORMAT( /20x, ' 序号', I5 )
3600 FORMAT( //2x, '致命错误: 线分布力作用在无效的节点上 ', I5 )
3800 FORMAT( //2x, '致命错误: 线分布力不可重复定义动载类型' )
4000 FORMAT( //10x, ' = = = = 面 分 布 载 荷 = = = =' / &
2x, ' 节点 类型 分 布 载 荷 值' )
4200 FORMAT( //2x, '致命错误: 面分布力作用在无效的节点上 ', I5 )
4400 FORMAT( //2x, '致命错误: 面分布力不可重复定义动载类型' )
4600 FORMAT( // 2x, '错误: 读节点载荷出错' )
4800 FORMAT( // 2x, '错误: 读线分布载荷出错' )
5000 FORMAT( // 2x, '错误: 读面分布载荷出错' )
END
SUBROUTINE RDCnt
!........
! 模块功能
! 读入集中质量, 集中刚度, 集中阻尼.
!........
USE CtrlData
USE CentData
IMPLICIT DOUBLE PRECISION( a-h, o-z )
IF( nerrc .GT. 0 ) RETURN
CALL ShowMessage( '读质点信息...' )
!.......读入集中质量.
IF( nmssp .GT. 0 ) THEN
IF( nprnc .NE. 0 ) WRITE( 12, 2000 )
DO imssp = 1, nmssp
READ( 11, 2200 ) lmssp( 1, imssp ), lmssp( 2, imssp ), &
vmssp( imssp )
IF( nprnc .NE. 0 ) &
WRITE( 12, 2400 ) lmssp( 1, imssp ), lmssp( 2, imssp ), &
vmssp( imssp )
IF( lmssp( 1, imssp ) .LE. 0 .OR. &
lmssp( 1, imssp ) .GT. npoin .OR. &
lmssp( 2, imssp ) .LE. 0 .OR. &
lmssp( 2, imssp ) .GT. mdofn ) THEN
nerrc = 2134
RETURN
END IF
END DO
END IF
!.......读入集中刚度.
IF( nstfp .GT. 0 ) THEN
IF( nprnc .NE. 0 ) WRITE( 12, 2600 )
DO istfp = 1, nstfp
READ( 11, 2200 ) lstfp( 1, istfp ), lstfp( 2, istfp ), &
vstfp( istfp )
IF( nprnc .NE. 0 ) &
WRITE( 12, 2400 ) lstfp( 1, istfp ), lstfp( 2, istfp ), &
vstfp( istfp )
IF( lstfp( 1, istfp ) .LE. 0 .OR. &
lstfp( 1, istfp ) .GT. npoin .OR. &
lstfp( 2, istfp ) .LE. 0 .OR. &
lstfp( 2, istfp ) .GT. mdofn ) THEN
nerrc = 2134
RETURN
END IF
END DO
END IF
!.......读入集中阻尼.
IF( ndmpp .GT. 0 ) THEN
IF( nprnc .NE. 0 ) WRITE( 12, 2800 )
DO idmpp = 1, ndmpp
READ( 11, 2200 ) ldmpp( 1, idmpp ), ldmpp( 2, idmpp ), &
vdmpp( idmpp )
IF( nprnc .NE. 0 ) &
WRITE( 12, 2400 ) ldmpp( 1, idmpp ), ldmpp( 2, idmpp ), &
vdmpp( idmpp )
IF( ldmpp( 1, idmpp ) .LE. 0 .OR. &
ldmpp( 1, idmpp ) .GT. npoin .OR. &
ldmpp( 2, idmpp ) .LE. 0 .OR. &
ldmpp( 2, idmpp ) .GT. mdofn ) THEN
nerrc = 2134
RETURN
END IF
END DO
END IF
2000 FORMAT(/10x, '= = = = = 集 中 质 量 = = = = =' // &
10x, ' 节点 自由度 集中质量' )
2200 FORMAT( 2I5, F15.5 )
2400 FORMAT( 10x, I5, 3x, I5, E15.5 )
2600 FORMAT(/10x, '= = = = = 集 中 刚 度 = = = = =' // &
10x, ' 节点 自由度 集中刚度' )
2800 FORMAT(/10x, '= = = = = 集 中 阻 尼 = = = = =' // &
10x, ' 节点 自由度 集中阻尼' )
RETURN
END
SUBROUTINE RDSlnt
USE CtrlData
USE MeshData
IMPLICIT DOUBLE PRECISION( a-h, o-z )
IF( nerrc .GT. 0 ) RETURN
CALL ShowMessage( '读斜约束信息...' )
IF( nslnt .LE. 0 ) RETURN
IF( nprnc .NE. 0 ) WRITE( 12, 1800 )
DO islnt = 1, nslnt
READ( 11, 2000 ) ipoin, idofn, ( vslnt( jdofn, islnt ), &
jdofn = 1, mdofn )
lslnt( 1, islnt ) = ipoin
lslnt( 2, islnt ) = idofn
IF( ipoin .LT.-ndime .OR. ipoin .EQ. 0 .OR. &
ipoin .GT. npoin ) THEN
WRITE( 12, 2200 ) ipoin
nerrc = 10213
RETURN
END IF
IF( idofn .LE. 0 .OR. idofn .GT. mdofn ) THEN
WRITE( 12, 2400 ) idofn
nerrc = 12543
RETURN
END IF
IF( nprnc .NE. 0 ) &
WRITE( 12, 2600 ) ipoin, idofn, ( vslnt( jdofn, islnt ), &
jdofn = 1, mdofn )
END DO
1800 FORMAT( // 10X, '= = = = = 广 义 自 由 度 = = = = = ' // &
1X, '节点 自由度 自由度转化系数')
2000 FORMAT( 2I5, 4F15.5 / ( 10X, 4F15.5 ) )
2200 FORMAT( 1X, '错误: 广义自由度对应无效的节点', I5 )
2400 FORMAT( 1X, '错误: 广义自由度对应无效的主自由度', I5 )
2600 FORMAT( I5, 3X, I4, 3X, 3F15.5 / ( 15X, 3F15.5 ) )
RETURN
END
SUBROUTINE RdOptAxis
USE CtrlData
USE MeshData
IMPLICIT DOUBLE PRECISION( a-h, o-z )
DIMENSION axist( 3 )
const = 0.0D0
IF( nerrc .GT. 0 ) RETURN
READ( 11, '( 3F15.5 )' ) basew
DO idime = 1, ndime
READ( 11, '( 3F15.5 )' ) axist
DO jdime = 1, ndime
axisw( idime, jdime ) = axist( jdime )
const = const + DABS( axist( jdime ) )
END DO
END DO
IF( const .LT. 1.0D-8 ) THEN
DO idime = 1, ndime
axisw( idime, idime ) = 1.0D0
END DO
END IF
axist( 1 ) = 0.0D0
axist( 2 ) = 0.0D0
axist( 3 ) = 0.0D0
IF( nprnc .NE. 0 ) THEN
DO idime = 1, ndime
axist( idime ) = basew( idime )
END DO
WRITE( 12, 2000 ) axist
DO idime = 1, ndime
DO jdime = 1, ndime
axist( jdime ) = axisw( idime, jdime )
END DO
WRITE( 12, 2200 ) idime, axist
END DO
END IF
2000 FORMAT( // 15X, '优化中心和优化轴线信息', &
// 2X, '优化中心:', 3F15.5 )
2200 FORMAT( 2X, '第', I2, '轴线:', 3F15.5 )
END
SUBROUTINE AutoLink( strng )
!.......
! 模块功能：
! 坐标相同的节点自动连接.
!.......
USE CtrlData
USE MeshData
CHARACTER * 80 strng
READ( strng( 11:20 ), 2000, ERR = 200 ) vskip
IF( vskip .LT. 1.0D-5 ) vskip = 1.0D-5
DO ipoin = 1, npoin
IF( ipoin .EQ. llnks( ipoin ) ) THEN
DO jpoin = ipoin + 1, npoin
IF( jpoin .EQ. llnks( jpoin ) ) THEN
displ = DABS( coord(1, ipoin) - coord(1, jpoin) )
IF( displ .LT. vskip ) THEN
nflag = 0
DO idime = 2, ndime
displ = DABS( coord( idime, ipoin ) - &
coord( idime, jpoin ) )
IF( displ .GT. vskip ) nflag = 1
END DO
IF( nflag .EQ. 0 ) llnks( jpoin ) = ipoin
END IF
END IF
END DO
END IF
END DO
RETURN
200 nerrc = 32435
WRITE( 12, 2200 )
RETURN
2000 FORMAT( F10.5 )
2200 FORMAT( 2x, // ' 错误的自动连接宏命令!' // )
END
SUBROUTINE MidNode
END
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -