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

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