parcom_comp.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE parcom_comp
!                   *****************
!
     &( x ,errx, icom , mesh)
!
!***********************************************************************
! BIEF   V6P2                                  24/02/2016
!***********************************************************************
!
!brief    COMPLEMENTS A VECTOR AND ERROR VECTOR AT THE INTERFACES BETWEEN
!+                SUB-DOMAINS.
!+
!+            X CAN BE A BLOCK OF VECTORS. IN THIS CASE, ALL THE
!+                VECTORS IN THE BLOCK ARE TREATED.
!
!note     IMPORTANT : FROM RELEASE 5.9 ON, IDENTICAL VALUES ARE
!+                     ENSURED AT INTERFACE POINTS SO THAT DIFFERENT
!+                     PROCESSORS WILL ALWAYS MAKE THE SAME DECISION
!+                     IN TESTS ON REAL NUMBERS.
!
!warning  IF THE VECTORS HAVE A SECOND DIMENSION, IT IS
!+            IGNORED FOR THE TIME BEING
!
!history  R.NHEILI (Univerte de Perpignan, DALI)
!+        24/02/2016
!+        V7P3
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| ICOM           |-->| COMMUNICATION MODE
!|                |   | = 1 : VALUE WITH MAXIMUM ABSOLUTE VALUE TAKEN
!|                |   | = 2 : CONTRIBUTIONS ADDED
!|                |   | = 3 : MAXIMUM CONTRIBUTION RETAINED
!|                |   | = 4 : MINIMUM CONTRIBUTION RETAINED
!| MESH           |-->| MESH STRUCTURE
!| X              |<->| VECTOR OR BLOCK OF VECTORS
!| ERRX           |<->| ERROR VECTOR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_parcom_comp => parcom_comp
!
      USE declarations_special
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      INTEGER, INTENT(IN) :: ICOM
!
!     STRUCTURES: VECTORS OR BLOCKS
!
      TYPE(bief_mesh), INTENT(INOUT)   :: MESH
      TYPE(bief_obj), INTENT(INOUT) :: X
      DOUBLE PRECISION, INTENT(INOUT) :: ERRX(*)
!
!-----------------------------------------------------------------------
!
      TYPE(bief_obj), POINTER  :: X2,X3
      INTEGER NPOIN,NPLAN,IAN,NP11,NSEG
!
!***********************************************************************
!
!  OF NO USE IF A SUB-DOMAIN IS DISCONNECTED FROM THE OTHERS
!
      IF(nptir.EQ.0) RETURN
!
!-----------------------------------------------------------------------
!
      npoin = mesh%NPOIN
      nplan = 1
      IF(mesh%DIM1.EQ.3) THEN
        npoin = bief_nbpts(11,mesh)
        nplan = mesh%NPOIN/npoin
      ENDIF
!
!-----------------------------------------------------------------------
!
      IF(x%TYPE.EQ.2) THEN
!
!     VECTOR STRUCTURE
!
      ian = 1
      CALL parcom2_comp(x%R,x%R,x%R,errx,npoin,nplan,icom,ian
     & ,mesh)
!
      IF(x%ELM.EQ.13) THEN
        np11=bief_nbpts(11,mesh)
        nseg=mesh%NSEG
        CALL parcom2_seg(x%R(np11+1:np11+nseg),
     &                   x%R(np11+1:np11+nseg),
     &                   x%R(np11+1:np11+nseg),
     &                   nseg,1,icom,ian,mesh,1,11)
      ENDIF
!
      ELSEIF(x%TYPE.EQ.4) THEN
!
!     BLOCK STRUCTURE
!
!     BEWARE: NUMBER LIMITED TO 3 |||||||||||||||||||||||||
      ian = x%N
      IF(ian.EQ.1) THEN
        x2 => x%ADR(1)%P
        x3 => x%ADR(1)%P
      ELSEIF(ian.EQ.2) THEN
        x2 => x%ADR(2)%P
        x3 => x%ADR(2)%P
      ELSEIF(ian.EQ.3) THEN
        x2 => x%ADR(2)%P
        x3 => x%ADR(3)%P
      ELSE
        WRITE(lu,*) 'PARCOM: NO MORE THAN 3 VECTORS'
        CALL plante(1)
        stop
      ENDIF
!
      CALL parcom2_comp(x%ADR(1)%P%R,x2%R,x3%R,errx,npoin
     & ,nplan,icom,ian,mesh)
!
!     PROVISIONNALY 1 BY 1, COULD BE OPTIMISED
!
      IF(x%ADR(1)%P%ELM.EQ.13) THEN
        np11=bief_nbpts(11,mesh)
        nseg=mesh%NSEG
        CALL parcom2_seg(x%ADR(1)%P%R(np11+1:np11+nseg),
     &                   x%ADR(1)%P%R(np11+1:np11+nseg),
     &                   x%ADR(1)%P%R(np11+1:np11+nseg),
!    *                   NSEG,1,ICOM,IAN,MESH)
     &                   nseg,1,icom,1  ,mesh,1,11)
      ENDIF
      IF(ian.GE.2.AND.x2%ELM.EQ.13) THEN
        np11=bief_nbpts(11,mesh)
        nseg=mesh%NSEG
        CALL parcom2_seg(x2%R(np11+1:np11+nseg),
     &                   x2%R(np11+1:np11+nseg),
     &                   x2%R(np11+1:np11+nseg),
!    *                   NSEG,1,ICOM,IAN,MESH)
     &                   nseg,1,icom,1  ,mesh,1,11)
      ENDIF
      IF(ian.EQ.3.AND.x3%ELM.EQ.13) THEN
        np11=bief_nbpts(11,mesh)
        nseg=mesh%NSEG
        CALL parcom2_seg(x3%R(np11+1:np11+nseg),
     &                   x3%R(np11+1:np11+nseg),
     &                   x3%R(np11+1:np11+nseg),
!    *                   NSEG,1,ICOM,IAN,MESH)
     &                   nseg,1,icom,1  ,mesh,1,11)
      ENDIF
!
      ELSE
!
!     ERROR ON THE STRUCTURE
!
      WRITE(lu,53)
53    FORMAT(1x,'                CAS NON PREVU')
      WRITE(lu,54)
54    FORMAT(1x,'               UNEXPECTED CASE')
      CALL plante(1)
      stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END