Télécharger la plaquette Cast3M


fr en

Télécharger crech3.eso

Retour à la liste

Numérotation des lignes : 

crech3

  1. C CRECH3    SOURCE    FANDEUR   22/01/03    21:15:08     11136          
  2.         SUBROUTINE CRECH3(KTRAV,KCHPOI,NND,MRIGID)
  3. C
  4. C
  5. C
  6. C ********   CE SUBROUTINE SERT A CREER UN CHAMP POINT A PARTIR
  7. C ********   D'UN SEGMENT MTRAV.
  8. C
  9. C ********   INCO(NNIN) CONTIENT LE NOMS DES NNIN INCONNUES DIFFERENTES.
  10. C
  11. C ********   BB(I,J) EST LA VALEUR DE LA IEME INCONNUE DU CHAMP POUR
  12. C ********   LE JEME NOEUD DU TABLEAU IGEO.
  13. C
  14. C ********   IBIN(I,J)=1 OU 0. 1 INDIQUE QUE LA I EME INCONNUE DU CHAMP
  15. C ********   EXISTE POUR LE J EME NOEUD DU TABLEAU IGEO.
  16. C
  17. C ********   IGEO(I) EST LE NUMERO A METTRE DANS UN OBJET MELEME POUR
  18. C ********   REFERENCER LE IEME NOEUD
  19. C
  20. C ********   NHAR(I)  EST LE NUMERO D'HARMONIQUE SI CALCUL AXI OU
  21. C ********   SIGNIFIE CONTRAINTE PLANE,DEFORMATION PLANE OU DEF PLAN GEN
  22. C
  23. C ********  ATTENTION ATTENTION ATTENTION IL EXISTE UNE VARIABLE
  24. C ********  POUVANT DEPENDRE DE LA MACHINE. NN25 EST SUPPOSE SUFFISAMENT
  25. C ********  PETIT POUR QUE 2**NN25 SOIT UN ENTIER POSSIBLE.
  26. C
  27. C
  28. C *** POUR PLUS DE RENSEIGNEMENTS VOIR CHARRAS.
  29. C
  30. C
  31. C
  32.       IMPLICIT INTEGER(I-N)
  33.       IMPLICIT REAL*8(A-H,O-Z)
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC SMCHPOI
  38. -INC SMELEME
  39. -INC TMTRAV
  40. -INC SMRIGID
  42. -INC SMMATRI
  43.       SEGMENT NTRAV
  44.       INTEGER IDEJ(NNIN),INO(NNNOE),IBINN(NNNOE,N25),IVA(NNIN)
  45.       INTEGER ICO(NNNOE),ipoinc(nnin)
  46.       ENDSEGMENT
  47.       SEGMENT,ILO(0)
  48.       SEGMENT,IPE(0)
  49.       segact,mrigid*mod
  50.       MMATRI=ICHOLE
  51.       SEGACT MMATRI
  52.       mimik=iimik
  53.       midua=iidua
  54.       NN25=25
  55.       MTRAV=KTRAV
  56.       SEGACT,MTRAV
  57.       NNIN=INCO(/2)
  58.       NNNOE=IBIN(/2)
  59.       N25=(NNIN+NN25-1)/NN25
  60.       SEGINI,NTRAV
  61. * on recherche dans quelle position est inco par rapport à mimik
  62.       itrouv=0
  63.       do ia=1,imik(/2)
  64.          do ib=1,nnin
  65.            if( inco( ib).eq.imik(ia) )then
  66.              itrouv=1
  67.              ipoinc(ib)=ia
  68.            endif
  69.          enddo
  70.       enddo
  71. C
  72. C  ****  CREATION DU TABLEAU IBINN. CE TABLEAU PERMET DE REGROUPER
  73. C  ****  LES INFORMATIONS DE IBIN DE MANIERE A TESTER RAPIDEMENT
  74. C  ****  SI 2 NOEUDS ONT LES MEMES INCONNUES.
  75. C
  76.       J=0
  77.       K=1
  78.       IO=1
  79.       DO 49 I=1,NNIN
  80.       J=J+1
  81.       IVA(I)=IO
  82.       IO=IO*2
  83.       IF(J.LT.NN25)  GO TO 49
  84.       IO=1
  85.       J=0
  86.   49  CONTINUE
  87.       maxinc=0
  88.       DO 51 I=1,NNNOE
  89.       K=0
  90.       maxinl=0
  91.       DO 510 L=1,N25
  92.       L1=1+(L-1)*NN25
  93.       L2=L*NN25
  94.       L2=MIN(L2,NNIN)
  95.       IAFS=0
  96.       DO 52 J=L1,L2
  97.       IF(IBIN(J,I).EQ.0)  GO TO 52
  98.       K=L
  99.       maxinl=maxinl+1
  100.       JJ=J-(L-1)*NN25
  101.       IAFS=IAFS+IVA(JJ)
  102.    52 CONTINUE
  103.       IBINN(I,L)=IAFS
  104.   510 CONTINUE
  105.       ICO(I)=K
  106.       maxinc=max(maxinc,maxinl)
  107.    51 CONTINUE
  108. C
  109. C  ****  CLASSEMENT DES NOEUDS PAR TYPES. ON REMPLIT LE TABLEAU INO.
  110. C  ****  DEUX NOEUDS ONT LE MEME TYPE S'ILS ONT LES MEMES INCONNUES.
  111. C  ****  INO(I)=J VEUT DIRE QUE LE I EME NOEUD EST DE TYPE J.
  112. C  ****  N DONNE LE NOMBRE DE TYPES DE NOEUD DIFFERENTS.
  113. C
  114.       N=0
  115.       SEGINI,ILO,IPE
  116.       NTROUV=0
  117.       DO 53 IDEB=1,NNNOE
  118.       IF(ICO(IDEB).NE.0) GO TO 54
  119.    53 CONTINUE
  120.       GO TO 540
  121.    54 CONTINUE
  122.     3 CONTINUE
  123.       N=N+1
  124.       IPE(**)=IDEB
  125.       ITES=IDEB
  126.       KK=0
  127.       DO 1 I=IDEB,NNNOE
  128.       DO 2 J=1,N25
  129.       IF(IBINN(I,J).NE.IBINN(ITES,J)) GO TO 1
  130.    2  CONTINUE
  131.       KK=KK+1
  132.       INO(I)=N
  133.       ICO(I)=0
  134.    1  CONTINUE
  135.       ILO(**)=KK
  136.       NTROUV=NTROUV+KK
  137.       IF(NTROUV.NE.NNNOE) THEN
  138.       DO 4 IDEB=1,NNNOE
  139.       IF(ICO(IDEB).NE.0)  GO TO 3
  140.     4 CONTINUE
  141.       ENDIF
  142. C
  143. C  ****  ON CONNAIT LE NOMBRE DE SOUS CHAMPS
  144. C  ****  ON INITIALISE LE SEGMENT  MCHPOIN
  145. C
  146. C
  147.   540 CONTINUE
  148.  
  149.       NSOUPO=N
  150.       idimve=nnd
  151.       segini mvecri
  152.       NAT=1
  153.       SEGINI,MCHPOI
  154.       IFOPOI=IFOUR
  155.       JATTRI(1) = 0
  156.       MTYPOI='        '
  157.       MOCHDE='            CHPOINT CREE PAR CRECH3'
  158. C
  159. C  ****  ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT
  160. C  **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE
  161. C  ****  SUPPORT
  162. C
  163.       IF(NSOUPO.EQ.0) THEN
  164.         KCHPOI=MCHPOI
  165.         SEGSUP,NTRAV,ILO,IPE
  166.         RETURN
  167.       ENDIF
  168.       DO 100 I=1,NSOUPO
  169. C
  170. C  **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA
  171. C  **** VALEUR DE IBINN ET ON REMPLIT NOCOMP
  172. C
  173.       IHK=IPE(I)
  174.       NC=0
  175.       DO 20 JK=1,NNIN
  176.       IF(IBIN(JK,IHK).EQ.0)  GO TO 20
  177.       NC=NC+1
  178.       IDEJ(NC)=JK
  179.    20 CONTINUE
  180.       SEGINI,MSOUPO
  181.       IPCHP(I)=MSOUPO
  182.       IB=0
  183.       DO 14 J=1,NC
  184.         NOHARM(J)=NHAR(IDEJ(J))
  185.         naminc(i,j)=imik(IPOINC(idej(j)))
  186.         namdua(i,j)=idua(ipoinc(idej(j)))
  187.         NUMHAR(i,j)=NOHARM(J)
  188.         NOCOMP(J)  =INCO(IDEJ(J))
  189.    14 CONTINUE
  190. C
  191. C  ****  ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE
  192. C
  193.       NBSOUS=0
  194.       NBREF=0
  195.       NBNN=1
  196.       NBELEM=ILO(I)
  197.       N=NBELEM
  198.       SEGINI,MPOVAL
  199.       SEGINI,MELEME
  200.       numnom(I)=nc
  201.       numnoe(i)=n
  202.       ITYPEL=1
  203.       IC=0
  204.       DO 16 J=1,NNNOE
  205.       IF(INO(J).NE.I) GO TO 16
  206.       IC=IC+1
  207.       NUM(1,IC)=IGEO(J)
  208.       DO 18 K=1,NC
  209.       IO=IDEJ(K)
  210.       VPOCHA(IC,K)=BB(IO,J)
  211.       ikk=ibin(io,j)
  212.       numzon(ikk)=i
  213.       nunolo(ikk)=ic
  214.       nuinlo(ikk)=k
  215.    18 CONTINUE
  216.    16 CONTINUE
  217.       call crech1(meleme,1)
  218.       melzon(i)=meleme
  219.       IGEOC=MELEME
  220.       IPOVAL=MPOVAL
  221.  100  CONTINUE
  222.       SEGSUP,ILO,IPE
  223.       KCHPOI=MCHPOI
  224.       ivecri=mvecri
  225.       segdes mvecri
  226.       SEGSUP,NTRAV
  227.       END
  228.  
  229.  
  230.  

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