dlduseg.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\dlduseg.f
00002 !
00094                      SUBROUTINE DLDUSEG
00095 !                    ******************
00096 !
00097      &(DB,XB,TYPDIA,XA,TYPEXA,GLOSEG,NSEG,NPOIN,COPY)
00098 !
00099 !***********************************************************************
00100 ! BIEF   V6P1                                   21/08/2010
00101 !***********************************************************************
00102 !
00103 !
00104 !
00105 !
00106 !
00107 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00108 !| COPY           |-->| IF .TRUE. A IS COPIED INTO B.
00109 !|                |   | IF .FALSE. B IS CONSIDERED ALREADY INITIALISED
00110 !| DB             |<--| DIAGONAL OF MATRIX B
00111 !| GLOSEG         |-->| FIRST AND SECOND POINT OF SEGMENTS
00112 !| NPOIN          |-->| NUMBER OF POINTS
00113 !| NSEG           |-->| NUMBER OF SEGMENTS
00114 !| TYPDIA         |<--| TYPE OF DIAGONAL ( 'Q', 'I' , OR '0' )
00115 !| TYPEXA         |<--| TYPE OF OFF-DIAGONAL TERMS ('Q','S',OR '0')
00116 !| XA             |<--| OFF-DIAGONAL TERMS OF MATRIX A
00117 !| XB             |<--| OFF-DIAGONAL TERMS OF MATRIX B
00118 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00119 !
00120       USE BIEF, EX_DLDUSEG => DLDUSEG
00121 !
00122       IMPLICIT NONE
00123       INTEGER LNG,LU
00124       COMMON/INFO/LNG,LU
00125 !
00126 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00127 !
00128       INTEGER, INTENT(IN)           :: NSEG,NPOIN
00129       DOUBLE PRECISION, INTENT(OUT) :: DB(NPOIN),XB(NSEG,*)
00130       DOUBLE PRECISION, INTENT(IN)  :: XA(NSEG,*)
00131       CHARACTER(LEN=1), INTENT(IN)  :: TYPDIA,TYPEXA
00132       INTEGER, INTENT(IN)           :: GLOSEG(NSEG,2)
00133       LOGICAL, INTENT(IN)           :: COPY
00134 !
00135 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00136 !
00137       INTEGER ISEG
00138 !
00139       DOUBLE PRECISION Z(1),C
00140 !
00141 !-----------------------------------------------------------------------
00142 !
00143 ! REQUIRES THAT THE DIAGONAL OF A BE THE IDENTITY (EXCEPT IN PARALLEL MODE)
00144 !
00145       IF(TYPDIA(1:1).NE.'I'.AND.NCSIZE.LE.1) THEN
00146         IF (LNG.EQ.1) WRITE(LU,100) TYPDIA(1:1)
00147         IF (LNG.EQ.2) WRITE(LU,101) TYPDIA(1:1)
00148 100     FORMAT(1X,'DLDUSEG (BIEF) : DIAGONALE DE A NON IDENTITE :',A1)
00149 101     FORMAT(1X,'DLDUSEG (BIEF) : DIAGONAL OF A NOT IDENTITY :',A1)
00150         CALL PLANTE(1)
00151         STOP
00152       ENDIF
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156       IF(TYPEXA(1:1).EQ.'S') THEN
00157 !
00158         IF(COPY) THEN
00159           CALL OV('X=Y     ' , XB , XA , Z , C , NSEG )
00160         ENDIF
00161 !
00162 !-----------------------------------------------------------------------
00163 !
00164       ELSEIF(TYPEXA(1:1).EQ.'Q') THEN
00165 !
00166         IF(COPY) THEN
00167           CALL OV('X=Y     ' , XB , XA , Z , C , 2*NSEG )
00168         ENDIF
00169 !
00170 !-----------------------------------------------------------------------
00171 !
00172       ELSE
00173         IF (LNG.EQ.1) WRITE(LU,200) TYPEXA(1:1)
00174         IF (LNG.EQ.2) WRITE(LU,201) TYPEXA(1:1)
00175 200     FORMAT(1X,'DLDUSEG (BIEF) : TYPE DE MATRICE NON PREVU :',A1)
00176 201     FORMAT(1X,'DLDUSEG (BIEF) : TYPE OF MATRIX NOT TREATED:',A1)
00177         CALL PLANTE(1)
00178         STOP
00179       ENDIF
00180 !
00181 !-----------------------------------------------------------------------
00182 !
00183 !  MULTIPLICATIVE ASSEMBLY OF THE DIAGONAL WITH INITIALISATION
00184 !  OF DB TO 1
00185 !
00186       CALL OV('X=C     ' , DB , DB , DB , 1.D0 , NPOIN )
00187 !
00188       IF(TYPEXA(1:1).EQ.'S') THEN
00189 !
00190       DO ISEG=1,NSEG
00191         DB(GLOSEG(ISEG,2))=DB(GLOSEG(ISEG,2))*(1.D0-XB(ISEG,1)**2)
00192       ENDDO
00193 !
00194       ELSE
00195 !
00196       DO ISEG=1,NSEG
00197         DB(GLOSEG(ISEG,2))=
00198      &  DB(GLOSEG(ISEG,2))*(1.D0-XB(ISEG,1)*XB(ISEG,2))
00199       ENDDO
00200 !
00201       ENDIF
00202 !
00203 !  INVERTS DB (COULD DIVIDE BY 0)
00204 !
00205       CALL OV( 'X=1/Y   ' , DB , DB , Z , C , NPOIN )
00206 !
00207 !-----------------------------------------------------------------------
00208 !
00209       RETURN
00210       END

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