dcpldu.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\dcpldu.f
00002 !
00089                      SUBROUTINE DCPLDU
00090 !                    *****************
00091 !
00092      &(B,A,MESH,COPY,LV)
00093 !
00094 !***********************************************************************
00095 ! BIEF   V6P1                                   21/08/2010
00096 !***********************************************************************
00097 !
00098 !
00099 !
00100 !
00101 !
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !| A              |<--| MATRIX A.
00104 !| B              |<--| MATRICE B, THE RESULT.
00105 !| COPY           |-->| IF .TRUE. A IS COPIED INTO B.
00106 !|                |   | IF .FALSE. B IS CONSIDERED ALREADY INITIALISED
00107 !| LV             |-->| VECTOR LENGTH OF THE COMPUTER
00108 !| MESH           |-->| MESH STRUCTURE
00109 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00110 !
00111       USE BIEF, EX_DCPLDU => DCPLDU
00112 !
00113       IMPLICIT NONE
00114       INTEGER LNG,LU
00115       COMMON/INFO/LNG,LU
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       TYPE(BIEF_OBJ) , INTENT(INOUT) :: B
00120       TYPE(BIEF_OBJ) , INTENT(IN)    :: A
00121       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00122       LOGICAL        , INTENT(IN)    :: COPY
00123       INTEGER        , INTENT(IN)    :: LV
00124 !
00125 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00126 !
00127       INTEGER SA,SB,I
00128 !
00129 !-----------------------------------------------------------------------
00130 !
00131       IF(A%TYPE.EQ.3) THEN
00132         SA = 0
00133       ELSEIF(A%TYPE.EQ.4) THEN
00134         SA = A%N
00135       ELSE
00136         IF (LNG.EQ.1) WRITE(LU,300) A%TYPE
00137         IF (LNG.EQ.2) WRITE(LU,400) A%TYPE
00138 300     FORMAT(1X,'DCPLDU (BIEF) :',1I6,' TYPE DE A NON PREVU.')
00139 400     FORMAT(1X,'DCPLDU (BIEF) :',1I6,' UNEXPECTED TYPE FOR A.')
00140         CALL PLANTE(0)
00141         STOP
00142       ENDIF
00143 !
00144       IF(B%TYPE.EQ.3) THEN
00145         SB = 0
00146       ELSEIF(B%TYPE.EQ.4) THEN
00147         SB = B%N
00148       ELSE
00149         IF (LNG.EQ.1) WRITE(LU,301) B%TYPE
00150         IF (LNG.EQ.2) WRITE(LU,401) B%TYPE
00151 301     FORMAT(1X,'DCPLDU (BIEF) :',1I6,' TYPE DE B NON PREVU.')
00152 401     FORMAT(1X,'DCPLDU (BIEF) :',1I6,' UNEXPECTED TYPE FOR B.')
00153         CALL PLANTE(0)
00154         STOP
00155       ENDIF
00156 !
00157 !-----------------------------------------------------------------------
00158 !
00159       IF(SA.EQ.0.AND.SB.EQ.0) THEN
00160 !
00161         CALL DECLDU(B,A,MESH,COPY,LV)
00162 !
00163       ELSEIF(SB.GT.0.AND.SA.GT.0) THEN
00164 !
00165 !       TAKES THE DIAGONALS OF BLOCK A
00166 !
00167         DO I=1,SB
00168           CALL DECLDU(B%ADR(I)%P,A%ADR(1+(SB+1)*(I-1))%P,
00169      &                MESH,COPY,LV)
00170         ENDDO
00171 !
00172       ELSEIF(SA.NE.0.AND.SB.EQ.0) THEN
00173 !
00174 !       TAKES THE FIRST DIAGONAL OF BLOCK A
00175 !
00176         CALL DECLDU(B,A%ADR(1)%P,MESH,COPY,LV)
00177 !
00178       ELSE
00179 !
00180         IF (LNG.EQ.1) WRITE(LU,302)
00181         IF (LNG.EQ.2) WRITE(LU,402)
00182 302     FORMAT(1X,'DCPLDU (BIEF) : CAS NON PREVU')
00183 402     FORMAT(1X,'DCPLDU (BIEF) : UNEXPECTED CASE')
00184         CALL PLANTE(0)
00185         STOP
00186 !
00187       ENDIF
00188 !
00189 !-----------------------------------------------------------------------
00190 !
00191       RETURN
00192       END

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