mt07aa.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt07aa.f
00002 !
00071                      SUBROUTINE MT07AA
00072 !                    *****************
00073 !
00074      &( A11 , A12 , A13 ,
00075      &        A22 , A23 ,
00076      &              A33 ,
00077      &  XMUL,SF,F,SURFAC,NELEM,NELMAX)
00078 !
00079 !***********************************************************************
00080 ! BIEF   V6P1                                   21/08/2010
00081 !***********************************************************************
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00089 !| A11            |<--| ELEMENTS OF MATRIX
00090 !| A12            |<--| ELEMENTS OF MATRIX
00091 !| A13            |<--| ELEMENTS OF MATRIX
00092 !| A22            |<--| ELEMENTS OF MATRIX
00093 !| A23            |<--| ELEMENTS OF MATRIX
00094 !| A33            |<--| ELEMENTS OF MATRIX
00095 !| F              |-->| FUNCTION USED IN THE FORMULA
00096 !| NELEM          |-->| NUMBER OF ELEMENTS
00097 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00098 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00099 !| SURFAC         |-->| AREA OF TRIANGLES
00100 !| XMUL           |-->| MULTIPLICATION FACTOR
00101 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00102 !
00103       USE BIEF, EX_MT07AA => MT07AA
00104 !
00105       IMPLICIT NONE
00106       INTEGER LNG,LU
00107       COMMON/INFO/LNG,LU
00108 !
00109 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00110 !
00111       INTEGER, INTENT(IN) :: NELEM,NELMAX
00112 !
00113       DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
00114       DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*)
00115       DOUBLE PRECISION, INTENT(INOUT) ::               A33(*)
00116 !
00117       DOUBLE PRECISION, INTENT(IN) :: XMUL
00118       DOUBLE PRECISION, INTENT(IN) :: F(*)
00119 !
00120 !     STRUCTURE OF F
00121       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00122 !
00123       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00124 !
00125 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00126 !
00127 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00128 !
00129       INTEGER IELMF,IELEM
00130 !
00131       DOUBLE PRECISION SUR12,DET,T
00132 !
00133 !-----------------------------------------------------------------------
00134 !
00135       SUR12 = XMUL/12.D0
00136 !
00137 !-----------------------------------------------------------------------
00138 !
00139       IELMF = SF%ELM
00140 !
00141 !  CASE WHERE F IS CONSTANT BY ELEMENT
00142 !
00143       IF(IELMF.EQ.10) THEN
00144 !
00145       DO IELEM = 1 , NELEM
00146 !
00147       DET = SURFAC(IELEM) * SUR12
00148       T   = F(IELEM)
00149 !
00150 !***********************************************************************
00151 !
00152 !  ELEMENTS OFF THE DIAGONAL
00153 !
00154       A12(IELEM) = T * DET
00155       A13(IELEM) = T * DET
00156       A23(IELEM) = T * DET
00157 !
00158 !  DIAGONAL TERMS
00159 !
00160       A11(IELEM) = ( DET + DET ) * (2.D0 - T)
00161       A22(IELEM) = ( DET + DET ) * (2.D0 - T)
00162       A33(IELEM) = ( DET + DET ) * (2.D0 - T)
00163 !
00164 !   END OF THE LOOP ON THE ELEMENTS
00165 !
00166       ENDDO ! IELEM
00167 !
00168 !-----------------------------------------------------------------------
00169 !
00170 !     OTHER TYPES OF DISCRETISATION OF F
00171 !
00172       ELSE
00173 !
00174         IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00175         IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00176 100     FORMAT(1X,'MT07AA (BIEF) :',/,
00177      &         1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00178      &         1X,'NOM REEL : ',A6)
00179 101     FORMAT(1X,'MT07AA (BIEF) :',/,
00180      &         1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00181      &         1X,'REAL NAME: ',A6)
00182         CALL PLANTE(0)
00183         STOP
00184 !
00185       ENDIF
00186 !
00187 !-----------------------------------------------------------------------
00188 !
00189       RETURN
00190       END

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