diag_murd.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\diag_murd.f
00002 !
00061                      SUBROUTINE DIAG_MURD
00062 !                    ********************
00063 !
00064      &(DIAG,XM,NELEM,NELMAX,NPOIN3,IKLE,IELM3,DIM1X)
00065 !
00066 !***********************************************************************
00067 ! TELEMAC3D   V6P2                                   21/08/2010
00068 !***********************************************************************
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00077 !| DIAG           |<->| DIAGONAL OF THE MURD MATRIX
00078 !| DIM1X          |-->| FIRST DIMENSION OF XM
00079 !| IELM3          |-->| TYPE OF ELEMENT
00080 !| IKLE           |-->| CONNECTIVITY TABLE
00081 !| NELEM          |-->| NUMBER OF ELEMENTS
00082 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00083 !| NPOIN3         |-->| NUMBER OF 3D POINTS
00084 !| XM             |-->| OFF-DIAGONAL TERMS
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !
00087       USE BIEF
00088 !
00089       IMPLICIT NONE
00090       INTEGER LNG,LU
00091       COMMON/INFO/LNG,LU
00092 !
00093 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00094 !
00095       INTEGER, INTENT(IN) :: NELEM,NELMAX,NPOIN3,IELM3,DIM1X
00096 !                                        6 OR 4
00097       INTEGER, INTENT(IN) :: IKLE(NELMAX,*)
00098 !
00099       DOUBLE PRECISION, INTENT(INOUT) :: DIAG(NPOIN3)
00100       DOUBLE PRECISION, INTENT(IN)    :: XM(DIM1X,NELMAX)
00101 !
00102 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00103 !
00104       INTEGER IELEM,I1,I2,I3,I4,I5,I6
00105 !
00106 !-----------------------------------------------------------------------
00107 !
00108 !     INITIALISES DIAG
00109 !
00110       DO I1=1,NPOIN3
00111         DIAG(I1)=0.D0
00112       ENDDO
00113 !
00114 !     COMPUTES THE SUM OF EACH LINE (WITH A - SIGN)
00115 !     THE DIAGONAL TERMS ARE 0
00116 !
00117       IF(IELM3.EQ.41) THEN
00118 !
00119         DO IELEM = 1,NELEM
00120           I1=IKLE(IELEM,1)
00121           I2=IKLE(IELEM,2)
00122           I3=IKLE(IELEM,3)
00123           I4=IKLE(IELEM,4)
00124           I5=IKLE(IELEM,5)
00125           I6=IKLE(IELEM,6)
00126           DIAG(I1)=DIAG(I1)-XM(01,IELEM)-XM(02,IELEM)
00127      &                     -XM(03,IELEM)-XM(04,IELEM)-XM(05,IELEM)
00128           DIAG(I2)=DIAG(I2)-XM(16,IELEM)-XM(06,IELEM)
00129      &                     -XM(07,IELEM)-XM(08,IELEM)-XM(09,IELEM)
00130           DIAG(I3)=DIAG(I3)-XM(17,IELEM)-XM(21,IELEM)
00131      &                     -XM(10,IELEM)-XM(11,IELEM)-XM(12,IELEM)
00132           DIAG(I4)=DIAG(I4)-XM(18,IELEM)-XM(22,IELEM)
00133      &                     -XM(25,IELEM)-XM(13,IELEM)-XM(14,IELEM)
00134           DIAG(I5)=DIAG(I5)-XM(19,IELEM)-XM(23,IELEM)
00135      &                     -XM(26,IELEM)-XM(28,IELEM)-XM(15,IELEM)
00136           DIAG(I6)=DIAG(I6)-XM(20,IELEM)-XM(24,IELEM)
00137      &                     -XM(27,IELEM)-XM(29,IELEM)-XM(30,IELEM)
00138         ENDDO
00139 !
00140       ELSEIF(IELM3.EQ.51.OR.IELM3.EQ.31) THEN
00141 !
00142         DO IELEM = 1,NELEM
00143           I1=IKLE(IELEM,1)
00144           I2=IKLE(IELEM,2)
00145           I3=IKLE(IELEM,3)
00146           I4=IKLE(IELEM,4)
00147           DIAG(I1)=DIAG(I1)-XM(01,IELEM)-XM(02,IELEM)-XM(03,IELEM)
00148           DIAG(I2)=DIAG(I2)-XM(04,IELEM)-XM(05,IELEM)-XM(07,IELEM)
00149           DIAG(I3)=DIAG(I3)-XM(06,IELEM)-XM(08,IELEM)-XM(10,IELEM)
00150           DIAG(I4)=DIAG(I4)-XM(09,IELEM)-XM(11,IELEM)-XM(12,IELEM)
00151         ENDDO
00152 !
00153       ELSE
00154         WRITE(LU,*) 'DIAG_MURD ELEMENT ',IELM3,' NOT IMPLEMENTED'
00155         CALL PLANTE(1)
00156         STOP
00157       ENDIF
00158 !
00159 !-----------------------------------------------------------------------
00160 !
00161       RETURN
00162       END

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