Sources Esope | Cast3M

noajar
C NOAJAR    SOURCE    CHAT      06/03/29    21:28:07     5360
C
C
      SUBROUTINE NOAJAR(NUMSO,IEL,NBS,NUMNO,NBNO,
     >                  ICODE,IDE,ITRNO2,NBNMX2,NBE2,
     >                  ITRNOE,NBNMAX,ITRTRI,NBCMAX,
     >                  ITVL,NITMAX,iarr)
C     *****************************************************************
C     OBJET NOAJAR : AJOUTE DES NOEUDS SUR UNE ARETE
C
C     EN ENTREE    :
C       ---------- NOEUD A AJOUTER -----------------------
C       NUMSO(1): SOMMET ORIGINE DE L'ARETE
C       NUMSO(2): SOMMET EXTREMITE DE L'ARETE
C       IEL    : UN ELEMENT INCIDENT A NUMSO1 ET/OU NUMSO2
C       NBS    : NOMBRE DE SOMMET QUE IEL CONTIENT (1 OU 2)
C       NUMNO  : LES NUMEROS DES NOEUDS A AJOUTER
C       NBNO   : LE NOMBRE DE NOEUD A AJOUTER
C       ---------- LE MAILLAGE A REMPLIR -----------------------
C       ICODE  : CODE DES ELEMENTS DE ITRNO2
C       ITRNO2 : NOEUDS DES ELEMENTS (A REMPLIR)
C       NBNMX2 : NOMBRE DE NOEUDS D'UN ELEMENT
C       NBE2   : NOMBRE D'ELEMENTS
C       ---------- LE MAILLAGE SANS NOEUDS ---------------------
C       ITRNOE : IDEM ITRNO2 (SANS NOEUDS MILIEU)
C       ITRTRI : TABLEAU DES ELEMENTS VOISINS
C       NBNMAX : NOMBRE DE NOEUDS D'UN ELEMENT
C       NBE    : NOMBRE D'ELEMENTS = NBE2
C       ----------TABLEAU DE TRAVAIL ---------------------------
C       ITVL   : TABLEAU D'ENTIERS
C       NITMAX : TAILLE DE ITVL
C
C     EN SORTIE    :
C       ITRNO2 : NOEUDS DES ELEMENTS AVEC NOEUDS MILIEU
C       iarr   : CODE D'ERREUR
C     *****************************************************************
      IMPLICIT INTEGER(I-N)
      INTEGER NUMSO(*),IEL,NBS,NUMNO(*),NBNO
      INTEGER ICODE,IDE,ITRNO2(*),NBNMX2,NBE2
      INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
      INTEGER ITVL(*),NITMAX
      INTEGER iarr
C
      INTEGER NBNAR
      INTEGER NBNOCO,NBCONN
      INTEGER IEL2,INDSO2(2),INO,INDNO(1),I,NBNO2
C
C         ==================================
C     ---- RECHERCHE DES ARETES DANS ITRNOE ----
C         ==================================
      NBNAR = 2
      CALL TTCONN(NBNAR,NUMSO,IEL,NBS,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
     >            ITVL,NBCONN,NITMAX,NBNOCO,iarr)
      IF( NBNOCO.LT.NBNAR )THEN
        iarr = -1
        CALL DSERRE(1,iarr,'NOAJAR ',' APPEL TTCON')
C        PRINT *,' ON A PERDU L ARETE : ',(NUMSO(INO),INO=1,NBNAR)
C        PRINT *,' NBNOCO = : ',NBNOCO
C        PRINT *,' NBCONN = : ',NBCONN
C        PRINT *,' NITMAX = : ',NITMAX
C        PRINT *,' iarr = : ',iarr
        GOTO 9999
      ENDIF
C      PRINT *,NBCONN,' ELEMENT(S) SUR L ARETE (',
C     >        NUMSO(1),NUMSO(2),') = ',
C     >       (ITVL(INO),INO=1,NBCONN)
C
      DO 100 I=1,NBCONN
C
C     ---- POUR CHAQUE ELEMENT IL FAUT RETROUVER L'INDICE DU NOEUD ----
C
        IEL2 = ITVL(I)
C       ---- NUMERO ABSOLU DANS ITRNO2 ------
        INDSO2(1) = 0
        INDSO2(2) = 0
        DO 20 INO=1,NBNMX2
          IF( ITRNO2((IEL2-1)*NBNMX2+INO).EQ.NUMSO(1))
     >        INDSO2(1) = INO
          IF( ITRNO2((IEL2-1)*NBNMX2+INO).EQ.NUMSO(2))
     >        INDSO2(2) = INO
   20   CONTINUE
C       ---- NUMERO RELATIFS ------
        CALL ELSNAR(ICODE,INDSO2,INDNO,NBNO2,iarr)
        IF((INDNO(1).GT.20).OR.(INDNO(1).LT.1))THEN
          iarr = -1
          CALL DSERRE(1,iarr,'NOAJAR ',' APPEL ELSNAR')
C          PRINT *,'INDSO2,INDNO ',INDSO2(1),INDSO2(2),INDNO(1)
          GOTO 9999
        ENDIF
        IF( iarr.NE.0 )THEN
          CALL DSERRE(1,iarr,'NOAJAR ',' APPEL ELSNAR')
          GOTO 9999
        ENDIF
        IF( NBNO.NE.NBNO2 )THEN
          iarr = -1
C          PRINT *,'NBNO != NBNO2 ',NBNO,NBNO2
          CALL DSERRE(1,iarr,'NOAJAR ',' NOMBRE DE NOEUD SUR L ARETE')
          GOTO 9999
        ENDIF
        DO 30 INO=1,NBNO2
C         PRINT *,'ON AJOUTE LE NOEUD ',NUMNO(INO),
C     >    ' A L ELEMENT ',IEL2,
C     >    ' EN POSITION : ',INDNO(INO)
          ITRNO2((IEL2-1)*NBNMX2+INDNO(INO)) = NUMNO(INO)
   30   CONTINUE
  100 CONTINUE
C
 9999 END