Sources Esope | Cast3M

avtrsf
C AVTRSF    SOURCE    PV        20/03/30    21:15:29     10567          
C   CE SOUS PROGRAMME FABRIQUE LE SEGMENT FER OU SONT MISE EN FORME
C   LES DONNEES DE TRANSF
C
      SUBROUTINE AVTRSF(MELEME,FER,IPT5)
C
C  MELEME = OBJET A EXPLORER
C  FER   = DONNEES MISES EN FORME
C  IPT5  = OBJET DANS LA NUMEROTATION DE FER
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD
      SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR),AFER.FER
      SEGMENT ICPR(nbpts)
      SEGMENT IDCP(ITE)
      SEGMENT KON(NBCON,NMAX)
      SEGMENT IDCT(ITT)
      SEGINI ICPR
      DO 1 I=1,ICPR(/1)
   1  ICPR(I)=0
C  REMPLISSAGE DE ICPR
      IT=0
      ITE=0
      SEGACT MELEME
      NBELEM=NUM(/2)
      NBNN=NUM(/1)
      NBSOUS=0
      NBREF=0
      ITT=(2+NBNN)*NBELEM
      IPP=NBELEM
      SEGINI FER
      IF (ITYPEL.EQ.2) IPT5=0
      IF (IPT5.EQ.0) GOTO 8
      SEGINI IPT5
      IPT5.ITYPEL=ITYPEL
      DO 7 J=1,NBELEM
      IT=IT+1
      ITE=ITE+1
      NFI(IT)=NUM(2,J)
      ICPR(NUM(2,J))=ITE
   7  CONTINUE
   8  CONTINUE
      DO 2 J=1,NBNN
      DO 2 K=1,NBELEM
      IPOIT=NUM(J,K)
      IF (ICPR(IPOIT).NE.0) GOTO 2
      ITE=ITE+1
      ICPR(IPOIT)=ITE
   2  CONTINUE
C  TABLEAU INVERSE
      SEGINI IDCP
      ILO=nbpts
      DO 3 I=1,ILO
      II=ILO+1-I
      IF (ICPR(II).NE.0) IDCP(ICPR(II))=II
   3  CONTINUE
C   ITE EST LE NOMBRE DE POINTS A TRACER  ICPR LE TABLEAU
C   ON VA MAINTENANT INITIALISER ET REMPLIR LE TABLEAU DES CONNECTIONS
      NBCON=3
      NBCONR=NBCON-1
      NMAX=(5*ITE)/NBCON
      SEGINI KON
C   MISE A ZERO DU TABLEAU KON
      DO 10 I=1,NMAX
      DO 10 J=1,NBCON
  10  KON(J,I)=0
C   FABRICATION DU TABLEAU DES CONNECTIONS
      ICHAIN=ITE
      DO 20 I=1,NUM(/2)
      N1=ICPR(NUM(1,I))
      N2=ICPR(NUM(NBNN,I))
      IF (N1.EQ.N2) GOTO 31
      ISENS=1
      NI=N1
      NJ=N2
  21  CONTINUE
  22  DO 23 K=1,NBCONR
      IF (ABS(KON(K,NI)).EQ.NJ) GOTO 31
      IF (KON(K,NI).EQ.0) GOTO 25
  23  CONTINUE
      IF (KON(NBCON,NI).EQ.0) GOTO 24
      NI=KON(NBCON,NI)
      GOTO 22
  24  ICHAIN=ICHAIN+1
      IF (ICHAIN.EQ.NMAX) GOTO 30
      KON(NBCON,NI)=ICHAIN
      K=1
      NI=ICHAIN
  25  KON(K,NI)=NJ*ISENS
      IF (ISENS.LE.0) GOTO 20
      NI=N2
      NJ=N1
      ISENS=-1
      GOTO 21
  20  CONTINUE
C  FABRICATION DES CONTOURS
      IP=0
      MAI(1)=IT
      KAUX=1
  40  KAUXR=KAUX
      K=KAUX
      KPRESS=KAUXR
  41  DO 42 KL=1,NBCONR
      ITRA=KON(KL,K)
      IF (ITRA.LE.0) GOTO 42
      GOTO 44
  42  CONTINUE
      K=KON(NBCON,K)
      IF (K.NE.0) GOTO 41
  43  KAUX=KAUX+1
      IF (KAUX.EQ.ITE+1) GOTO 60
      GOTO 40
  44  IT=IT+1
      NFI(IT)=IDCP(KAUXR)
      GOTO 46
  45  KL=1
  46  DO 47 L=KL,NBCONR
      M=ABS(KON(L,K))
      IF (M.EQ.0) GOTO 47
      GOTO 48
  47  CONTINUE
      K=KON(NBCON,K)
      IF (K.EQ.0) GOTO 31
      GOTO 45
  48  IT=IT+1
      NFI(IT)=IDCP(M)
      KON(L,K)=0
      M1=M
  49  DO 50 L=1,NBCONR
      IF (KON(L,M1).EQ.0) GOTO 50
      IF (ABS(KON(L,M1)).EQ.KPRESS) GOTO 51
  50  CONTINUE
      M1=KON(NBCON,M1)
      GOTO 49
  51  KON(L,M1)=0
      IF (M.EQ.KAUXR) GOTO 52
      KPRESS=M
      K=KPRESS
      GOTO 45
  52  IT=IT-1
      IP=IP+1
      MAI(IP+1)=IT
      GOTO 40
  60  CONTINUE
      ITOUR=IP
      IF (IPT5.EQ.0) GOTO 70
      SEGINI IDCT
      DO 71 I=1,IT
      IDCT(ICPR(NFI(I)))=I
  71  CONTINUE
      DO 72 I=1,NBNN
      DO 72 J=1,NBELEM
      IPT5.NUM(I,J)=IDCT(ICPR(NUM(I,J)))
  72  CONTINUE
      SEGSUP IDCT
  70  CONTINUE
      SEGSUP KON,ICPR,IDCP
      RETURN
  30  CALL ERREUR(23)
      RETURN
  31  CALL ERREUR(28)
      RETURN
      END