descen.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\descen.f
00002 !
00095                      SUBROUTINE DESCEN
00096 !                    *****************
00097 !
00098      &(X, XA,TYPEXA,B,IKLE,NELEM,NELMAX,NPOIN,IELM,DITR,COPY,LV)
00099 !
00100 !***********************************************************************
00101 ! BIEF   V6P1                                   21/08/2010
00102 !***********************************************************************
00103 !
00104 !
00105 !
00106 !
00107 !
00108 !
00109 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00110 !| B              |<--| RIGHT-HAND SIDE OF THE LINEAR SYSTEM TO BE SOLVED
00111 !| COPY           |-->| IF .TRUE. B IS COPIED INTO X TO START WITH
00112 !| DITR           |-->| CHARACTER, IF  'D' : DIRECT MATRIX A CONSIDERED
00113 !|                |   |                'T' : TRANSPOSED MATRIX A CONSIDERED
00114 !| IELM           |-->| TYPE OF ELEMENT (SEE ABOVE)
00115 !| IKLE           |-->| CONNECTIVITY TABLE.
00116 !| LV             |-->| VECTOR LENGTH OF THE MACHINE
00117 !| NELEM          |-->| NUMBER OF ELEMENTS
00118 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00119 !| NPOIN          |-->| NUMBER OF POINTS
00120 !| TYPEXA         |-->| TYPE OF OFF-DIAGONAL TERMS IN THE MATRIX
00121 !| X              |<--| SOLUTION OF THE SYSTEM AX = B
00122 !| XA             |<--| OFF-DIAGONAL TERMS OF THE MATRIX
00123 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00124 !
00125       USE BIEF, EX_DESCEN => DESCEN
00126 !
00127       IMPLICIT NONE
00128       INTEGER LNG,LU
00129       COMMON/INFO/LNG,LU
00130 !
00131 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00132 !
00133       INTEGER         , INTENT(IN)    :: IELM,NPOIN,NELEM,NELMAX,LV
00134       INTEGER         , INTENT(IN)    :: IKLE(NELMAX,*)
00135       DOUBLE PRECISION, INTENT(INOUT) :: X(NPOIN)
00136       DOUBLE PRECISION, INTENT(IN)    :: XA(NELMAX,*),B(NPOIN)
00137       CHARACTER(LEN=1), INTENT(IN)    :: TYPEXA,DITR
00138       LOGICAL         , INTENT(IN)    :: COPY
00139 !
00140 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00141 !
00142 ! 1) INITIALISES : X = SECOND MEMBER
00143 !
00144       IF(COPY) CALL OV( 'X=Y     ' , X , B , B , 0.D0 , NPOIN )
00145 !
00146 !-----------------------------------------------------------------------
00147 !
00148 ! 2) INVERTS THE LOWER TRIANGULAR MATRICES (DESCENT)
00149 !
00150 !     2.1) TRANSPOSE CASE
00151 !
00152       IF(TYPEXA(1:1).EQ.'S' .OR.
00153      &  (TYPEXA(1:1).EQ.'Q'.AND.DITR(1:1).EQ.'T')) THEN
00154 !
00155       IF(IELM.EQ.11) THEN
00156 !
00157         CALL DES11(X,XA(1,1),XA(1,2),XA(1,3),
00158      &             IKLE(1,1),IKLE(1,2),IKLE(1,3),NELEM,NELMAX,NPOIN,LV)
00159 !
00160       ELSEIF(IELM.EQ.21.OR.IELM.EQ.12.OR.IELM.EQ.31.OR.IELM.EQ.51) THEN
00161 !
00162         CALL DES21(X,XA(1,1),XA(1,2),XA(1,3),XA(1,4),XA(1,5),XA(1,6),
00163      &             IKLE(1,1),IKLE(1,2),IKLE(1,3),IKLE(1,4),
00164      &             NELEM,NELMAX,NPOIN,LV)
00165 !
00166       ELSEIF(IELM.EQ.41) THEN
00167 !
00168         CALL DES41(X,XA(1,1),XA(1,2),XA(1,3),XA(1,4),XA(1,5),XA(1,6),
00169      &             XA(1,7),XA(1,8),XA(1,9),XA(1,10),XA(1,11),XA(1,12),
00170      &             XA(1,13),XA(1,14),XA(1,15),
00171      &             IKLE(1,1),IKLE(1,2),IKLE(1,3),
00172      &             IKLE(1,4),IKLE(1,5),IKLE(1,6),NELEM,NELMAX,NPOIN,LV)
00173 !
00174 !  IELM NOT IMPLEMENTED: ERROR
00175 !
00176       ELSE
00177 !
00178         IF (LNG.EQ.1) WRITE(LU,100) IELM
00179         IF (LNG.EQ.2) WRITE(LU,101) IELM
00180 100   FORMAT(1X,'DESCEN (BIEF) : IELM = ',1I6,' ELEMENT NON PREVU')
00181 101   FORMAT(1X,'DESCEN (BIEF) : IELM = ',1I6,' ELEMENT NOT AVAILABLE')
00182         CALL PLANTE(1)
00183         STOP
00184 !
00185       ENDIF
00186 !
00187 !     2.2) DIRECT CASE
00188 !
00189       ELSEIF(TYPEXA(1:1).EQ.'Q'.AND.DITR(1:1).EQ.'D') THEN
00190 !
00191       IF(IELM.EQ.11) THEN
00192 !
00193         CALL DES11(X,XA(1,4),XA(1,5),XA(1,6),
00194      &             IKLE(1,1),IKLE(1,2),IKLE(1,3),NELEM,NELMAX,NPOIN,LV)
00195 !
00196       ELSEIF(IELM.EQ.21.OR.IELM.EQ.12.OR.IELM.EQ.31.OR.IELM.EQ.51) THEN
00197 !
00198         CALL DES21(X,XA(1,7),XA(1,8),XA(1,9),XA(1,10),XA(1,11),XA(1,12),
00199      &             IKLE(1,1),IKLE(1,2),IKLE(1,3),IKLE(1,4),
00200      &             NELEM,NELMAX,NPOIN,LV)
00201 !
00202       ELSEIF(IELM.EQ.41) THEN
00203 !
00204         CALL DES41(X,
00205      &            XA(1,16),XA(1,17),XA(1,18),XA(1,19),XA(1,20),XA(1,21),
00206      &            XA(1,22),XA(1,23),XA(1,24),XA(1,25),XA(1,26),XA(1,27),
00207      &            XA(1,28),XA(1,29),XA(1,30),
00208      &            IKLE(1,1),IKLE(1,2),IKLE(1,3),
00209      &            IKLE(1,4),IKLE(1,5),IKLE(1,6),NELEM,NELMAX,NPOIN,LV)
00210 !
00211 !  IELM NOT IMPLEMENTED: ERROR
00212 !
00213       ELSE
00214 !
00215         IF (LNG.EQ.1) WRITE(LU,100) IELM
00216         IF (LNG.EQ.2) WRITE(LU,101) IELM
00217         CALL PLANTE(1)
00218         STOP
00219 !
00220       ENDIF
00221 !
00222 !     2.3) CASE NOT IMPLEMENTED
00223 !
00224       ELSE
00225         IF (LNG.EQ.1) WRITE(LU,200) TYPEXA(1:1),DITR(1:1)
00226         IF (LNG.EQ.2) WRITE(LU,201) TYPEXA(1:1),DITR(1:1)
00227 200     FORMAT(1X,'DESCEN (BIEF) : TYPE DE MATRICE NON PREVU :',A1,/,
00228      &         1X,'AVEC DITR=',A1)
00229 201     FORMAT(1X,'DESCEN (BIEF) : UNEXPECTED TYPE OF MATRIX :',A1,/,
00230      &         1X,'WITH DITR=',A1)
00231         CALL PLANTE(1)
00232         STOP
00233       ENDIF
00234 !
00235 !-----------------------------------------------------------------------
00236 !
00237       RETURN
00238       END

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