mt07cc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt07cc.f
00002 !
00066                      SUBROUTINE MT07CC
00067 !                    *****************
00068 !
00069      &( A11 , A12 , A13 , A14 , A15 , A16 ,
00070      &        A22 , A23 , A24 , A25 , A26 ,
00071      &              A33 , A34 , A35 , A36 ,
00072      &                    A44 , A45 , A46 ,
00073      &                          A55 , A56 ,
00074      &                                A66 ,
00075      &  XMUL,SF,F,SURFAC,NELEM,NELMAX)
00076 !
00077 !***********************************************************************
00078 ! BIEF   V6P1                                   21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| A11            |<--| ELEMENTS OF MATRIX
00088 !| ...            |<--| ELEMENTS OF MATRIX
00089 !| A66            |<--| ELEMENTS OF MATRIX
00090 !| F              |-->| FUNCTION USED IN THE FORMULA
00091 !| NELEM          |-->| NUMBER OF ELEMENTS
00092 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00093 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00094 !| SURFAC         |-->| AREA OF TRIANGLES
00095 !| XMUL           |-->| MULTIPLICATION FACTOR
00096 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00097 !
00098       USE BIEF!, EX_MT07CC => MT07CC
00099 !
00100       IMPLICIT NONE
00101       INTEGER LNG,LU
00102       COMMON/INFO/LNG,LU
00103 !
00104 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00105 !
00106       INTEGER, INTENT(IN) :: NELEM,NELMAX
00107 !
00108       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00109       DOUBLE PRECISION, INTENT(INOUT) :: A14(*),A15(*),A16(*)
00110       DOUBLE PRECISION, INTENT(INOUT) :: A22(*),A23(*),A24(*)
00111       DOUBLE PRECISION, INTENT(INOUT) :: A25(*),A26(*),A33(*)
00112       DOUBLE PRECISION, INTENT(INOUT) :: A34(*),A35(*),A36(*)
00113       DOUBLE PRECISION, INTENT(INOUT) :: A44(*),A45(*),A46(*)
00114       DOUBLE PRECISION, INTENT(INOUT) :: A55(*),A56(*),A66(*)
00115 !
00116       DOUBLE PRECISION, INTENT(IN) :: XMUL
00117       DOUBLE PRECISION, INTENT(IN) :: F(*)
00118 !
00119 !     STRUCTURE OF F
00120       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00121 !
00122       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00123 !
00124 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00125 !
00126 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00127 !
00128       DOUBLE PRECISION T,XSUR30,XSUR45,XSUR180
00129       INTEGER IELEM
00130 !
00131 !=======================================================================
00132 !
00133       XSUR30 = XMUL/30.D0
00134       XSUR45 = XMUL/45.D0
00135       XSUR180 = XMUL/180.D0
00136 !
00137 !-----------------------------------------------------------------------
00138 !
00139       IF(SF%ELM.EQ.10) THEN
00140 !
00141 !-----------------------------------------------------------------------
00142 !
00143 !   P0 DISCRETISATION OF F:
00144 !
00145       DO IELEM = 1 , NELEM
00146 !
00147 !   INITIALISES THE INTERMEDIATE VARIABLES
00148 !
00149         T = F(IELEM)
00150 !
00151 !  DIAGONAL TERMS
00152 !
00153 !  FOR P2 ELEMENTS, DM(1) = DM(2) = DM(3) = 0
00154 !               AND DM(4) = DM(5) = DM(6) = S/3
00155         A11(IELEM) = T*SURFAC(IELEM)*XSUR30
00156         A22(IELEM) = A11(IELEM)
00157         A33(IELEM) = A11(IELEM)
00158         A44(IELEM) = (15.D0-7.D0*T)*SURFAC(IELEM)*XSUR45
00159         A55(IELEM) = A44(IELEM)
00160         A66(IELEM) = A44(IELEM)
00161 !
00162 !  EXTRADIAGONAL TERMS
00163 !
00164         A12(IELEM) = -SURFAC(IELEM)*T*XSUR180
00165         A13(IELEM) = A12(IELEM)
00166         A14(IELEM) = 0.D0
00167         A15(IELEM) = -SURFAC(IELEM)*T*XSUR45
00168         A16(IELEM) = 0.D0
00169         A23(IELEM) = A12(IELEM)
00170         A24(IELEM) = 0.D0
00171         A25(IELEM) = 0.D0
00172         A26(IELEM) = A15(IELEM)
00173         A34(IELEM) = A15(IELEM)
00174         A35(IELEM) = 0.D0
00175         A36(IELEM) = 0.D0
00176         A45(IELEM) = (15.D0-11.D0*T)*SURFAC(IELEM)*XSUR45
00177         A46(IELEM) = A45(IELEM)
00178         A56(IELEM) = A45(IELEM)
00179 !
00180       ENDDO ! IELEM
00181 !
00182 !-----------------------------------------------------------------------
00183 !
00184 !  ANOTHER DISCRETISATION OF F
00185 !      ELSEIF(SF%ELM.EQ.XX) THEN
00186 !
00187 !-----------------------------------------------------------------------
00188 !
00189       ELSE
00190 !
00191         IF (LNG.EQ.1) WRITE(LU,100) SF%ELM,SF%NAME
00192         IF (LNG.EQ.2) WRITE(LU,101) SF%ELM,SF%NAME
00193 100     FORMAT(1X,'MT07CC (BIEF) :',/,
00194      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00195      &         1X,'NOM REEL : ',A6)
00196 101     FORMAT(1X,'MT07CC (BIEF) :',/,
00197      &         1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00198      &         1X,'REAL NAME: ',A6)
00199         CALL PLANTE(1)
00200         STOP
00201 !
00202       ENDIF
00203 !
00204 !-----------------------------------------------------------------------
00205 !
00206       RETURN
00207       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0