omborseg.f

Go to the documentation of this file.

!                   *******************
                    SUBROUTINE omborseg
!                   *******************
!
     &(op,dm,xm,typexm,dn,xn,typexn,c,
     & ndiag,mseg1,mseg2,nseg1,nseg2,nbor)
!
!***********************************************************************
! BIEF   V6P3                                   01/01/2013
!***********************************************************************
!
!brief    OPERATIONS ON MATRICES WITH AN EDGE-BASED STORAGE
!+         WHERE N IS A BOUNDARY MATRIX
!
!code
!+   D: DIAGONAL MATRIX
!+   C: CONSTANT
!+
!+   OP IS A STRING OF 8 CHARACTERS, WHICH INDICATES THE OPERATION TO BE
!+   PERFORMED ON MATRICES M AND N, D AND C.
!+
!+   THE RESULT IS MATRIX M.
!+
!+      OP = 'M=M+N   '  : ADDS N TO M
!
!history  F. DECUNG (LNHE)
!+        2012
!+        V6P3
!+   Adapted from omseg.f
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| C              |-->| A GIVEN CONSTANT USED IN OPERATION OP
!| DM             |<->| DIAGONAL OF M
!| DN             |-->| DIAGONAL OF N
!| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
!| NDIAG          |-->| NUMBER OF TERMS IN THE DIAGONAL
!| MSEG1          |-->| NUMBER OF SEGMENTS OF LINE ELEMENT OF M
!| MSEG2          |-->| NUMBER OF SEGMENTS OF COLUMN ELEMENT OF M
!| NSEG1          |-->| NUMBER OF SEGMENTS OF LINE ELEMENT OF N
!| NSEG2          |-->| NUMBER OF SEGMENTS OF COLUMN ELEMENT OF N
!| OP             |-->| OPERATION TO BE DONE (SEE ABOVE)
!| TYPEXM         |-->| TYPE OF OFF-DIAGONAL TERMS OF M:
!|                |   | TYPEXM = 'Q' : ANY VALUE
!|                |   | TYPEXM = 'S' : SYMMETRIC
!|                |   | TYPEXM = '0' : ZERO
!| TYPEXN         |-->| TYPE OF OFF-DIAGONAL TERMS OF N:
!|                |   | TYPEXN = 'Q' : ANY VALUE
!|                |   | TYPEXN = 'S' : SYMMETRIC
!|                |   | TYPEXN = '0' : ZERO
!| XM             |-->| OFF-DIAGONAL TERMS OF M
!| XN             |-->| OFF-DIAGONAL TERMS OF N
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_omborseg => omborseg
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NDIAG,MSEG1,MSEG2,NSEG1,NSEG2
      INTEGER, INTENT(IN) :: NBOR(*)
      CHARACTER(LEN=8), INTENT(IN)    :: OP
      DOUBLE PRECISION, INTENT(IN)    :: DN(*)
!     XM AND XN MAY ONLY BE OF SIZE NSEG1 IF THE MATRIX IS SYMMETRICAL
!     SIZE GIVEN HERE ONLY TO CHECK BOUNDS
      DOUBLE PRECISION, INTENT(INOUT) :: XM(mseg1+mseg2)
      DOUBLE PRECISION, INTENT(IN)    :: XN(nseg1+nseg2)
      CHARACTER(LEN=1), INTENT(INOUT) :: TYPEXM,TYPEXN
      DOUBLE PRECISION, INTENT(INOUT) :: DM(*)
      DOUBLE PRECISION, INTENT(IN)    :: C
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTRINSIC min
!
      DOUBLE PRECISION Z(1)
!
      INTEGER DIMX,DIMY
!
!-----------------------------------------------------------------------
!     BASICALLY, FOR SQUARED MATRICES :
!     XM(1:NSEG) <=> XN(1:NSEG)
!     XM(DIMX+1:DIMX+NSEG) <=> XN(NSEG+1:2*NSEG)
!
      dimx=min(mseg1,mseg2)
      dimy=max(nseg1,nseg2)
!
      IF(op(3:8).EQ.'M+N   ') THEN
!
        CALL ovdb( 'X=X+Y   ' , dm , dn , z , c , nbor, ndiag )
!
        IF(typexn(1:1).EQ.'S') THEN
          CALL ov('X=X+Y   ', x=xm, y=xn, dim1=nseg2)
          IF(typexm(1:1).EQ.'Q') THEN
          CALL ov('X=X+Y   ' , x=xm(dimx+1:dimx+nseg2) , y=xn,
     &            dim1=nseg2)
          ENDIF
        ELSEIF(typexn(1:1).EQ.'Q') THEN
          IF(typexm(1:1).NE.'Q') THEN
            WRITE(lu,98) typexm(1:1),op(1:8),typexn(1:1)
98         FORMAT(1x,'OMBORSEG (BIEF) : TYPEXM = ',a1,
     &      ' DOES NOT GO',/,1x,'FOR THE OPERATION : ',a8,
     &      ' WITH TYPEXN = ',a1)
            CALL plante(1)
            stop
          ENDIF
          CALL ov('X=X+Y   ' , x=xm, y=xn, dim1=nseg2)
          CALL ov('X=X+Y   ' , x=xm(dimx+1:dimx+nseg2),
     &            y=xn(dimy+1:dimy+nseg2), dim1=nseg2)
        ELSEIF(typexn(1:1).NE.'0') THEN
          WRITE(lu,11) typexn(1:1)
11        FORMAT(1x,'OMBORSEG (BIEF) : TYPEXN UNKNOWN :',a1)
          CALL plante(1)
          stop
        ENDIF
!
!-----------------------------------------------------------------------
!
      ELSE
!
        WRITE(lu,41) op
41      FORMAT(1x,'OMBORSEG (BIEF) : UNKNOWN OPERATION : ',a8)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END