Sources Esope | Cast3M

triseg
C TRISEG    SOURCE    PV        09/01/08    21:15:20     6254
      SUBROUTINE TRISEG (TS,ISEG,TN,INOR,TI,ICPR,lcpr,VN,IP1,IP2,IC)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Y)
      IMPLICIT LOGICAL (Z)
      SEGMENT TN
          REAL*8 TNOR (N1,3)
      ENDSEGMENT
      SEGMENT TS
          INTEGER TSEG (M1,M2)
      ENDSEGMENT
      SEGMENT TI
      INTEGER TINDIC(MI1,MI2,2)
      ENDSEGMENT
      SEGMENT ICPR(0)
-INC SMELEME
      REAL*8    VN(3)
*    RECHERCHE SI NORMALE DEJA CODEE
      IF (INOR.NE.0) THEN
         IF (.NOT.( (VN(1).EQ.TNOR(INOR,1)) .AND.
     .   (VN(2).EQ.TNOR(INOR,2)) .AND. (VN(3).EQ.TNOR(INOR,3)))) THEN
              INOR=INOR+1
              IF (INOR.GT.TNOR(/1)) THEN
                     N1=INOR+199
                     N2=3
                     SEGADJ TN
              ENDIF
              TNOR(INOR,1)=VN(1)
              TNOR(INOR,2)=VN(2)
              TNOR(INOR,3)=VN(3)
          ENDIF
      ELSE
            INOR=INOR+1
            TNOR(INOR,1)=VN(1)
            TNOR(INOR,2)=VN(2)
            TNOR(INOR,3)=VN(3)
      ENDIF
*    RECHERCHE SI SEGMENT EN TABLE OU SEGMENT A AJOUTER
      IMIN=1
      IMAX=ISEG
      ZTROUV=.FALSE.
      ZFINI=.FALSE.
*     CLASSE LES EXTREM.
      JP1=MIN(IP1,IP2)
      JP2=MAX(IP1,IP2)
*  on cherche jp1 jp2 dans tindic
      ijp1=icpr(jp1)
      if (ijp1.eq.0) then
       lcpr=lcpr+1
       icpr(jp1)=lcpr
       ijp1=lcpr
      endif
      mi1=tindic(/1)
      mi2=tindic(/2)
      if (ijp1.gt.tindic(/1)) then
       mi1=ijp1+100
       segadj ti
      endif
      do 100 mj=1,mi2
       jp=tindic(ijp1,mj,1)
       if (jp.eq.0) goto 101
       if (jp.ne.jp2) goto 100
       it=tindic(ijp1,mj,2)
       ztrouv=.true.
       goto 101
 100  continue
 101  continue
 
*     AJOUT D'UNE NORMALE POUR UN SEGMENT DEJA EXISTANT
      IF (ZTROUV) THEN
         J=6
2        IF ((J.LE.TSEG(/2)).AND.(TSEG(IT,J).NE.0)) THEN
             J=J+1
             GOTO 2
         ENDIF
         IF (J.GT.TSEG(/2)) THEN
              M2=J
              M1=TSEG(/1)
              SEGADJ TS
         ENDIF
         TSEG(IT,J)=INOR
      ELSE
*     AJOUT D'UN SEGMENT
         ISEG=ISEG+1
         IF (ISEG.GT.TSEG(/1)) THEN
             M1=ISEG+199
             M2=TSEG(/2)
             SEGADJ TS
         ENDIF
         TSEG(ISEG,3)=JP1
         TSEG(ISEG,4)=JP2
         TSEG(ISEG,5)=INOR
         TSEG(ISEG,1)=0
         TSEG(ISEG,2)=IC
         DO 8 I=6,TSEG(/2)
              TSEG(ISEG,I)=0
8        CONTINUE
 
* mise a jour de tindic
         do 110 mj=1,mi2
          if (tindic(ijp1,mj,1).eq.0) goto 111
 110     continue
         mi2=mi2+1
         segadj ti
 111     continue
         tindic(ijp1,mj,1)=jp2
         tindic(ijp1,mj,2)=iseg
      ENDIF
      RETURN
      END