mt08pp.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt08pp.f
00002 !
00071                      SUBROUTINE MT08PP
00072 !                    *****************
00073 !
00074      &( T,XM,XMUL,SF,F,SURFAC,IKLE,NELEM,NELMAX)
00075 !
00076 !***********************************************************************
00077 ! BIEF   V6P1                                   21/08/2010
00078 !***********************************************************************
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| F              |-->| FUNCTION USED IN THE FORMULA
00087 !| FORMUL         |-->| FORMULA DESCRIBING THE RESULTING MATRIX
00088 !| IKLE           |-->| CONNECTIVITY TABLE.
00089 !| NELEM          |-->| NUMBER OF ELEMENTS
00090 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00091 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00092 !| SURFAC         |-->| AREA OF 2D ELEMENTS
00093 !| T              |<->| WORK ARRAY FOR ELEMENT BY ELEMENT DIAGONAL
00094 !| Z              |-->| ELEVATIONS OF POINTS
00095 !| XM             |<->| OFF-DIAGONAL TERMS
00096 !| XMUL           |-->| COEFFICIENT FOR MULTIPLICATION
00097 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00098 !
00099       USE BIEF, EX_MT08PP => MT08PP
00100 !
00101       IMPLICIT NONE
00102       INTEGER LNG,LU
00103       COMMON/INFO/LNG,LU
00104 !
00105 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00106 !
00107       INTEGER, INTENT(IN) :: NELEM,NELMAX
00108       INTEGER, INTENT(IN) :: IKLE(NELMAX,6)
00109 !
00110       DOUBLE PRECISION, INTENT(INOUT) :: T(NELMAX,6),XM(NELMAX,30)
00111 !
00112       DOUBLE PRECISION, INTENT(IN) :: XMUL
00113       DOUBLE PRECISION, INTENT(IN) :: F(*)
00114 !
00115 !     STRUCTURE OF F
00116 !
00117       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00118 !
00119       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00120 !
00121 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00122 !
00123 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00124 !
00125       DOUBLE PRECISION PZ1,XSU360
00126       DOUBLE PRECISION Q1,Q2,Q3,Q4,Q5,Q6
00127       DOUBLE PRECISION W14,W41,W25,W52,W63,W36
00128 !
00129       INTEGER I1,I2,I3,I4,I5,I6,IELEM
00130 !
00131 !**********************************************************************
00132 !
00133       XSU360 = XMUL/360.D0
00134 !
00135       IF(SF%ELM.NE.41) THEN
00136         IF (LNG.EQ.1) WRITE(LU,1000) SF%ELM
00137         IF (LNG.EQ.2) WRITE(LU,1001) SF%ELM
00138 1000    FORMAT(1X,'MT08PP (BIEF) : TYPE DE F NON PREVU : ',I6)
00139 1001    FORMAT(1X,'MT08PP (BIEF) : TYPE OF F NOT IMPLEMENTED: ',I6)
00140         CALL PLANTE(1)
00141         STOP
00142       ENDIF
00143 !
00144 !     LOOP ON THE ELEMENTS
00145 !
00146       DO IELEM=1,NELEM
00147 !
00148         I1 = IKLE(IELEM,1)
00149         I2 = IKLE(IELEM,2)
00150         I3 = IKLE(IELEM,3)
00151         I4 = IKLE(IELEM,4)
00152         I5 = IKLE(IELEM,5)
00153         I6 = IKLE(IELEM,6)
00154 !
00155         Q1  =  F(I1)
00156         Q2  =  F(I2)
00157         Q3  =  F(I3)
00158         Q4  =  F(I4)
00159         Q5  =  F(I5)
00160         Q6  =  F(I6)
00161 !
00162 !       INTERMEDIATE COMPUTATIONS
00163 !
00164         PZ1=-XSU360*SURFAC(IELEM)
00165 !
00166         W14 = Q1+2*Q4
00167         W41 = Q4+2*Q1
00168         W25 = Q2+2*Q5
00169         W52 = Q5+2*Q2
00170         W63 = Q6+2*Q3
00171         W36 = Q3+2*Q6
00172 !
00173         T(IELEM,1)=PZ1*2*(3*W41+W52+W63)
00174         XM(IELEM,18)=-T(IELEM,1)
00175         XM(IELEM,16)=PZ1*(2*(W41+W52)+W63)
00176         XM(IELEM,19)=-XM(IELEM,16)
00177         XM(IELEM,1) = XM(IELEM,16)
00178         XM(IELEM,22)=-XM(IELEM,16)
00179         XM(IELEM,2)=PZ1*(2*(W41+W63)+W52)
00180         XM(IELEM,20)=-XM(IELEM,2)
00181         XM(IELEM,17)= XM(IELEM,2)
00182         XM(IELEM,25)=-XM(IELEM,2)
00183         T(IELEM,2)=PZ1*2*(W41+3*W52+W63)
00184         XM(IELEM,23)= -T(IELEM,2)
00185         XM(IELEM,21)=PZ1*(2*(W52+W63)+W41)
00186         XM(IELEM,24)=-XM(IELEM,21)
00187         XM(IELEM,6) = XM(IELEM,21)
00188         XM(IELEM,26)=-XM(IELEM,21)
00189         T(IELEM,3)=PZ1*2*(W41+W52+3*W63)
00190         XM(IELEM,27)=-T(IELEM,3)
00191         XM(IELEM,3)=PZ1*2*(3*W14+W25+W36)
00192         T(IELEM,4)=-XM(IELEM,3)
00193         XM(IELEM,7)=PZ1*(2*(W14+W25)+W36)
00194         XM(IELEM,28)=-XM(IELEM,7)
00195         XM(IELEM,4) = XM(IELEM,7)
00196         XM(IELEM,13)=-XM(IELEM,7)
00197         XM(IELEM,10)=PZ1*(2*(W14+W36)+W25)
00198         XM(IELEM,29)=-XM(IELEM,10)
00199         XM(IELEM,5) = XM(IELEM,10)
00200         XM(IELEM,14)=-XM(IELEM,10)
00201         XM(IELEM,8)=PZ1*2*(W14+3*W25+W36)
00202         T(IELEM,5)=-XM(IELEM,8)
00203         XM(IELEM,11)=PZ1*(2*(W25+W36)+W14)
00204         XM(IELEM,30)=-XM(IELEM,11)
00205         XM(IELEM,9) = XM(IELEM,11)
00206         XM(IELEM,15)=-XM(IELEM,11)
00207         XM(IELEM,12)=PZ1*2*(W14+W25+3*W36)
00208         T(IELEM,6)=-XM(IELEM,12)
00209 !
00210       ENDDO
00211 !
00212 !-----------------------------------------------------------------------
00213 !
00214       RETURN
00215       END

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