matrbl.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\matrbl.f
00002 !
00087                      SUBROUTINE MATRBL
00088 !                    *****************
00089 !
00090      &( OP , X , A , Y , C , MESH )
00091 !
00092 !***********************************************************************
00093 ! BIEF   V6P1                                   21/08/2010
00094 !***********************************************************************
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !| A              |-->| MATRIX OR BLOCK OF MATRICES
00102 !| C              |-->| A GIVEN CONSTANT
00103 !| MESH           |-->| MESH STRUCTURE
00104 !| OP             |-->| THE OPERATION TO BE DONE
00105 !| X              |<--| RESULTING VECTOR OR BLOCK OF VECTORS
00106 !| Y              |-->| GIVEN VECTOR OR BLOCK OF VECTORS
00107 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00108 !
00109       USE BIEF, EX_MATRBL => MATRBL
00110 !
00111       IMPLICIT NONE
00112       INTEGER LNG,LU
00113       COMMON/INFO/LNG,LU
00114 !
00115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00116 !
00117       CHARACTER(LEN=8), INTENT(IN)   :: OP
00118       TYPE(BIEF_OBJ), INTENT(INOUT)  :: X
00119       TYPE(BIEF_OBJ), INTENT(IN)     :: A,Y
00120       DOUBLE PRECISION, INTENT(IN)   :: C
00121       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00122 !
00123 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00124 !
00125       INTEGER S
00126 !
00127 !-----------------------------------------------------------------------
00128 !
00129 !     CASE WHERE THE STRUCTURES ARE BLOCKS
00130 !
00131       IF(A%TYPE.EQ.4) THEN
00132 !
00133         S = X%N
00134 !
00135         IF(S.EQ.1) THEN
00136 !
00137           CALL MATVEC( OP,X%ADR(1)%P,A%ADR(1)%P,Y%ADR(1)%P,C,MESH)
00138 !
00139         ELSEIF(S.EQ.2) THEN
00140 !
00141           IF(OP(1:8).EQ.'X=AY    ') THEN
00142             CALL MATVEC('X=AY    ',
00143      &      X%ADR(1)%P,A%ADR(1)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00144             CALL MATVEC('X=X+AY  ',
00145      &      X%ADR(1)%P,A%ADR(2)%P,Y%ADR(2)%P,C,MESH,LEGO=.TRUE.)
00146             CALL MATVEC('X=AY    ',
00147      &      X%ADR(2)%P,A%ADR(3)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00148             CALL MATVEC('X=X+AY  ',
00149      &      X%ADR(2)%P,A%ADR(4)%P,Y%ADR(2)%P,C,MESH,LEGO=.TRUE.)
00150           ELSEIF(OP(1:8).EQ.'X=TAY   ') THEN
00151             CALL MATVEC('X=TAY   ',
00152      &      X%ADR(1)%P,A%ADR(1)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00153             CALL MATVEC('X=X+TAY ',
00154      &      X%ADR(1)%P,A%ADR(3)%P,Y%ADR(2)%P,C,MESH,LEGO=.TRUE.)
00155             CALL MATVEC('X=TAY   ',
00156      &      X%ADR(2)%P,A%ADR(2)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00157             CALL MATVEC('X=X+TAY ',
00158      &      X%ADR(2)%P,A%ADR(4)%P,Y%ADR(2)%P,C,MESH,LEGO=.TRUE.)
00159 !
00160           ELSE
00161             IF (LNG.EQ.1) WRITE(LU,10) OP
00162             IF (LNG.EQ.2) WRITE(LU,11) OP
00163             CALL PLANTE(1)
00164             STOP
00165           ENDIF
00166 !
00167         ELSEIF(S.EQ.3) THEN
00168 !
00169           IF(OP(1:8).EQ.'X=AY    ') THEN
00170             CALL MATVEC('X=AY    ',
00171      &      X%ADR(1)%P,A%ADR(1)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00172             CALL MATVEC('X=X+AY  ',
00173      &      X%ADR(1)%P,A%ADR(2)%P,Y%ADR(2)%P,C,MESH,LEGO=.FALSE.)
00174             CALL MATVEC('X=X+AY  ',
00175      &      X%ADR(1)%P,A%ADR(3)%P,Y%ADR(3)%P,C,MESH,LEGO=.TRUE.)
00176             CALL MATVEC('X=AY    ',
00177      &      X%ADR(2)%P,A%ADR(4)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00178             CALL MATVEC('X=X+AY  ',
00179      &      X%ADR(2)%P,A%ADR(5)%P,Y%ADR(2)%P,C,MESH,LEGO=.FALSE.)
00180             CALL MATVEC('X=X+AY  ',
00181      &      X%ADR(2)%P,A%ADR(6)%P,Y%ADR(3)%P,C,MESH,LEGO=.TRUE. )
00182             CALL MATVEC('X=AY    ',
00183      &      X%ADR(3)%P,A%ADR(7)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00184             CALL MATVEC('X=X+AY  ',
00185      &      X%ADR(3)%P,A%ADR(8)%P,Y%ADR(2)%P,C,MESH,LEGO=.FALSE.)
00186             CALL MATVEC('X=X+AY  ',
00187      &      X%ADR(3)%P,A%ADR(9)%P,Y%ADR(3)%P,C,MESH,LEGO=.TRUE.)
00188           ELSEIF(OP(1:8).EQ.'X=TAY   ') THEN
00189             CALL MATVEC('X=TAY   ',
00190      &      X%ADR(1)%P,A%ADR(1)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00191             CALL MATVEC('X=X+TAY ',
00192      &      X%ADR(1)%P,A%ADR(4)%P,Y%ADR(2)%P,C,MESH,LEGO=.FALSE.)
00193             CALL MATVEC('X=X+TAY ',
00194      &      X%ADR(1)%P,A%ADR(7)%P,Y%ADR(3)%P,C,MESH,LEGO=.TRUE.)
00195             CALL MATVEC('X=TAY   ',
00196      &      X%ADR(2)%P,A%ADR(2)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00197             CALL MATVEC('X=X+TAY ',
00198      &      X%ADR(2)%P,A%ADR(5)%P,Y%ADR(2)%P,C,MESH,LEGO=.FALSE.)
00199             CALL MATVEC('X=X+TAY ',
00200      &      X%ADR(2)%P,A%ADR(8)%P,Y%ADR(3)%P,C,MESH,LEGO=.TRUE.)
00201             CALL MATVEC('X=TAY   ',
00202      &      X%ADR(3)%P,A%ADR(3)%P,Y%ADR(1)%P,C,MESH,LEGO=.FALSE.)
00203             CALL MATVEC('X=X+TAY ',
00204      &      X%ADR(3)%P,A%ADR(6)%P,Y%ADR(2)%P,C,MESH,LEGO=.FALSE.)
00205             CALL MATVEC('X=X+TAY ',
00206      &      X%ADR(3)%P,A%ADR(9)%P,Y%ADR(3)%P,C,MESH,LEGO=.TRUE.)
00207 !
00208           ELSE
00209             IF (LNG.EQ.1) WRITE(LU,10) OP
00210             IF (LNG.EQ.2) WRITE(LU,11) OP
00211 10          FORMAT(1X,'MATRBL (BIEF) : OPERATION INCONNUE : ',A8)
00212 11          FORMAT(1X,'MATRBL (BIEF) : UNKNOWN OPERATION  : ',A8)
00213             CALL PLANTE(0)
00214             STOP
00215           ENDIF
00216 !
00217         ELSE
00218 !
00219           IF (LNG.EQ.1) WRITE(LU,150) S
00220           IF (LNG.EQ.2) WRITE(LU,151) S
00221           IF (LNG.EQ.1) WRITE(LU,50) X%NAME,X%TYPE
00222           IF (LNG.EQ.1) WRITE(LU,51) Y%NAME,Y%TYPE
00223           IF (LNG.EQ.1) WRITE(LU,52) A%NAME,A%TYPE
00224           IF (LNG.EQ.1) WRITE(LU,53)
00225           IF (LNG.EQ.2) WRITE(LU,60) X%NAME,X%TYPE
00226           IF (LNG.EQ.2) WRITE(LU,61) Y%NAME,Y%TYPE
00227           IF (LNG.EQ.2) WRITE(LU,62) A%NAME,A%TYPE
00228           IF (LNG.EQ.2) WRITE(LU,63)
00229 150       FORMAT(1X,'MATRBL (BIEF) : TROP DE VECTEURS INCONNUS :',1I6)
00230 151       FORMAT(1X,'MATRBL (BIEF) : TOO MANY VECTORS          :',1I6)
00231           CALL PLANTE(1)
00232           STOP
00233 !
00234         ENDIF
00235 !
00236 !-----------------------------------------------------------------------
00237 !
00238 !  CASE WHERE THE STRUCTURES ARE NOT BLOCKS
00239 !
00240       ELSEIF(A%TYPE.EQ.3.AND.X%TYPE.EQ.4.AND.Y%TYPE.EQ.4) THEN
00241 !
00242         CALL MATVEC( OP , X%ADR(1)%P , A , Y%ADR(1)%P , C , MESH )
00243 !
00244 !-----------------------------------------------------------------------
00245 !
00246       ELSEIF(A%TYPE.EQ.3.AND.X%TYPE.EQ.2.AND.Y%TYPE.EQ.2) THEN
00247 !
00248         CALL MATVEC( OP , X          , A , Y          , C , MESH )
00249 !
00250 !-----------------------------------------------------------------------
00251 !
00252 !  ERROR
00253 !
00254       ELSE
00255 !
00256         IF (LNG.EQ.1) WRITE(LU,50) X%NAME,X%TYPE
00257         IF (LNG.EQ.1) WRITE(LU,51) Y%NAME,Y%TYPE
00258         IF (LNG.EQ.1) WRITE(LU,52) A%NAME,A%TYPE
00259         IF (LNG.EQ.1) WRITE(LU,53)
00260         IF (LNG.EQ.2) WRITE(LU,60) X%NAME,X%TYPE
00261         IF (LNG.EQ.2) WRITE(LU,61) Y%NAME,Y%TYPE
00262         IF (LNG.EQ.2) WRITE(LU,62) A%NAME,A%TYPE
00263         IF (LNG.EQ.2) WRITE(LU,63)
00264 50      FORMAT(1X,'MATRBL (BIEF) : NOM DE X : ',A6,'  TYPE : ',1I6)
00265 51      FORMAT(1X,'                NOM DE Y : ',A6,'  TYPE : ',1I6)
00266 52      FORMAT(1X,'                NOM DE A : ',A6,'  TYPE : ',1I6)
00267 53      FORMAT(1X,'                CAS NON PREVU')
00268 60      FORMAT(1X,'MATRBL (BIEF) : NAME OF X : ',A6,'  TYPE : ',1I6)
00269 61      FORMAT(1X,'                NAME OF Y : ',A6,'  TYPE : ',1I6)
00270 62      FORMAT(1X,'                NAME OF A : ',A6,'  TYPE : ',1I6)
00271 63      FORMAT(1X,'                NOT IMPLEMENTED')
00272         CALL PLANTE(1)
00273         STOP
00274 !
00275       ENDIF
00276 !
00277 !-----------------------------------------------------------------------
00278 !
00279 !  COMPLEMENTS THE VECTOR (PARALLEL MODE)
00280 !
00281       IF(NCSIZE.GT.1) THEN
00282         CALL PARCOM(X,2,MESH)
00283       ENDIF
00284 !
00285 !-----------------------------------------------------------------------
00286 !
00287       RETURN
00288       END

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