data.f90

非线性有限元分析程序

        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        ALLOCATABLE lnodx(:,:), coorx(:,:), lprtx(:)
        ALLOCATABLE dispx(:,:), strsx(:,:), smodx(:,:)
        ALLOCATABLE histx(:,:), strhx(:,:), dsphx(:,:)
        ALLOCATABLE strnx(:,:)

        INTEGER nnodx, nelmx, ndofx
        SAVE lnodx, coorx, dispx, strsx, lprtx, smodx
        SAVE nnodx, nelmx, ndofx, strhx, dsphx, strnx

        CONTAINS
          SUBROUTINE InitExtraMesh
            USE CtrlData
            ndofx = mdofn * nnodx
            IF( nnodx .EQ. 0 .AND. nelmx .EQ. 0 ) RETURN
            IF( nnodx .NE. 0 ) THEN
              ALLOCATE( coorx( ndime, nnodx ), strsx( 7, nnodx ),          &
                        dispx( ndofx, nload ), strnx( 7, nnodx ),          &
						dsphx( ndofx, nload ), STAT = ierro )
              IF( ierro .NE. 0 ) nerrc = 4
              IF( nerrc .GT. 0 ) RETURN
              CALL InitFloat( coorx, ndime * nnodx, 0.0D0 )
              CALL InitFloat( strsx,     7 * nnodx, 0.0D0 )
              CALL InitFloat( strnx,     7 * nnodx, 0.0D0 )
              CALL InitFloat( Dispx, ndofx * nload, 0.0D0 )
              CALL InitFloat( dsphx, ndofx * nload, 0.0D0 )
              IF( nmode .GT. 0 ) THEN
                ALLOCATE( smodx( ndofx, nmode ), STAT = ierro )
                IF( ierro .NE. 0 ) nerrc = 4
                IF( nerrc .GT. 0 ) RETURN
              END IF
            END IF
            IF( nelmx .NE. 0 ) THEN
              ALLOCATE( lnodx( mnode, nelmx ), lprtx( nelem ),                 &
                        STAT = ierro )
              IF( ierro .NE. 0 ) nerrc = 4
              IF( nerrc .GT. 0 ) RETURN
              IF( nhstr .NE. 0 ) THEN
                ALLOCATE( histx( nhstr, nelmx ), STAT = ierro )
                IF( ierro .NE. 0 ) nerrc = 4
                IF( nerrc .GT. 0 ) RETURN
                CALL InitFloat( histx, nhstr * nelmx, 0.0D0 )
              END IF

              IF( nstrh .GT. 0 ) THEN
                ALLOCATE( strhx( nstrh, nelmx ), STAT = ierro )
                IF( ierro .NE. 0 ) nerrc = 4
                IF( nerrc .GT. 0 ) RETURN
                CALL InitFloat( strhx, nstrh * nelmx, 0.0D0 )
              END IF
            END IF
          END SUBROUTINE InitExtraMesh

          SUBROUTINE DelExtraMesh
            USE CtrlData
            IF( ALLOCATED( smodx ) ) DEALLOCATE( smodx )
            IF( ALLOCATED( coorx ) ) DEALLOCATE( coorx )
            IF( ALLOCATED( dispx ) ) DEALLOCATE( dispx )
            IF( ALLOCATED( strsx ) ) DEALLOCATE( strsx )
            IF( ALLOCATED( strnx ) ) DEALLOCATE( strnx )
            IF( ALLOCATED( lnodx ) ) DEALLOCATE( lnodx )
            IF( ALLOCATED( lprtx ) ) DEALLOCATE( lprtx )
            IF( ALLOCATED( histx ) ) DEALLOCATE( histx )
            IF( ALLOCATED( strhx ) ) DEALLOCATE( strhx )
            IF( ALLOCATED( dsphx ) ) DEALLOCATE( dsphx )
          END SUBROUTINE DelExtraMesh
        END MODULE ExtraMesh

        MODULE AutoMeshData
        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        ALLOCATABLE vdims(:), ldims(:,:)
        SAVE vdims, ldims

        CONTAINS
          SUBROUTINE InitAutoMesh
          USE CtrlData
          IMPLICIT DOUBLE PRECISION( a-h, o-z )
          ALLOCATE( vdims( npoin ), ldims( ndime, nelem ),                     &
          STAT = ierro )
          IF( ierro .NE. 0 ) nerrc = 4
          IF( nerrc .GT. 0 ) RETURN
          CALL InitFloat( vdims, npoin, 0.0D0 )
          CALL InitInteger( ldims, ndime * nelem, 0 )
          END SUBROUTINE InitAutoMesh

          SUBROUTINE DelAutoMesh
          IF( ALLOCATED( vdims ) ) DEALLOCATE( vdims )
          IF( ALLOCATED( ldims ) ) DEALLOCATE( ldims )
          END SUBROUTINE DelAutoMesh
        END MODULE AutoMeshData

        MODULE CentData
        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        ALLOCATABLE lmssp(:,:), vmssp(:)
        ALLOCATABLE ldmpp(:,:), vdmpp(:)
        ALLOCATABLE lstfp(:,:), vstfp(:)
        SAVE lmssp, vmssp, ldmpp, vdmpp, lstfp, vstfp

        CONTAINS
          SUBROUTINE InitCent
            USE CtrlData
            IF( nerrc .GT. 0 ) RETURN
            ALLOCATE( lmssp( 2, mmssp ), vmssp( mmssp ),                       &
                      lstfp( 2, mstfp ), vstfp( mstfp ),                       &
                      ldmpp( 2, mdmpp ), vdmpp( mdmpp ), STAT = ierro )
            IF( ierro .GT. 0 ) nerrc = 3
            IF( nerrc .GT. 0 ) RETURN
            CALL InitFloat( vmssp, mmssp, 0.0D0 )
            CALL InitFloat( vstfp, mstfp, 0.0D0 )
            CALL InitFloat( vdmpp, mdmpp, 0.0D0 )
            CALL InitInteger( lmssp, 2 * mmssp, 0 )
            CALL InitInteger( lstfp, 2 * mstfp, 0 )
            CALL InitInteger( ldmpp, 2 * mdmpp, 0 )
          END SUBROUTINE InitCent

          SUBROUTINE DelCent
            IF( ALLOCATED( lmssp ) ) DEALLOCATE( lmssp )
            IF( ALLOCATED( vmssp ) ) DEALLOCATE( vmssp )
            IF( ALLOCATED( ldmpp ) ) DEALLOCATE( ldmpp )
            IF( ALLOCATED( vdmpp ) ) DEALLOCATE( vdmpp )
            IF( ALLOCATED( lstfp ) ) DEALLOCATE( lstfp )
            IF( ALLOCATED( vstfp ) ) DEALLOCATE( vstfp )
          END SUBROUTINE DelCent
        END MODULE CentData

        MODULE LoadData
        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        ALLOCATABLE loads(:,:)
        ALLOCATABLE lnodf(:,:), vnodf(:,:)
        ALLOCATABLE ledgf(:,:), vedgf(:,:)
        ALLOCATABLE lplnf(:,:), vplnf(:,:)
        SAVE loads, lnodf, vnodf, ledgf, vedgf, lplnf, vplnf

        CONTAINS
          SUBROUTINE InitLoad
            USE CtrlData
            IF( nerrc .GT. 0 ) RETURN
            ALLOCATE( lnodf(     2, mnodf ), vnodf( mdofn, mnodf ),            &
                      ledgf( mnodg, medgf ), vedgf( ndofg, medgf ),            &
                      lplnf( mnodp, mplnf ), vplnf( ndofp, mplnf ),            &
                      loads(     3, nload ), STAT = ierro )
            IF( ierro .GT. 0 ) nerrc = 3
            IF( nerrc .GT. 0 ) RETURN
            CALL InitFloat( vnodf, mdofn * mnodf, 0.0D0 )
            CALL InitFloat( vedgf, ndofg * medgf, 0.0D0 )
            CALL InitFloat( vplnf, ndofp * mplnf, 0.0D0 )
            CALL InitInteger( ledgf, mnodg * medgf, 0 )
            CALL InitInteger( lplnf, mnodp * mplnf, 0 )
            CALL InitInteger( lnodf, 2 * mnodf, 0 )
            CALL InitInteger( loads, 3 * nload, 0 )
          END SUBROUTINE InitLoad

          SUBROUTINE DelLoad
            IF( ALLOCATED( loads ) ) DEALLOCATE( loads )
            IF( ALLOCATED( lnodf ) ) DEALLOCATE( lnodf )
            IF( ALLOCATED( vnodf ) ) DEALLOCATE( vnodf )
            IF( ALLOCATED( ledgf ) ) DEALLOCATE( ledgf )
            IF( ALLOCATED( vedgf ) ) DEALLOCATE( vedgf )
            IF( ALLOCATED( lplnf ) ) DEALLOCATE( lplnf )
            IF( ALLOCATED( vplnf ) ) DEALLOCATE( vplnf )
          END SUBROUTINE DelLoad
        END MODULE LoadData

        MODULE ElmtData
!........
!       模块内容：
!           本模块包含程序运算过程中的所有单元传递参数，并负责对它们初始化。
!........
        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        ALLOCATABLE stife(:,:), lnode(:), accen(:)
        ALLOCATABLE coren(:,:), force(:), dispe(:), dspie(:)
        ALLOCATABLE histe(:)  , velen(:), dispt(:), tempe(:)
        ALLOCATABLE accet(:)  , velet(:), dishe(:), strhe(:)
        INTEGER ndofn, nnode, ndofe

        SAVE ndofn, nnode, ndofe, strhe, tempe, dspie
        SAVE dispe, histe, velen, dispt, accet, dishe
        SAVE stife, lnode, accen, coren, force, velet

        CONTAINS
          SUBROUTINE InitElmt
            USE CtrlData
            IF( nhstr .GT. 0 ) THEN
              ALLOCATE( histe( nhstr ), STAT = ierro )
              IF( ierro .GT. 0 ) nerrc = 4
              IF( nerrc .GT. 0 ) RETURN
              CALL InitFloat( histe, nhstr, 0.0D0 )
            END IF
            ALLOCATE( dispe( mdofe ), stife( mdofe, mdofe ),                   &
                      lnode( mnode ), coren( ndime, mnode ),                   &
                      force( mdofe ), velen( mdofe ),                          &
                      accen( mdofe ), dispt( mdofe ),                          &
                      accet( mdofe ), velet( mdofe ),                          &
                      dishe( mdofe ), tempe( mnode ),                          &
                      dspie( mdofe ), STAT = ierro )
            IF( ierro .GT. 0 ) nerrc = 4
            IF( nerrc .GT. 0 ) RETURN
            CALL InitInteger( lnode, mnode, 0 )
            CALL InitFloat( dishe, mdofe, 0.0D0 )
            CALL InitFloat( dispe, mdofe, 0.0D0 )
            CALL InitFloat( dspie, mdofe, 0.0D0 )
            CALL InitFloat( force, mdofe, 0.0D0 )
            CALL InitFloat( accen, mdofe, 0.0D0 )
            CALL InitFloat( velen, mdofe, 0.0D0 )
            CALL InitFloat( dispt, mdofe, 0.0D0 )
            CALL InitFloat( accet, mdofe, 0.0D0 )
            CALL InitFloat( velet, mdofe, 0.0D0 )
            CALL InitFloat( tempe, mnode, 0.0D0 )
            CALL InitFloat( stife, mdofe * mdofe, 0.0D0 )
            CALL InitFloat( coren, ndime * mnode, 0.0D0 )
            IF( nstrh .NE. 0 ) THEN
              ALLOCATE( strhe( nstrh ), STAT = ierro )
              IF( ierro .NE. 0 ) nerrc = 4
              IF( nerrc .NE. 0 ) RETURN
              CALL InitFloat( strhe, nstrh, 0.0D0 )
            END IF
          END SUBROUTINE InitElmt

          SUBROUTINE DelElmt
            USE CtrlData
            IF( ALLOCATED( dspie ) ) DEALLOCATE( dspie )
            IF( ALLOCATED( dispe ) ) DEALLOCATE( dispe )
            IF( ALLOCATED( stife ) ) DEALLOCATE( stife )
            IF( ALLOCATED( lnode ) ) DEALLOCATE( lnode )
            IF( ALLOCATED( coren ) ) DEALLOCATE( coren )
            IF( ALLOCATED( force ) ) DEALLOCATE( force )
            IF( ALLOCATED( velen ) ) DEALLOCATE( velen )
            IF( ALLOCATED( accen ) ) DEALLOCATE( accen )
            IF( ALLOCATED( dispt ) ) DEALLOCATE( dispt )
            IF( ALLOCATED( accet ) ) DEALLOCATE( accet )
            IF( ALLOCATED( velet ) ) DEALLOCATE( velet )
            IF( ALLOCATED( dishe ) ) DEALLOCATE( dishe )
            IF( ALLOCATED( histe ) ) DEALLOCATE( histe )
            IF( ALLOCATED( strhe ) ) DEALLOCATE( strhe )
            IF( ALLOCATED( tempe ) ) DEALLOCATE( tempe )
          END SUBROUTINE DelElmt
        END MODULE ElmtData

        MODULE GlobData
!........
!       模块内容：
!           本模块包含程序运算过程中的所有过程参数，并负责对它们初始化。
!........
        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        ALLOCATABLE disph(:,:), dspis(:,:)
        ALLOCATABLE histr(:,:), strsh(:,:)
        ALLOCATABLE llmts(:,:), vlmts(:,:), lstat(:)
        ALLOCATABLE accel(:,:), acctm(:,:), ldofs(:), luses(:)
        ALLOCATABLE disps(:,:), distm(:,:), aitkn(:), lsmts(:)
        ALLOCATABLE veloc(:,:), veltm(:,:), freqs(:), wsmts(:)
        ALLOCATABLE strss(:,:), shmod(:,:), react(:), vsmts(:)
        ALLOCATABLE strns(:,:)

        SAVE histr, strss, shmod, react, lsmts, strsh
        SAVE llmts, vlmts, lstat, accel, acctm, ldofs, strns
        SAVE disps, distm, aitkn, veloc, veltm, freqs, dspis

        CONTAINS
          SUBROUTINE InitGlob
          USE CtrlData
          IF( nerrc .GT. 0 ) RETURN
!.........
          IF( nhstr .GT. 0 ) THEN
            ALLOCATE( histr( nhstr, nelem ), STAT = ierro )
            IF( ierro .GT. 0 ) nerrc = 4
            IF( nerrc .GT. 0 ) RETURN
            CALL InitFloat( histr, nhstr * nelem, 0.0D0 )
          END IF
          IF( nstrh .GT. 0 ) THEN
            ALLOCATE( strsh( nstrh, nelem ), STAT = ierro )
            IF( ierro .NE. 0 ) nerrc = 4
            IF( nerrc .GT. 0 ) RETURN
            CALL InitFloat( strsh, nstrh * nelem, 0.0D0 )
          END IF
          ALLOCATE( vsmts( ndofs ), llmts(     2, mdofn ),                     &
                    lstat( nelem ), vlmts(     2, mdofn ),                     &
                    lsmts( mdofn ), strss(     7, npoin ),                     &
                    wsmts( npoin ), strns(     7, npoin ),                     &
                    aitkn( ndofs ), disph( ndofs, nload ),                     &
                    react( ndofs ), disps( ndofs, nload ),                     &
                    ldofs( npoin ), distm( ndofs, nload ),                     &
                    luses( nelem ), dspis( ndofs, nload ),                     &
                    STAT = ierro )
          IF( ierro .GT. 0 ) nerrc = 4
          IF( nerrc .GT. 0 ) RETURN

          CALL InitInteger( luses, nelem, 1 )
          CALL InitInteger( lstat, mdofn, 0 )
          CALL InitInteger( ldofs, npoin, 0 )
          CALL InitInteger( lstat, nelem, 0 )
          CALL InitInteger( llmts, mdofn * 2, 0 )