comp_nh_com_seg.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\comp_nh_com_seg.f
00002 !
00066                      SUBROUTINE COMP_NH_COM_SEG
00067 !                    **************************
00068 !
00069      &(ELTSEG,NELEM,NH_COM_SEG,DIM1NHCOM,NB_NEIGHB_SEG,NB_NEIGHB_PT_SEG,
00070      & GLOSEG,DIMGLO,KNOLG,NPOIN)
00071 !
00072 !***********************************************************************
00073 ! BIEF   V6P1                                   21/08/2010
00074 !***********************************************************************
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !| DIM1NHCOM      |-->| FIRST DIMENSION OF NH_COM_SEG
00083 !| DIMGLO         |-->| FIRST DIMENSION OF GLOSEG
00084 !| ELTSEG         |-->| GIVES THE SEGMENT NUMBER OF EDGES OF ELEMENTS
00085 !| GLOSEG         |-->| GLOBAL NUMBERS (IN SUB-DOMAIN) OF POINTS
00086 !|                |   | OF A SEGMENT
00087 !| KNOLG          |-->| GLOBAL NUMBERS (WHOLE MESH) FUNCTION OF
00088 !|                |   | LOCAL NUMBERS OF POINTS
00089 !| NB_NEIGHB_SEG  |-->| NUMBER OF NEIGHBOUR PROCESSOR (FOR SEGMENTS)
00090 !| NELEM          |-->| NUMBER OF ELEMENTS
00091 !| NH_COM_SEG     |-->| ADDRESSES OF INTERFACE SEGMENTS
00092 !| NPOIN          |-->| NUMBER OF POINTS
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !
00095       IMPLICIT NONE
00096       INTEGER LNG,LU
00097       COMMON/INFO/LNG,LU
00098 !
00099 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00100 !
00101       INTEGER, INTENT(IN)    :: NELEM,DIM1NHCOM,NB_NEIGHB_SEG,DIMGLO
00102       INTEGER, INTENT(IN)    :: NPOIN
00103       INTEGER, INTENT(INOUT) :: NH_COM_SEG(DIM1NHCOM,NB_NEIGHB_SEG)
00104       INTEGER, INTENT(IN)    :: ELTSEG(NELEM,3),GLOSEG(DIMGLO,2)
00105       INTEGER, INTENT(IN)    :: NB_NEIGHB_PT_SEG(NB_NEIGHB_SEG)
00106       INTEGER, INTENT(IN)    :: KNOLG(NPOIN)
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER IELEM,IFACE,ISEG,IPROC,IKA,I,J,B,NUMSEG
00111       INTEGER I11,I12,I21,I22
00112       LOGICAL IS_LE_THAN
00113 !
00114 !-----------------------------------------------------------------------
00115 !
00116       DO IPROC=1,NB_NEIGHB_SEG
00117         IKA = NB_NEIGHB_PT_SEG(IPROC)
00118         DO ISEG=1,IKA
00119           IFACE=MOD(NH_COM_SEG(ISEG,IPROC),4)
00120           IELEM=(NH_COM_SEG(ISEG,IPROC)-IFACE)/4
00121           NUMSEG=ELTSEG(IELEM,IFACE)
00122           NH_COM_SEG(ISEG,IPROC)=NUMSEG
00123         ENDDO
00124         IF(IKA.GT.1) THEN
00125           DO J=2,IKA
00126             B=NH_COM_SEG(J,IPROC)
00127             DO I=J-1,1,-1
00128               NUMSEG=NH_COM_SEG(I,IPROC)
00129               I11=KNOLG(GLOSEG(NUMSEG,1))
00130               I12=KNOLG(GLOSEG(NUMSEG,2))
00131               I21=KNOLG(GLOSEG(B     ,1))
00132               I22=KNOLG(GLOSEG(B     ,2))
00133               IF(I11.GT.I21) THEN
00134                 IS_LE_THAN=.FALSE.
00135               ELSEIF(I11.LT.I21) THEN
00136                 IS_LE_THAN=.TRUE.
00137               ELSEIF(I11.EQ.I21.AND.I12.GT.I22) THEN
00138                 IS_LE_THAN=.FALSE.
00139               ELSEIF(I11.EQ.I21.AND.I12.LT.I22) THEN
00140                 IS_LE_THAN=.TRUE.
00141               ELSEIF(I11.EQ.I21.AND.I12.EQ.I22) THEN
00142                 IS_LE_THAN=.TRUE.
00143               ELSE
00144                 WRITE(LU,*) 'UNEXPECTED CASE IN COMP_NH_COM_SEG'
00145                 CALL PLANTE(1)
00146                 STOP
00147               ENDIF
00148               IF(IS_LE_THAN) GO TO 10
00149               NH_COM_SEG(I+1,IPROC)=NH_COM_SEG(I,IPROC)
00150             ENDDO
00151  10         CONTINUE
00152             NH_COM_SEG(I+1,IPROC)=B
00153           ENDDO
00154         ENDIF
00155       ENDDO
00156 !
00157 !-----------------------------------------------------------------------
00158 !
00159       RETURN
00160       END

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