Télécharger la plaquette Cast3M


fr en

Télécharger crech4.eso

Retour à la liste

Numérotation des lignes : 

crech4

  1. C CRECH4    SOURCE    CB215821  25/04/23    21:15:09     12247          
  2. C 
  3.       SUBROUTINE CRECH4(KTRAV,LCHPO)
  4. C
  5. C
  6. C
  7. C ********   CE SUBROUTINE SERT A CREER plusieurs CHAMP POINT A PARTIR
  8. C ********   D'UN SEGMENT MTRAV.
  9. C
  10. C ********   INCO(NNIN) CONTIENT LE NOMS DES NNIN INCONNUES DIFFERENTES.
  11. C
  12. C ********   BB(k,I,J) EST LA VALEUR DE LA IEME INCONNUE DU kieme CHAMP 
  13. C ********   POUR LE JEME NOEUD DU TABLEAU IGEO.
  14. C
  15. C ********   IBIN(I,J)=1 OU 0. 1 INDIQUE QUE LA I EME INCONNUE DU CHAMP
  16. C ********   EXISTE POUR LE J EME NOEUD DU TABLEAU IGEO.
  17. C
  18. C ********   IGEO(I) EST LE NUMERO A METTRE DANS UN OBJET MELEME POUR
  19. C ********   REFERENCER LE IEME NOEUD
  20. C
  21. C ********   NHAR(I)  EST LE NUMERO D'HARMONIQUE SI CALCUL AXI OU
  22. C ********   SIGNIFIE CONTRAINTE PLANE,DEFORMATION PLANE OU DEF PLAN GEN
  23. C
  24. C ********  ATTENTION ATTENTION ATTENTION IL EXISTE UNE VARIABLE
  25. C ********  POUVANT DEPENDRE DE LA MACHINE. NN25 EST SUPPOSE SUFFISAMENT
  26. C ********  PETIT POUR QUE 2**NN25 SOIT UN ENTIER POSSIBLE.
  27. C
  28. C
  29. C *** CREATION : BP, 2016 : COPIE DE CRECHP ADAPTEE AFIN DE TRAITER 
  30. C                PLUSIEURS CHPOINT DE MEME STRUCTURE EN 1 SEUL PASSAGE
  31. C                + AJOUT DE QQ COMMENTAIRES ET INDENTATION
  32. C
  33. C
  34.       IMPLICIT INTEGER(I-N)
  35.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC SMCHPOI
  39. -INC SMCOORD
  40. -INC SMLCHPO
  41. -INC SMELEME
  42. -INC SMMATRI
  43. *     segment de travail = MTRAV modifie pour NNCHPO chpoints
  44.       SEGMENT MTRAV                                                             
  45.        CHARACTER*(LOCOMP) INCO(NNIN)                                                
  46.        REAL*8             BB(NNCHPO,NNIN,NNNOE)                                            
  47.        INTEGER            IBIN(NNIN,NNNOE),IGEO(NNNOE),NHAR(NNIN)                   
  48.       ENDSEGMENT                                                                
  49. *                                                                               
  50. * ********   INCO(NNIN) CONTIENT LE NOMS DES NNIN INCONNUES DIFFERENTES.        
  51. *                                                                               
  52. * ********   BB(I,J) EST LA VALEUR DE LA IEME INCONNUE DU CHAMP POUR            
  53. * ********   LE JEME NOEUD DU TABLEAU IGEO.                                     
  54. *                                                                               
  55. * ********   IBIN(I,J)=1 OU 0. 1 INDIQUE QUE LA I EME INCONNUE DU CHAMP         
  56. * ********   EXISTE POUR LE J EME NOEUD DU TABLEAU IGEO.                        
  57. *                                                                               
  58. * ********   IGEO(I) EST LE NUMERO A METTRE DANS UN OBJET MELEME POUR           
  59. * ********   REFERENCER LE IEME NOEUD                                           
  60. *                                                                               
  61. * ********   NHAR(I)  EST LE NUMERO D'HARMONIQUE SI CALCUL AXI OU               
  62. * ********   SIGNIFIE CONTRAINTE PLANE,DEFORMATION PLANE OU DEF PLAN GEN
  63. *
  64.       SEGMENT NTRAV
  65.       INTEGER IDEJ(NNIN),INO(NNNOE),IBINN(NNNOE,N25),IVA(NNIN)
  66.       INTEGER ICO(NNNOE)
  67.       ENDSEGMENT
  68.  
  69.       SEGMENT,ILO(0)
  70.       SEGMENT,IPE(0)
  71.  
  72.       NN25=25
  73.       MTRAV=KTRAV
  74.       SEGACT,MTRAV
  75.       NNIN=INCO(/2)
  76.       NNNOE=IBIN(/2)
  77.  
  78.       N25=(NNIN+NN25-1)/NN25
  79.       SEGINI,NTRAV
  80.  
  81.       MLCHPO=LCHPO
  82.       NBMOD1=ICHPOI(/1)
  83.  
  84.  
  85. C  ****  CREATION DU TABLEAU IBINN. CE TABLEAU PERMET DE REGROUPER
  86. C  ****  LES INFORMATIONS DE IBIN DE MANIERE A TESTER RAPIDEMENT
  87. C  ****  SI 2 NOEUDS ONT LES MEMES INCONNUES.
  88. C
  89. c     on genere le tableau IVA :
  90. c      I =  1  2  3  4  ...  25   | 26 27 28  ...  50
  91. c      J =  1  2  3  4       25   |  1  2  3       25
  92. c IVA(I) =  1  2  4  8      2**24 |  1  2  4      2**24
  93. c 
  94.       J=0
  95.       K=1
  96.       IO=1
  97.       DO 49 I=1,NNIN
  98.         J=J+1
  99.         IVA(I)=IO
  100.         IO=IO*2
  101.         IF(J.LT.NN25)  GO TO 49
  102.         IO=1
  103.         J=0
  104.   49  CONTINUE
  105.  
  106. c     boucle sur les noeuds ---------------------------------------
  107.       DO 51 I=1,NNNOE
  108.       K=0
  109. c     boucle sur les blocs de 25 ------------
  110.       DO 510 L=1,N25
  111.         L1=1+(L-1)*NN25
  112.         L2=L*NN25
  113.         L2=MIN(L2,NNIN)
  114.         IAFS=0
  115. c       boucle sur les inconnues par bloc de 25  ------
  116.         DO 52 J=L1,L2
  117.           IF(IBIN(J,I).EQ.0)  GO TO 52
  118.           K=L
  119.           JJ=J-(L-1)*NN25
  120.           IAFS=IAFS+IVA(JJ)
  121.    52   CONTINUE
  122. c       fin de boucle sur les inconnues ------
  123. c       IAFS = somme_j 2**(j-1) pour les j inconnues de ce noeud I
  124. c       L'indice L ne sert que pour eviter les pb de representativite  
  125. c       des entiers > 2**26
  126.         IBINN(I,L)=IAFS
  127.   510 CONTINUE
  128. c     fin de boucle sur les blocs de 25 ------------
  129.       ICO(I)=K
  130.    51 CONTINUE
  131. c     fin de boucle sur les noeuds --------------------------------
  132.  
  133.  
  134. C  ****  CLASSEMENT DES NOEUDS PAR TYPES. ON REMPLIT LE TABLEAU INO.
  135. C  ****  DEUX NOEUDS ONT LE MEME TYPE S'ILS ONT LES MEMES INCONNUES.
  136. C  ****  INO(I)=J VEUT DIRE QUE LE I EME NOEUD EST DE TYPE J.
  137. C  ****  N DONNE LE NOMBRE DE TYPES DE NOEUD DIFFERENTS.
  138. C
  139.       N=0
  140.       SEGINI,ILO,IPE
  141.       NTROUV=0
  142. c     Recherceh du 1er noeud avec effectivement une inconnue
  143.       DO 53 IDEB=1,NNNOE
  144.         IF(ICO(IDEB).NE.0) GO TO 54
  145.    53 CONTINUE
  146.       GO TO 540
  147.    54 CONTINUE
  148. c     Boucle sur les types -----------------------------
  149.     3 CONTINUE
  150.       N=N+1
  151. c     on enregistre dans IPE le 1er noeud du type N est IDEB
  152.       IPE(**)=IDEB
  153.       ITES=IDEB
  154.       KK=0
  155. c     boucle sur les noeuds ------
  156.       DO 1 I=IDEB,NNNOE
  157.         DO 2 J=1,N25
  158.           IF(IBINN(I,J).NE.IBINN(ITES,J)) GO TO 1
  159.    2    CONTINUE
  160.         KK=KK+1
  161. c       on note que le noeud I est de type N, et qu'il a deja ete traite
  162.         INO(I)=N
  163.         ICO(I)=0
  164.    1  CONTINUE
  165. c     fin de boucle sur les noeuds ------
  166. c     on enregistre le nombre de noeud KK de type K dans ILO et le total
  167.       ILO(**)=KK
  168.       NTROUV=NTROUV+KK
  169. c     faut-il encore iterer ?
  170.       IF(NTROUV.NE.NNNOE) THEN
  171.         DO 4 IDEB=1,NNNOE
  172.           IF(ICO(IDEB).NE.0)  GO TO 3
  173.     4   CONTINUE    
  174.       ENDIF
  175. c     fin de boucle sur les types -----------------------------
  176. c       write(*,*) N,'type detecte'
  177. c       write(*,*) 'IPE=',(IPE(iou),iou=1,IPE(/1))
  178. c       write(*,*) 'INO=',(INO(iou),iou=1,NNNOE)
  179. c       write(*,*) 'ILO=',(ILO(iou),iou=1,ILO(/1))
  180.  
  181.  
  182. C  ****  ON CONNAIT LE NOMBRE DE SOUS CHAMPS
  183.       NSOUPO=N
  184.       NAT=1
  185.  
  186. C==== BOUCLE SUR LES CHPOINTS ==========================================
  187.   540 CONTINUE
  188.       IMOD=0
  189.   541 CONTINUE
  190.       IMOD=IMOD+1
  191. c       write(*,*) '-------mode',IMOD
  192.  
  193. C  ****  ON INITIALISE LE SEGMENT  MCHPOIN
  194.       SEGINI,MCHPOI
  195.       IFOPOI=IFOUR
  196.       JATTRI(1) = 0
  197.       MTYPOI='        '
  198.       MOCHDE='CHPOINT CREE PAR CRECH4'
  199. C
  200. C  ****  ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT
  201. C  **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE
  202. C  ****  SUPPORT
  203. C
  204. c     cas du chpoint vide
  205.       IF(NSOUPO.EQ.0) GOTO 900
  206.  
  207. c     Boucle sur les SOUPO ---------------------------------------------
  208.       DO 100 I=1,NSOUPO
  209. C
  210. C  **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA
  211. C  **** VALEUR DE IBINN ET ON REMPLIT NOCOMP
  212. C
  213.       IHK=IPE(I)
  214.       NC=0
  215.       DO 20 JK=1,NNIN
  216.         IF(IBIN(JK,IHK).EQ.0)  GO TO 20
  217.         NC=NC+1
  218.         IDEJ(NC)=JK
  219.    20 CONTINUE
  220.       SEGINI,MSOUPO
  221.       IPCHP(I)=MSOUPO
  222.       IB=0
  223.       DO 14 J=1,NC
  224.         NOHARM(J)=NHAR(IDEJ(J))
  225.         NOCOMP(J)=INCO(IDEJ(J))
  226.    14 CONTINUE
  227. C
  228. C  ****  ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE
  229. C
  230. c   - 1er passage : il faut creer et remplir les MELEME + MPOVAL 
  231.       IF(IMOD.EQ.1) THEN      
  232.         NBELEM=ILO(I)
  233.         NBSOUS=0
  234.         NBREF=0
  235.         NBNN=1
  236.         SEGINI,MELEME
  237.         ITYPEL=1
  238.         N=NBELEM
  239.         SEGINI,MPOVAL
  240.         IC=0
  241. c       remplissage de MELEME + MPOVAL 
  242.         DO 16 J=1,NNNOE
  243.           IF(INO(J).NE.I) GO TO 16
  244.           IC=IC+1
  245.           NUM(1,IC)=IGEO(J)
  246.           DO 18 K=1,NC
  247.             IO=IDEJ(K)
  248.             VPOCHA(IC,K)=BB(IMOD,IO,J)
  249.    18     CONTINUE   
  250.    16   CONTINUE
  251. C       Obligation du NOMOD sur MELEME sinon attente en parallele
  252.         segact,meleme*nomod
  253.         call crech1(meleme,1)
  254.         IGEOC=MELEME
  255.         IPOVAL=MPOVAL
  256. c astuce: pour les passages suivants, on stocke le meleme actif dans ILO
  257.         ILO(I)=IGEOC
  258.  
  259. c   - passages suivants : il faut creer et remplir MPOVAL 
  260.       ELSE      
  261.         MELEME=ILO(I)
  262.         N=NUM(/2)
  263.         SEGINI,MPOVAL
  264.         IC=0
  265. c       remplissage de MPOVAL 
  266.         DO 26 J=1,NNNOE
  267.           IF(INO(J).NE.I) GO TO 26
  268.           IC=IC+1
  269.           DO 28 K=1,NC
  270.             IO=IDEJ(K)
  271.             VPOCHA(IC,K)=BB(IMOD,IO,J)
  272.    28     CONTINUE   
  273.    26   CONTINUE
  274.         IGEOC=MELEME
  275.         IPOVAL=MPOVAL
  276.       ENDIF
  277.  
  278.  
  279.  100  CONTINUE
  280. c     fin de Boucle sur les SOUPO --------------------------------------
  281.  
  282.  
  283.  900  CONTINUE
  284.       KCHPOI=MCHPOI
  285.       ICHPOI(IMOD)=KCHPOI
  286.       IF(IMOD.LT.NBMOD1) GOTO 541
  287.  
  288. C==== FIN DE BOUCLE SUR LES CHPOINTS ===================================
  289.  
  290.  999  CONTINUE
  291.       SEGSUP,ILO,IPE
  292.       SEGSUP,NTRAV
  293.       END
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  

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