mt07bb.f

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

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