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

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