dldu11.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\dldu11.f
00002 !
00089                      SUBROUTINE DLDU11
00090 !                    *****************
00091 !
00092      &(DB,XB,TYPDIA,XA,TYPEXA,IKLE,NELEM,NELMAX,NPOIN,W,COPY,LV)
00093 !
00094 !***********************************************************************
00095 ! BIEF   V6P1                                   21/08/2010
00096 !***********************************************************************
00097 !
00098 !
00099 !
00100 !
00101 !
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !| COPY           |-->| IF .TRUE. A IS COPIED INTO B.
00104 !|                |   | IF .FALSE. B IS CONSIDERED ALREADY INITIALISED
00105 !| DB             |<--| DIAGONAL OF MATRIX B
00106 !| IKLE           |-->| CONNECTIVITY TABLE
00107 !| LV             |-->| VECTOR LENGTH OF THE COMPUTER
00108 !| NELEM          |-->| NUMBER OF ELEMENTS
00109 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00110 !| NPOIN          |-->| NUMBER OF POINTS
00111 !| TYPDIA         |<--| TYPE OF DIAGONAL ( 'Q', 'I' , OR '0' )
00112 !| TYPEXA         |<--| TYPE OF OFF-DIAGONAL TERMS ('Q','S',OR '0')
00113 !| W              |-->| WORK ARRAY OF DIMENSION (NELMAX,3)
00114 !| XA             |<--| OFF-DIAGONAL TERMS OF MATRIX A
00115 !| XB             |<--| OFF-DIAGONAL TERMS OF MATRIX B
00116 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00117 !
00118       USE BIEF, EX_DLDU11 => DLDU11
00119 !
00120       IMPLICIT NONE
00121       INTEGER LNG,LU
00122       COMMON/INFO/LNG,LU
00123 !
00124 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00125 !
00126       INTEGER, INTENT(IN)           :: NELEM,NELMAX,LV,NPOIN
00127       DOUBLE PRECISION, INTENT(OUT) :: DB(NPOIN),XB(NELMAX,*)
00128       DOUBLE PRECISION, INTENT(IN)  :: XA(NELMAX,*)
00129       CHARACTER(LEN=1), INTENT(IN)  :: TYPDIA,TYPEXA
00130       INTEGER, INTENT(IN)           :: IKLE(NELMAX,*)
00131       DOUBLE PRECISION, INTENT(OUT) :: W(NELMAX,3)
00132       LOGICAL, INTENT(IN)           :: COPY
00133 !
00134 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00135 !
00136       INTEGER IELEM
00137 !
00138       DOUBLE PRECISION Z(1),C
00139 !
00140 !-----------------------------------------------------------------------
00141 !
00142 ! REQUIRES THAT THE DIAGONAL OF A BE THE IDENTITY (EXCEPT IN PARALLEL MODE)
00143 !
00144       IF(TYPDIA(1:1).NE.'I'.AND.NCSIZE.LE.1) THEN
00145         IF (LNG.EQ.1) WRITE(LU,100) TYPDIA(1:1)
00146         IF (LNG.EQ.2) WRITE(LU,101) TYPDIA(1:1)
00147 100     FORMAT(1X,'DLDU11 (BIEF) : DIAGONALE DE A NON EGALE A I :',A1)
00148 101     FORMAT(1X,'DLDU11 (BIEF) : DIAGONAL OF A NOT EQUAL TO I :',A1)
00149         CALL PLANTE(0)
00150         STOP
00151       ENDIF
00152 !
00153 !-----------------------------------------------------------------------
00154 !
00155       IF(TYPEXA(1:1).EQ.'S') THEN
00156 !
00157         IF(COPY) CALL OV('X=Y     ' , XB , XA , Z , C  , NELMAX*3 )
00158 !
00159         DO IELEM = 1 , NELEM
00160           W(IELEM,2) = 1.D0 - XB(IELEM,1)**2
00161           XB(IELEM,3) = (XB(IELEM,3)-XB(IELEM,1)*XB(IELEM,2))/W(IELEM,2)
00162           W(IELEM,3) = 1.D0 - XB(IELEM,2)**2 -XB(IELEM,3)**2
00163         ENDDO ! IELEM
00164 !
00165 !-----------------------------------------------------------------------
00166 !
00167       ELSEIF(TYPEXA(1:1).EQ.'Q') THEN
00168 !
00169         IF(COPY) CALL OV('X=Y     ' , XB , XA , Z , C  , NELMAX*6 )
00170 !
00171         DO IELEM = 1 , NELEM
00172 ! L U FACTORISATION
00173           W(IELEM,2)=1.D0 - XB(IELEM,1)*XB(IELEM,4)
00174           XB(IELEM,6) = (XB(IELEM,6)-XB(IELEM,1)*XB(IELEM,5))/W(IELEM,2)
00175           XB(IELEM,3) =  XB(IELEM,3)-XB(IELEM,4)*XB(IELEM,2)
00176           W(IELEM,3)  = 1.D0-XB(IELEM,2)*XB(IELEM,5)
00177      &                - XB(IELEM,3)*XB(IELEM,6)
00178 ! L D U FACTORISATION
00179           XB(IELEM,3) = XB(IELEM,3) / W(IELEM,2)
00180         ENDDO ! IELEM
00181 !
00182 !-----------------------------------------------------------------------
00183 !
00184       ELSE
00185         IF (LNG.EQ.1) WRITE(LU,200) TYPEXA(1:1)
00186         IF (LNG.EQ.2) WRITE(LU,201) TYPEXA(1:1)
00187 200     FORMAT(1X,'DLDU11 (BIEF) : TYPE DE MATRICE NON PREVU :',A1)
00188 201     FORMAT(1X,'DLDU11 (BIEF) : TYPE OF MATRIX NOT AVAILABLE :',A1)
00189         CALL PLANTE(0)
00190         STOP
00191       ENDIF
00192 !
00193 !-----------------------------------------------------------------------
00194 !
00195 !  MULTIPLICATIVE ASSEMBLY OF THE DIAGONAL WITH INITIALISATION OF DB TO 1
00196 !  SKIPS IKLE1 BECAUSE W1 = 1
00197 !
00198       CALL ASMVEC(DB,IKLE(1,2),NPOIN,NELEM,NELMAX,2,W(1,2),.TRUE.,LV)
00199 !
00200 !  INVERTS DB
00201 !
00202       CALL OV( 'X=1/Y   ' , DB , DB , Z , C , NPOIN )
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