elebd31.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\elebd31.f
00002 !
00064                      SUBROUTINE ELEBD31
00065 !                    ******************
00066 !
00067      &(NELBOR,NULONE,IKLBOR,IFABOR,NBOR,IKLE,
00068      & NELEM,NELEB,NELMAX,NPOIN,NPTFR,IELM)
00069 !
00070 !***********************************************************************
00071 ! BIEF   V6P0                                   21/08/2010
00072 !***********************************************************************
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00080 !| IELM           |-->| TYPE D'ELEMENT.
00081 !| IFABOR         |-->| TABLEAU DES VOISINS DES FACES.
00082 !| IKLBOR         |<--| NUMERO LOCAL DES NOEUDS A PARTIR D'UN ELEMENT
00083 !|                |   | DE BORD
00084 !| IKLE           |-->| NUMEROS GLOBAUX DES POINTS DE CHAQUE ELEMENT.
00085 !| NBOR           |-->| NUMERO GLOBAL D'UN NOEUD A PARTIR DU NUMERO LOCAL
00086 !| NELBOR         |<--| NUMERO DE L'ELEMENT ADJACENT AU KIEME SEGMENT
00087 !| NELEB          |-->| NOMBRE D'ELEMENTS DE BORD.
00088 !| NELEM          |-->| NOMBRE TOTAL D'ELEMENTS DANS LE MAILLAGE.
00089 !| NELMAX         |---|
00090 !| NPOIN          |-->| NOMBRE TOTAL DE POINTS DU DOMAINE.
00091 !| NPTFR          |-->| NOMBRE DE POINTS FRONTIERES.
00092 !| NULONE         |<--| NUMERO LOCAL D'UN POINT DE BORD DANS
00093 !|                |   | L'ELEMENT ADJACENT DONNE PAR NELBOR
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !
00096       USE BIEF, EX_ELEBD31 => ELEBD31
00097 !
00098       IMPLICIT NONE
00099       INTEGER LNG,LU
00100       COMMON/INFO/LNG,LU
00101 !
00102 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00103 !
00104       INTEGER, INTENT(IN)    :: NELEM,NELEB,NELMAX
00105       INTEGER, INTENT(IN)    :: NPOIN,NPTFR,IELM
00106       INTEGER, INTENT(IN)    :: NBOR(NPTFR)
00107       INTEGER, INTENT(IN)    :: IFABOR(NELMAX,4)
00108       INTEGER, INTENT(IN)    :: IKLE(NELEM,4)
00109       INTEGER, INTENT(OUT)   :: NELBOR(NELEB),NULONE(NELEB,3)
00110       INTEGER, INTENT(OUT)   :: IKLBOR(NELEB,3)
00111 !
00112 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00113 !
00114       INTEGER   :: IELEM, IELEB, J,K,IPOIN
00115       INTEGER   :: IPOBO(NPOIN)
00116 !
00117       INTEGER SOMFAC(3,4)
00118       DATA SOMFAC / 1,2,3 , 4,1,2 , 2,3,4 , 3,4,1  /
00119 !     SIDE NUMBER:    1       2       3       4
00120 !
00121 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00122 !
00123       IF(IELM /= 31) THEN
00124         IF(LNG.EQ.1) WRITE(LU,98) IELM
00125         IF(LNG.EQ.2) WRITE(LU,99) IELM
00126 98      FORMAT(1X,'VOISIN: IELM=',1I6,' TYPE D''ELEMENT NON PREVU')
00127 99      FORMAT(1X,'VOISIN: IELM=',1I6,' TYPE OF ELEMENT NOT AVAILABLE')
00128         CALL PLANTE(1)
00129         STOP
00130       ENDIF
00131 !
00132 ! BUILDS IPOBO TO GO FROM GLOBAL NUMBERING TO LOCAL NUMBERING
00133       DO IPOIN=1,NPOIN
00134         IPOBO(IPOIN) = 0
00135       ENDDO
00136       DO K = 1, NPTFR
00137         IPOBO(NBOR(K)) = K
00138       ENDDO
00139 !
00140 ! BUILDS NELBOR, NULONE, IKLBORD
00141 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00142       IELEB = 0
00143       DO IELEM = 1,NELEM
00144         DO J = 1,4
00145           IF(IFABOR(IELEM,J).EQ.0.OR.IFABOR(IELEM,J).EQ.-1) THEN
00146             IELEB           = IELEB + 1
00147             IF ( IELEB .GT. NELEB ) THEN
00148               IF(LNG.EQ.1) WRITE(LU,101)
00149               IF(LNG.EQ.2) WRITE(LU,102)
00150 101           FORMAT(1X,'ELEBD31 : ERREUR DANS LE MAILLAGE')
00151 102           FORMAT(1X,'ELEBD31 : ERROR IN MESH')
00152               CALL PLANTE(1)
00153               STOP
00154             END IF
00155             NELBOR(IELEB)   = IELEM
00156             NULONE(IELEB,1) = SOMFAC(1,J)
00157             NULONE(IELEB,2) = SOMFAC(2,J)
00158             NULONE(IELEB,3) = SOMFAC(3,J)
00159             IKLBOR(IELEB,1) = IPOBO(IKLE(NELBOR(IELEB),SOMFAC(1,J)))
00160             IKLBOR(IELEB,2) = IPOBO(IKLE(NELBOR(IELEB),SOMFAC(2,J)))
00161             IKLBOR(IELEB,3) = IPOBO(IKLE(NELBOR(IELEB),SOMFAC(3,J)))
00162           ENDIF
00163         ENDDO
00164       ENDDO
00165 !
00166 !-----------------------------------------------------------------------
00167 !
00168       RETURN
00169       END SUBROUTINE ELEBD31

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