Télécharger la plaquette Cast3M


fr en

Télécharger elftr2.eso

Retour à la liste

Numérotation des lignes : 

elftr2

  1. C ELFTR2    SOURCE    CHAT      05/01/12    23:32:48     5004
  2.       SUBROUTINE ELFTR2(MATTAC,KNREFE)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C  ====================================================================
  7. C  = APPELE PAR ELFE                                                  =
  8. C  = REGROUPEMENT DES JONCTIONS RELIEES PAR DES ELEMENTS RIGIDES EN   =
  9. C  = UNE SEULE                                                        =
  10. C  = CREATION    : 22/07/87                                           =
  11. C  = PROGRAMMEUR : GUILBAUD                                           =
  12. C  ====================================================================
  13. C
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMATTAC
  18. C
  19.       SEGMENT MNREFE
  20.         INTEGER NREFE(8,NSTR)
  21.         INTEGER NTANBN
  22.         INTEGER NIDNCN
  23.         INTEGER NTVN
  24.         POINTEUR NREPA.MPASS
  25.         POINTEUR NRECA.MCARA
  26.         POINTEUR NRENO.MNORM
  27.         POINTEUR NRECPR.ICPR
  28.         POINTEUR NREMEL.MELEME
  29.         POINTEUR NREDEN.MDEN
  30.       ENDSEGMENT
  31. C
  32. C   NSTR       : NOMBRE D'ELEMENTS
  33. C   NREFE(1,I) : MELEME
  34. C   NREFE(2,I) : MSOSTU
  35. C   NREFE(3,I) : TYPE DE L'ELEMENT
  36. C   NREFE(4,I) : NOMBRE DE POINTS DU MELEME
  37. C   NREFE(5,I) : NOMBRE DE DDL PAR POINT
  38. C   NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN
  39. C   NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN
  40. C   NREFE(8,I)= 1 :LE IEME ELEMENT EST RIGIDE (OU PARTIELLEMENT) SINON 0
  41. C   NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS
  42. C   NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN
  43. C   NTVN   : LONGUEUR DU TABLEAU VN
  44. C
  45.       SEGMENT /JTRAI/(ITRAI(NN))
  46.       SEGMENT /JTRAL/(ITRAL(NSOUMA))
  47.       SEGMENT /JDEJL/(IDEJL(NSOUMA))
  48.       SEGMENT /JDEJA/(IDEJA(NN))
  49.       SEGMENT /JTRAV/(ITRAV(NN))
  50. C
  51.       WRITE(IOIMP,*) ' DEBUT DE ELFTR2 '
  52. C
  53.       MNREFE=KNREFE
  54.       NSTR=NREFE(/2)
  55.       NN=NSTR
  56.       SEGINI JTRAV
  57.       NN=0
  58.       DO 10 N=1,NSTR
  59.       IF(NREFE(8,N).EQ.1) THEN
  60.         NN=NN+1
  61.         ITRAV(NN)=NREFE(2,N)
  62.       ENDIF
  63.    10 CONTINUE
  64.       IF(NN.EQ.0) THEN
  65.         SEGSUP JTRAV
  66.         RETURN
  67.       ENDIF
  68.       SEGADJ JTRAV
  69.       SEGINI JDEJA
  70.       SEGINI JTRAI
  71.       DO 9 I=1,NN
  72.       IDEJA(I)=0
  73.     9 CONTINUE
  74.       SEGACT MATTAC
  75.       NSOUMA=LISATT(/1)
  76.       SEGINI JDEJL,JTRAL
  77.       DO 11 I=1,NSOUMA
  78.       IDEJL(I)=0
  79.    11 CONTINUE
  80.       N=NSOUMA
  81.       SEGINI MATTA1
  82. C
  83. C  BOUCLE SUR LES ELEMENTS RIGIDES
  84. C
  85.       NKK=0
  86.       DO 130 NE=1,NN
  87.       IF(IDEJA(NE).EQ.0) THEN
  88.         WRITE(IOIMP,*) ' ELEMENT RIGIDE NE = ',NE
  89.         NI1=1
  90.         NI2=1
  91.         ITRAI(NI1)=NE
  92.         NLL=0
  93.         NL1=1
  94.         IDEJA(NE)=1
  95.    15   CONTINUE
  96. C
  97. C   1 - RECHERCHE DE TOUTES LES NOUVELLES LIAISONS QUI S'APPUIENT SUR
  98. C       LES DERNIERS ELEMENTS RIGIDES TROUVES
  99. C
  100.         DO 60 NI=NI1,NI2
  101.         NK=ITRAI(NI)
  102.         MSOST1=ITRAV(NK)
  103.         IDEJA(NK)=1
  104.         DO 40 NSOU=1,NSOUMA
  105.         IF(IDEJL(NSOU).EQ.0) THEN
  106.           MSOUMA=LISATT(NSOU)
  107.           SEGACT MSOUMA
  108.           NJON=IATREL(/1)
  109.           DO 30 NJ=1,NJON
  110.           MJONCT=IATREL(NJ)
  111.           SEGACT MJONCT
  112.           NTJ=ISTRJO(/1)
  113.           DO 20 J=1,NTJ
  114.           MSOSTU=ISTRJO(J)
  115.           IF(MSOSTU.EQ.MSOST1) THEN
  116.             NLL=NLL+1
  117.             ITRAL(NLL)=NSOU
  118.             SEGDES MJONCT,MSOUMA
  119.         IDEJL(NSOU)=1
  120.             GOTO 40
  121.           ENDIF
  122.    20     CONTINUE
  123.           SEGDES MJONCT
  124.    30     CONTINUE
  125.           SEGDES MSOUMA
  126.         ENDIF
  127.    40   CONTINUE
  128.    60   CONTINUE
  129.         WRITE(IOIMP,*) ' NI1 NI2 ',NI1,NI2
  130.         WRITE(IOIMP,*) ' ITRAL   ',(ITRAL(NLLL),NLLL=1,NLL)
  131.         WRITE(IOIMP,*) ' IDEJA   ',(IDEJA(NLLL),NLLL=1,NN)
  132. C
  133. C   2 - RECHERCHE DE TOUS LES NOUVEAUX ELEMENTS RIGIDES SUR LESQUELS
  134. C       S'APPUIENT LES DERNIERES LIAISONS TROUVEES
  135. C
  137.         DO 100 NL=NL1,NLL
  138.         NSOU=ITRAL(NL)
  139.         MSOUMA=LISATT(NSOU)
  140.         SEGACT MSOUMA
  141.         NJON=IATREL(/1)
  142.         DO 90 NJ=1,NJON
  143.         MJONCT=IATREL(NJ)
  144.         SEGACT MJONCT
  145.         NTJ=ISTRJO(/1)
  146.         DO 80 J=1,NTJ
  147.         MSOSTU=ISTRJO(J)
  148.         DO 70 KK=1,NN
  149.         IF(IDEJA(KK).EQ.0.AND.MSOSTU.EQ.ITRAV(KK)) THEN
  150.           NI=NI+1
  151.           ITRAI(NI)=KK
  152.           IDEJA(KK)=1
  153.           GOTO 80
  154.         ENDIF
  155.    70   CONTINUE
  156.    80   CONTINUE
  157.         SEGDES MJONCT
  158.    90   CONTINUE
  159.         SEGDES MSOUMA
  160. C       IDEJL(NSOU)=1
  161.   100   CONTINUE
  162.         WRITE(IOIMP,*) ' NL1 NLL ',NL1,NLL
  163.         WRITE(IOIMP,*) ' ITRAI   ',(ITRAI(NLLL),NLLL=1,NI)
  164.         WRITE(IOIMP,*) ' IDEJL   ',(IDEJL(NLLL),NLLL=1,NSOUMA)
  165.         NL1=NLL+1
  166.         NI1=NI2+1
  168.         IF(NI2.GE.NI1) GOTO 15
  169.         M=0
  170.         N=0
  171.         SEGINI MSOUM1
  172.         MSOUM1.IGEOCH=0
  173.         MSOUM1.IPHYCH=0
  174.         MSOUM1.ITYATT='MECA'
  175.         NJJ=0
  176.         DO 120 NL=1,NLL
  177.         NSOU=ITRAL(NL)
  178.         MSOUMA=LISATT(NSOU)
  179.         SEGACT MSOUMA
  180.         NJON=IATREL(/1)
  181.         N=NJJ+NJON
  182.         SEGADJ MSOUM1
  183.         DO 110 NJ=1,NJON
  184.         NJJ=NJJ+1
  185.         MSOUM1.IATREL(NJJ)=IATREL(NJ)
  186.   110   CONTINUE
  187.         SEGSUP MSOUMA
  188.   120   CONTINUE
  189.         SEGDES MSOUM1
  190.         NKK=NKK+1
  191.         MATTA1.LISATT(NKK)=MSOUM1
  192.       ENDIF
  193.   130 CONTINUE
  194.       DO 140 NSOU=1,NSOUMA
  195.       IF(IDEJL(NSOU).EQ.0) THEN
  196.         NKK=NKK+1
  197.         MATTA1.LISATT(NKK)=LISATT(NSOU)
  198.       ENDIF
  199.   140 CONTINUE
  200.       N=NKK
  201.       SEGADJ MATTA1
  202.       SEGSUP MATTAC,JTRAL,JDEJL,JDEJA,JTRAV,JTRAI
  203.       MATTAC=MATTA1
  204. C
  205.       IF(IIMPI.EQ.1) THEN
  206.         WRITE(IOIMP,105) MATTAC
  207.   105   FORMAT(/,10X,' CREATION DE L''OBJET ATTACHE ',I4///)
  208.         NATTA=LISATT(/1)
  209.         WRITE(IOIMP,101)
  210.   101   FORMAT(10X,28('*'))
  211.         WRITE(IOIMP,102)
  212.   102   FORMAT(10X,'* MSOUMA * ITYATT * IATREL *')
  213.         WRITE(IOIMP,101)
  214.         DO 160 IL=1,NATTA
  215.         MSOUMA=LISATT(IL)
  216.         SEGACT MSOUMA
  217.         WRITE(IOIMP,103) MSOUMA,ITYATT,IATREL(1)
  218.   103   FORMAT(10X,'*  ',I4,'  *  ',A4,'  *  ',I4,'  *  ')
  219.         NRELA=IATREL(/1)
  220.         DO 150 IN=2,NRELA
  221.         WRITE(IOIMP,104) IATREL(IN)
  222.   104   FORMAT(10X,2('*        '),'*  ',I4,'  *')
  223.   150   CONTINUE
  224.         SEGDES MSOUMA
  225.         WRITE(IOIMP,101)
  226.   160   CONTINUE
  227.       ENDIF
  228.       SEGDES MATTAC
  229.       WRITE(IOIMP,*) ' FIN DE ELFTR2 '
  230.       RETURN
  231.       END
  232.  
  233.  

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