⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gauss.f90

📁 边界元程序,供力学工作者参考,希望对大家有所帮助
💻 F90
字号:
        SUBROUTINE Gauss( pgaus, wgaus, ngaus, nerrc )
!.....
!       P R O G R A M
!             To set gauss point positions and weight.
!.....
        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        DIMENSION pgaus( ngaus ), wgaus( ngaus )
        IF( ngaus .EQ. 1 ) THEN
         pgaus( 1 ) =  0.000000000000000d0
         wgaus( 1 ) =  2.000000000000000d0
        ELSE IF( ngaus .EQ. 2 ) THEN
         pgaus( 1 ) = -0.577350269189626d0
         pgaus( 2 ) =  0.577350269189626d0
         wgaus( 1 ) =  1.000000000000000d0
         wgaus( 2 ) =  1.000000000000000d0
        ELSE IF( ngaus .EQ. 3 ) THEN
         pgaus( 1 ) = -0.774596669241483d0
         pgaus( 2 ) =  0.000000000000000d0
         pgaus( 3 ) =  0.774596669241483d0
         wgaus( 1 ) =  0.555555555555556d0
         wgaus( 2 ) =  0.888888888888889d0
         wgaus( 3 ) =  0.555555555555556d0
        ELSE IF( ngaus .EQ. 4 ) THEN
         pgaus( 1 ) = -0.861136311594053d0
         pgaus( 2 ) = -0.339981043584856d0
         pgaus( 3 ) =  0.339981043584856d0
         pgaus( 4 ) =  0.861136311594053d0
         wgaus( 1 ) =  0.347854845137454d0
         wgaus( 2 ) =  0.652145154862546d0
         wgaus( 3 ) =  0.652145154862546d0
         wgaus( 4 ) =  0.347854845137454d0
        ELSE IF( ngaus .EQ. 5 ) THEN
         pgaus( 1 ) = -0.906179845938664d0
         pgaus( 2 ) = -0.538469310105683d0
         pgaus( 3 ) =  0.000000000000000d0
         pgaus( 4 ) =  0.538469310105683d0
         pgaus( 5 ) =  0.906179845938664d0
         wgaus( 1 ) =  0.236926885056189d0
         wgaus( 2 ) =  0.478628670499366d0
         wgaus( 3 ) =  0.568888888888889d0
         wgaus( 4 ) =  0.478628670499366d0
         wgaus( 5 ) =  0.236926885056189d0
        ELSE IF( ngaus .EQ. 6 ) THEN
         pgaus( 1 ) = -0.932469514203152d0
         pgaus( 2 ) = -0.661209386466265d0
         pgaus( 3 ) = -0.238619186083197d0
         pgaus( 4 ) =  0.238619186083197d0
         pgaus( 5 ) =  0.661209386466265d0
         pgaus( 6 ) =  0.932469514203152d0
         wgaus( 1 ) =  0.171324492379170d0
         wgaus( 2 ) =  0.360761573048139d0
         wgaus( 3 ) =  0.467913934572691d0
         wgaus( 4 ) =  0.467913934572691d0
         wgaus( 5 ) =  0.360761573048139d0
         wgaus( 6 ) =  0.171324492379170d0
        ELSE
         nerrc = 4001
        END IF
        RETURN
        END

        SUBROUTINE Labatto( plaba, wlaba, nlaba, nerrc )
!.....
!       P R O G R A M
!             To set gauss point positions and weight.
!.....
        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        DIMENSION plaba( nlaba ), wlaba( nlaba )
        IF( nlaba .EQ. 3 ) THEN
          plaba( 1 ) = -1.00000000D0
          plaba( 2 ) =  0.00000000D0
          plaba( 3 ) =  1.00000000D0
          wlaba( 1 ) =  0.33333333D0
          wlaba( 2 ) =  1.33333333D0
          wlaba( 3 ) =  0.33333333D0
        ELSE IF( nlaba .EQ. 4 ) THEN
          plaba( 1 ) = -1.00000000D0
          plaba( 2 ) = -0.44721360D0
          plaba( 3 ) =  0.44721360D0
          plaba( 4 ) =  1.00000000D0
          wlaba( 1 ) =  0.16666667D0
          wlaba( 2 ) =  0.83333333D0
          wlaba( 3 ) =  0.83333333D0
          wlaba( 4 ) =  0.16666667D0
        ELSE IF( nlaba .EQ. 5 ) THEN
          plaba( 1 ) = -1.00000000D0
          plaba( 2 ) = -0.65465367D0
          plaba( 3 ) =  0.00000000D0
          plaba( 4 ) =  0.65465367D0
          plaba( 5 ) =  1.00000000D0
          wlaba( 1 ) =  0.10000000D0
          wlaba( 2 ) =  0.54444444D0
          wlaba( 3 ) =  0.71111111D0
          wlaba( 4 ) =  0.54444444D0
          wlaba( 5 ) =  0.10000000D0
        ELSE IF( nlaba .EQ. 6 ) THEN
          plaba( 1 ) = -1.00000000D0
          plaba( 2 ) = -0.76505532D0
          plaba( 3 ) = -0.28523152D0
          plaba( 4 ) =  0.28523152D0
          plaba( 5 ) =  0.76505532D0
          plaba( 6 ) =  1.00000000D0
          wlaba( 1 ) =  0.06666667D0
          wlaba( 2 ) =  0.37847496D0
          wlaba( 3 ) =  0.55485838D0
          wlaba( 4 ) =  0.55485838D0
          wlaba( 5 ) =  0.37847496D0
          wlaba( 6 ) =  0.06666667D0
        ELSE IF( nlaba .EQ. 7 ) THEN
          plaba( 1 ) = -1.00000000D0
          plaba( 2 ) = -0.83022390D0
          plaba( 3 ) = -0.46884879D0
          plaba( 4 ) =  0.00000000D0
          plaba( 5 ) =  0.46884879D0
          plaba( 6 ) =  0.83022390D0
          plaba( 7 ) =  1.00000000D0
          wlaba( 1 ) =  0.04761904D0
          wlaba( 2 ) =  0.27682604D0
          wlaba( 3 ) =  0.43174538D0
          wlaba( 4 ) =  0.48761904D0
          wlaba( 5 ) =  0.43174538D0
          wlaba( 6 ) =  0.27682604D0
          wlaba( 7 ) =  0.04761904D0
        ELSE IF( nlaba .EQ. 8 ) THEN
          plaba( 1 ) = -1.00000000D0
          plaba( 2 ) = -0.87174015D0
          plaba( 3 ) = -0.59170018D0
          plaba( 4 ) = -0.20929922D0
          plaba( 5 ) =  0.20929922D0
          plaba( 6 ) =  0.59170018D0
          plaba( 7 ) =  0.87174015D0
          plaba( 8 ) =  1.00000000D0
          wlaba( 1 ) =  0.03571428D0
          wlaba( 2 ) =  0.21070422D0
          wlaba( 3 ) =  0.34112270D0
          wlaba( 4 ) =  0.41245880D0
          wlaba( 5 ) =  0.41245880D0
          wlaba( 6 ) =  0.34112270D0
          wlaba( 7 ) =  0.21070422D0
          wlaba( 8 ) =  0.03571428D0
        ELSE
          nerrc = 21454
        END IF
        RETURN
        END

        SUBROUTINE Hammer2D( phamm, whamm, nhamm, norde, nerrc )
        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        DIMENSION phamm( 3, 7 ), whamm( 7 )
        IF( norde .EQ. 1 ) THEN
          nhamm = 1
          whamm(    1 ) = 1.0000000000D0
          phamm( 1, 1 ) = 0.3333333333D0
          phamm( 2, 1 ) = 0.3333333333D0
          phamm( 3, 1 ) = 0.3333333333D0
        ELSE IF( norde .EQ. 2 ) THEN
          nhamm = 3
          whamm(    1 ) = 0.3333333333D0
          phamm( 1, 1 ) = 0.5000000000D0
          phamm( 2, 1 ) = 0.5000000000D0
          phamm( 3, 1 ) = 0.0000000000D0
          whamm(    2 ) = 0.3333333333D0
          phamm( 1, 2 ) = 0.0000000000D0
          phamm( 2, 2 ) = 0.5000000000D0
          phamm( 3, 2 ) = 0.5000000000D0
          whamm(    3 ) = 0.3333333333D0
          phamm( 1, 3 ) = 0.5000000000D0
          phamm( 2, 3 ) = 0.0000000000D0
          phamm( 3, 3 ) = 0.5000000000D0
        ELSE IF( norde .EQ. 3 ) THEN
          nhamm = 4
          whamm(    1 ) =-0.5625000000D0
          phamm( 1, 1 ) = 0.3333333333D0
          phamm( 2, 1 ) = 0.3333333333D0
          phamm( 3, 1 ) = 0.3333333333D0
          whamm(    2 ) = 0.5208333333D0
          phamm( 1, 2 ) = 0.6000000000D0
          phamm( 2, 2 ) = 0.2000000000D0
          phamm( 3, 2 ) = 0.2000000000D0
          whamm(    3 ) = 0.5208333333D0
          phamm( 1, 3 ) = 0.2000000000D0
          phamm( 2, 3 ) = 0.6000000000D0
          phamm( 3, 3 ) = 0.2000000000D0
          whamm(    4 ) = 0.5208333333D0
          phamm( 1, 4 ) = 0.2000000000D0
          phamm( 2, 4 ) = 0.2000000000D0
          phamm( 3, 4 ) = 0.6000000000D0
        ELSE IF( norde .EQ. 4 ) THEN
          nhamm = 7
          whamm(    1 ) = 0.2250000000D0
          phamm( 1, 1 ) = 0.3333333333D0
          phamm( 2, 1 ) = 0.3333333333D0
          phamm( 3, 1 ) = 0.3333333333D0
          whamm(    2 ) = 0.1323941527D0
          phamm( 1, 2 ) = 0.0597158717D0
          phamm( 2, 2 ) = 0.4701420641D0
          phamm( 3, 2 ) = 0.4701420641D0
          whamm(    3 ) = 0.1323941527D0
          phamm( 1, 3 ) = 0.4701420641D0
          phamm( 2, 3 ) = 0.0597158717D0
          phamm( 3, 3 ) = 0.4701420641D0
          whamm(    4 ) = 0.1323941527D0
          phamm( 1, 4 ) = 0.4701420641D0
          phamm( 2, 4 ) = 0.4701420641D0
          phamm( 3, 4 ) = 0.0597158717D0
          whamm(    5 ) = 0.1259391806D0
          phamm( 1, 5 ) = 0.7974269853D0
          phamm( 2, 5 ) = 0.1012865073D0
          phamm( 3, 5 ) = 0.1012865073D0
          whamm(    6 ) = 0.1259391806D0
          phamm( 1, 6 ) = 0.1012865073D0
          phamm( 2, 6 ) = 0.7974269853D0
          phamm( 3, 6 ) = 0.1012865073D0
          whamm(    7 ) = 0.1259391806D0
          phamm( 1, 7 ) = 0.1012865073D0
          phamm( 2, 7 ) = 0.1012865073D0
          phamm( 3, 7 ) = 0.7974269853D0
        ELSE
          nerrc = 21454
        END IF
        DO ihamm = 1, nhamm
          whamm( ihamm ) = whamm( ihamm ) / 2.0D0
        END DO
        RETURN
        END

        SUBROUTINE Hammer3D( phamm, whamm, nhamm, norde, nerrc )
        IMPLICIT DOUBLE PRECISION( a-h, o-z )
        DIMENSION phamm( 4, 7 ), whamm( 7 )
        IF( norde .EQ. 1 ) THEN
          nhamm = 1
          whamm(    1 ) = 1.0000000000D0
          phamm( 1, 1 ) = 0.2500000000D0
          phamm( 2, 1 ) = 0.2500000000D0
          phamm( 3, 1 ) = 0.2500000000D0
          phamm( 4, 1 ) = 0.2500000000D0
        ELSE IF( norde .EQ. 2 ) THEN
          nhamm = 4
          whamm(    1 ) = 0.2500000000D0
          phamm( 1, 1 ) = 0.5854120200D0
          phamm( 2, 1 ) = 0.1381966000D0
          phamm( 3, 1 ) = 0.1381966000D0
          phamm( 4, 1 ) = 0.1381966000D0
          whamm(    2 ) = 0.2500000000D0
          phamm( 1, 2 ) = 0.1381966000D0
          phamm( 2, 2 ) = 0.5854120200D0
          phamm( 3, 2 ) = 0.1381966000D0
          phamm( 4, 2 ) = 0.1381966000D0
          whamm(    3 ) = 0.2500000000D0
          phamm( 1, 3 ) = 0.1381966000D0
          phamm( 2, 3 ) = 0.1381966000D0
          phamm( 3, 3 ) = 0.5854120200D0
          phamm( 4, 3 ) = 0.1381966000D0
          whamm(    4 ) = 0.2500000000D0
          phamm( 1, 4 ) = 0.1381966000D0
          phamm( 2, 4 ) = 0.1381966000D0
          phamm( 3, 4 ) = 0.1381966000D0
          phamm( 4, 4 ) = 0.5854120200D0
        ELSE IF( norde .EQ. 3 ) THEN
          nhamm = 5
          whamm(    1 ) =-0.8000000000D0
          phamm( 1, 1 ) = 0.2500000000D0
          phamm( 2, 1 ) = 0.2500000000D0
          phamm( 3, 1 ) = 0.2500000000D0
          phamm( 4, 1 ) = 0.2500000000D0
          whamm(    2 ) = 0.4500000000D0
          phamm( 1, 2 ) = 0.3333333333D0
          phamm( 2, 2 ) = 0.1666666667D0
          phamm( 3, 2 ) = 0.1666666667D0
          phamm( 4, 2 ) = 0.1666666667D0
          whamm(    3 ) = 0.4500000000D0
          phamm( 1, 3 ) = 0.1666666667D0
          phamm( 2, 3 ) = 0.3333333333D0
          phamm( 3, 3 ) = 0.1666666667D0
          phamm( 4, 3 ) = 0.1666666667D0
          whamm(    4 ) = 0.4500000000D0
          phamm( 1, 4 ) = 0.1666666667D0
          phamm( 2, 4 ) = 0.1666666667D0
          phamm( 3, 4 ) = 0.3333333333D0
          phamm( 4, 4 ) = 0.1666666667D0
          whamm(    4 ) = 0.4500000000D0
          phamm( 1, 4 ) = 0.1666666667D0
          phamm( 2, 4 ) = 0.1666666667D0
          phamm( 3, 4 ) = 0.1666666667D0
          phamm( 4, 4 ) = 0.3333333333D0
        ELSE
          nerrc = 21454
        END IF
        DO ihamm = 1, nhamm
          whamm( ihamm ) = whamm( ihamm ) / 6.0D0
        END DO
        RETURN
        END

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -