Télécharger la plaquette Cast3M


fr en

Télécharger avtrsf.eso

Retour à la liste

Numérotation des lignes : 

avtrsf

  1. C AVTRSF    SOURCE    OF166741  26/03/02    21:15:01     12482          
  2.  
  3. C   CE SOUS PROGRAMME FABRIQUE LE SEGMENT FER OU SONT MISES EN FORME
  4. C   LES DONNEES DE TRANSF
  5. C
  6. C  MELEME = OBJET A EXPLORER (MAILLAGE SIMPLE)
  7. C  FER    = DONNEES MISES EN FORME
  8. C  IPT5   = OBJET DANS LA NUMEROTATION DE FER
  9.  
  10.       SUBROUTINE AVTRSF(MELEME,FER,IPT5)
  11.  
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8 (A-H,O-Z)
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.  
  18. -INC SMELEME
  19. -INC SMCOORD
  20.  
  21.       SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR)
  22.       SEGMENT ICPR(nbpts)
  23.       SEGMENT IDCP(ITE)
  24.       SEGMENT KON(NBCON,NMAX)
  25.       SEGMENT IDCT(ITT)
  26.  
  27. c*      SEGACT,MELEME <- Actif en E/S
  28.       NBELEM=meleme.NUM(/2)
  29.       NBNN  =meleme.NUM(/1)
  30.       IF (NBNN.EQ.0 .OR. NBELEM.EQ.0) THEN
  31.         CALL ERREUR(21)
  32.         RETURN
  33.       ENDIF
  34.       NBSOUS=0
  35.       NBREF =0
  36.  
  37. C  REMPLISSAGE DE ICPR
  38.       SEGINI ICPR
  39. *      DO I=1,nbpts
  40. *        ICPR(I)=0
  41. *      ENDDO
  42.       ITT=(2+NBNN)*NBELEM
  43.       IPP=NBELEM
  44.       SEGINI FER
  45.       IF (meleme.ITYPEL.EQ.2) IPT5=0
  46.       IT  = 0
  47.       ITE = 0
  48.       IF (IPT5.NE.0) THEN
  49.         SEGINI IPT5
  50.         IPT5.ITYPEL = meleme.ITYPEL
  51.         DO J=1,NBELEM
  52.           IPOIT=meleme.NUM(2,J)
  53.           IT=IT+1
  54.           ITE=ITE+1
  55.           fer.NFI(IT)=IPOIT
  56.           ICPR(IPOIT)=ITE
  57.         ENDDO
  58.       ENDIF
  59.       DO J=1,NBNN
  60.         DO K=1,NBELEM
  61.           IPOIT=meleme.NUM(J,K)
  62.           IF (ICPR(IPOIT).EQ.0) THEN
  63.             ITE=ITE+1
  64.             ICPR(IPOIT)=ITE
  65.           ENDIF
  66.         ENDDO
  67.       ENDDO
  68. C  TABLEAU INVERSE
  69.       SEGINI IDCP
  70.       ILO=nbpts
  71.       DO I=1,ILO
  72.         II=ILO+1-I
  73.         IF (ICPR(II).NE.0) IDCP(ICPR(II))=II
  74.       ENDDO
  75. C   ITE EST LE NOMBRE DE POINTS A TRACER  ICPR LE TABLEAU
  76. C   ON VA MAINTENANT INITIALISER ET REMPLIR LE TABLEAU DES CONNECTIONS
  77.       NBCON=3
  78.       NBCONR=NBCON-1
  79.       NMAX=(5*ITE)/NBCON
  80.       SEGINI KON
  81. C   MISE A ZERO DU TABLEAU KON
  82. c*      DO I=1,NMAX
  83. c*        DO J=1,NBCON
  84. c*          KON(J,I)=0
  85. c*        ENDDO
  86. c*      ENDDO
  87. C   FABRICATION DU TABLEAU DES CONNECTIONS
  88.       ICHAIN=ITE
  89.       DO 20 I=1,NBELEM
  90.         N1=ICPR(meleme.NUM(1,I))
  91.         N2=ICPR(meleme.NUM(NBNN,I))
  92.         IF (N1.EQ.N2) THEN
  93.           CALL ERREUR(28)
  94.           GOTO 99
  95.         ENDIF
  96.         ISENS=1
  97.         NI=N1
  98.         NJ=N2
  99.   21    CONTINUE
  100.   22    DO 23 K=1,NBCONR
  101.           IF (ABS(KON(K,NI)).EQ.NJ) THEN
  102.             CALL ERREUR(28)
  103.             GOTO 99
  104.           ENDIF
  105.           IF (KON(K,NI).EQ.0) GOTO 25
  106.   23    CONTINUE
  107.         IF (KON(NBCON,NI).EQ.0) GOTO 24
  108.         NI=KON(NBCON,NI)
  109.         GOTO 22
  110.   24    ICHAIN=ICHAIN+1
  111.         IF (ICHAIN.EQ.NMAX) THEN
  112.           CALL ERREUR(23)
  113.           GOTO 99
  114.         ENDIF
  115.         KON(NBCON,NI)=ICHAIN
  116.         K=1
  117.         NI=ICHAIN
  118.   25    KON(K,NI)=NJ*ISENS
  119.         IF (ISENS.LE.0) GOTO 20
  120.         NI=N2
  121.         NJ=N1
  122.         ISENS=-1
  123.         GOTO 21
  124.   20  CONTINUE
  125. C  FABRICATION DES CONTOURS
  126.       IP=0
  127.       fer.MAI(1)=IT
  128.       KAUX=1
  129.   40  KAUXR=KAUX
  130.       K=KAUX
  131.       KPRESS=KAUXR
  132.   41  DO KL=1,NBCONR
  133.         ITRA=KON(KL,K)
  134.         IF (ITRA.GT.0) GOTO 44
  135.       ENDDO
  136.       K=KON(NBCON,K)
  137.       IF (K.NE.0) GOTO 41
  138.   43  KAUX=KAUX+1
  139.       IF (KAUX.EQ.ITE+1) GOTO 60
  140.       GOTO 40
  141.   44  IT=IT+1
  142.       fer.NFI(IT)=IDCP(KAUXR)
  143.       GOTO 46
  144.   45  CONTINUE
  145.       KL=1
  146.   46  DO L=KL,NBCONR
  147.         M=ABS(KON(L,K))
  148.         IF (M.NE.0) GOTO 48
  149.       ENDDO
  150.       K=KON(NBCON,K)
  151.       IF (K.EQ.0) THEN
  152.         CALL ERREUR(28)
  153.         GOTO 99
  154.       ENDIF
  155.       GOTO 45
  156.   48  CONTINUE
  157.       IT=IT+1
  158.       fer.NFI(IT)=IDCP(M)
  159.       KON(L,K)=0
  160.       M1=M
  161.   49  CONTINUE
  162.       DO L = 1,NBCONR
  163.         K_z = KON(L,M1)
  164.         IF (K_z.NE.0) THEN
  165.           IF (ABS(K_z).EQ.KPRESS) GOTO 51
  166.         ENDIF
  167.       ENDDO
  168.       M1=KON(NBCON,M1)
  169.       GOTO 49
  170.   51  CONTINUE
  171.       KON(L,M1)=0
  172.       IF (M.EQ.KAUXR) GOTO 52
  175.       GOTO 45
  176.   52  IT=IT-1
  177.       IP=IP+1
  178.       fer.MAI(IP+1)=IT
  179.       GOTO 40
  180.   60  CONTINUE
  181.       fer.ITOUR=IP
  182.       IF (IPT5.NE.0) THEN
  183.         SEGINI IDCT
  184.         DO I=1,IT
  185.           IDCT(ICPR(fer.NFI(I)))=I
  186.         ENDDO
  187.         DO J=1,NBELEM
  188.           DO I=1,NBNN
  189.             IPT5.NUM(I,J)=IDCT(ICPR(NUM(I,J)))
  190.           ENDDO
  191.         ENDDO
  192.         SEGSUP IDCT
  193.       ENDIF
  194.  
  195.  99   CONTINUE
  196.       SEGSUP KON,ICPR,IDCP
  197.       RETURN
  198.       END
  199.  
  200.  
  201.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales