C CRECH4 SOURCE MB234859 26/06/10 21:15:22 12569 C SUBROUTINE CRECH4(KTRAV,LCHPO) C C C C ******** CE SUBROUTINE SERT A CREER plusieurs CHAMP POINT A PARTIR C ******** D'UN SEGMENT MTRAV. C C ******** INCO(NNIN) CONTIENT LE NOMS DES NNIN INCONNUES DIFFERENTES. C C ******** BB(k,I,J) EST LA VALEUR DE LA IEME INCONNUE DU kieme CHAMP C ******** POUR LE JEME NOEUD DU TABLEAU IGEO. C C ******** IBIN(I,J)=1 OU 0. 1 INDIQUE QUE LA I EME INCONNUE DU CHAMP C ******** EXISTE POUR LE J EME NOEUD DU TABLEAU IGEO. C C ******** IGEO(I) EST LE NUMERO A METTRE DANS UN OBJET MELEME POUR C ******** REFERENCER LE IEME NOEUD C C ******** NHAR(I) EST LE NUMERO D'HARMONIQUE SI CALCUL AXI OU C ******** SIGNIFIE CONTRAINTE PLANE,DEFORMATION PLANE OU DEF PLAN GEN C C ******** ATTENTION ATTENTION ATTENTION IL EXISTE UNE VARIABLE C ******** POUVANT DEPENDRE DE LA MACHINE. NN25 EST SUPPOSE SUFFISAMENT C ******** PETIT POUR QUE 2**NN25 SOIT UN ENTIER POSSIBLE. C C C *** CREATION : BP, 2016 : COPIE DE CRECHP ADAPTEE AFIN DE TRAITER C PLUSIEURS CHPOINT DE MEME STRUCTURE EN 1 SEUL PASSAGE C + AJOUT DE QQ COMMENTAIRES ET INDENTATION C C IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMCHPOI -INC SMCOORD -INC SMLCHPO -INC SMELEME -INC SMMATRI * segment de travail = MTRAV modifie pour NNCHPO chpoints SEGMENT MTRAV CHARACTER*(LOCOMP) INCO(NNIN) REAL*8 BB(NNCHPO,NNIN,NNNOE) INTEGER IBIN(NNIN,NNNOE),IGEO(NNNOE),NHAR(NNIN) ENDSEGMENT * * ******** INCO(NNIN) CONTIENT LE NOMS DES NNIN INCONNUES DIFFERENTES. * * ******** BB(I,J) EST LA VALEUR DE LA IEME INCONNUE DU CHAMP POUR * ******** LE JEME NOEUD DU TABLEAU IGEO. * * ******** IBIN(I,J)=1 OU 0. 1 INDIQUE QUE LA I EME INCONNUE DU CHAMP * ******** EXISTE POUR LE J EME NOEUD DU TABLEAU IGEO. * * ******** IGEO(I) EST LE NUMERO A METTRE DANS UN OBJET MELEME POUR * ******** REFERENCER LE IEME NOEUD * * ******** NHAR(I) EST LE NUMERO D'HARMONIQUE SI CALCUL AXI OU * ******** SIGNIFIE CONTRAINTE PLANE,DEFORMATION PLANE OU DEF PLAN GEN * SEGMENT NTRAV INTEGER IDEJ(NNIN),INO(NNNOE),IBINN(NNNOE,N25),IVA(NNIN) INTEGER ICO(NNNOE) ENDSEGMENT SEGMENT,ILO(0) SEGMENT,IPE(0) NN25=25 MTRAV=KTRAV SEGACT,MTRAV NNIN=INCO(/2) NNNOE=IBIN(/2) N25=(NNIN+NN25-1)/NN25 SEGINI,NTRAV MLCHPO=LCHPO NBMOD1=ICHPOI(/1) C **** CREATION DU TABLEAU IBINN. CE TABLEAU PERMET DE REGROUPER C **** LES INFORMATIONS DE IBIN DE MANIERE A TESTER RAPIDEMENT C **** SI 2 NOEUDS ONT LES MEMES INCONNUES. C c on genere le tableau IVA : c I = 1 2 3 4 ... 25 | 26 27 28 ... 50 c J = 1 2 3 4 25 | 1 2 3 25 c IVA(I) = 1 2 4 8 2**24 | 1 2 4 2**24 c J=0 K=1 IO=1 DO 49 I=1,NNIN J=J+1 IVA(I)=IO IO=IO*2 IF(J.LT.NN25) GO TO 49 IO=1 J=0 49 CONTINUE c boucle sur les noeuds --------------------------------------- DO 51 I=1,NNNOE K=0 c boucle sur les blocs de 25 ------------ DO 510 L=1,N25 L1=1+(L-1)*NN25 L2=L*NN25 L2=MIN(L2,NNIN) IAFS=0 c boucle sur les inconnues par bloc de 25 ------ DO 52 J=L1,L2 IF(IBIN(J,I).EQ.0) GO TO 52 K=L JJ=J-(L-1)*NN25 IAFS=IAFS+IVA(JJ) 52 CONTINUE c fin de boucle sur les inconnues ------ c IAFS = somme_j 2**(j-1) pour les j inconnues de ce noeud I c L'indice L ne sert que pour eviter les pb de representativite c des entiers > 2**26 IBINN(I,L)=IAFS 510 CONTINUE c fin de boucle sur les blocs de 25 ------------ ICO(I)=K 51 CONTINUE c fin de boucle sur les noeuds -------------------------------- C **** CLASSEMENT DES NOEUDS PAR TYPES. ON REMPLIT LE TABLEAU INO. C **** DEUX NOEUDS ONT LE MEME TYPE S'ILS ONT LES MEMES INCONNUES. C **** INO(I)=J VEUT DIRE QUE LE I EME NOEUD EST DE TYPE J. C **** N DONNE LE NOMBRE DE TYPES DE NOEUD DIFFERENTS. C N=0 SEGINI,ILO,IPE NTROUV=0 c Recherceh du 1er noeud avec effectivement une inconnue DO 53 IDEB=1,NNNOE IF(ICO(IDEB).NE.0) GO TO 54 53 CONTINUE GO TO 540 54 CONTINUE c Boucle sur les types ----------------------------- 3 CONTINUE N=N+1 c on enregistre dans IPE le 1er noeud du type N est IDEB IPE(**)=IDEB ITES=IDEB KK=0 c boucle sur les noeuds ------ DO 1 I=IDEB,NNNOE DO 2 J=1,N25 IF(IBINN(I,J).NE.IBINN(ITES,J)) GO TO 1 2 CONTINUE KK=KK+1 c on note que le noeud I est de type N, et qu'il a deja ete traite INO(I)=N ICO(I)=0 1 CONTINUE c fin de boucle sur les noeuds ------ c on enregistre le nombre de noeud KK de type K dans ILO et le total ILO(**)=KK NTROUV=NTROUV+KK c faut-il encore iterer ? IF(NTROUV.NE.NNNOE) THEN DO 4 IDEB=1,NNNOE IF(ICO(IDEB).NE.0) GO TO 3 4 CONTINUE ENDIF c fin de boucle sur les types ----------------------------- c write(*,*) N,'type detecte' c write(*,*) 'IPE=',(IPE(iou),iou=1,IPE(/1)) c write(*,*) 'INO=',(INO(iou),iou=1,NNNOE) c write(*,*) 'ILO=',(ILO(iou),iou=1,ILO(/1)) C **** ON CONNAIT LE NOMBRE DE SOUS CHAMPS NSOUPO=N NAT=1 C==== BOUCLE SUR LES CHPOINTS ========================================== 540 CONTINUE IMOD=0 541 CONTINUE IMOD=IMOD+1 c write(*,*) '-------mode',IMOD C **** ON INITIALISE LE SEGMENT MCHPOIN SEGINI,MCHPOI IFOPOI=IFOUR JATTRI(1) = 0 MTYPOI=' ' MOCHDE='CHPOINT CREE PAR CRECH4' C C **** ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT C **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE C **** SUPPORT C c cas du chpoint vide IF(NSOUPO.EQ.0) GOTO 900 c Boucle sur les SOUPO --------------------------------------------- DO 100 I=1,NSOUPO C C **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA C **** VALEUR DE IBINN ET ON REMPLIT NOCOMP C IHK=IPE(I) NC=0 DO 20 JK=1,NNIN IF(IBIN(JK,IHK).EQ.0) GO TO 20 NC=NC+1 IDEJ(NC)=JK 20 CONTINUE SEGINI,MSOUPO IPCHP(I)=MSOUPO IB=0 DO 14 J=1,NC NOHARM(J)=NHAR(IDEJ(J)) NOCOMP(J)=INCO(IDEJ(J)) 14 CONTINUE C C **** ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE C c - 1er passage : il faut creer et remplir les MELEME + MPOVAL IF(IMOD.EQ.1) THEN NBELEM=ILO(I) NBSOUS=0 NBREF=0 NBNN=1 SEGINI,MELEME ITYPEL=1 N=NBELEM SEGINI,MPOVAL IC=0 c remplissage de MELEME + MPOVAL DO 16 J=1,NNNOE IF(INO(J).NE.I) GO TO 16 IC=IC+1 NUM(1,IC)=IGEO(J) DO 18 K=1,NC IO=IDEJ(K) VPOCHA(IC,K)=BB(IMOD,IO,J) 18 CONTINUE 16 CONTINUE C Obligation du NOMOD sur MELEME sinon attente en parallele segact,meleme*nomod call crech1(meleme,1) IGEOC=MELEME IPOVAL=MPOVAL c astuce: pour les passages suivants, on stocke le meleme actif dans ILO ILO(I)=IGEOC c - passages suivants : il faut creer et remplir MPOVAL ELSE MELEME=ILO(I) N=NUM(/2) SEGINI,MPOVAL IC=0 c remplissage de MPOVAL DO 26 J=1,NNNOE IF(INO(J).NE.I) GO TO 26 IC=IC+1 DO 28 K=1,NC IO=IDEJ(K) VPOCHA(IC,K)=BB(IMOD,IO,J) 28 CONTINUE 26 CONTINUE IGEOC=MELEME IPOVAL=MPOVAL ENDIF 100 CONTINUE c fin de Boucle sur les SOUPO -------------------------------------- 900 CONTINUE KCHPOI=MCHPOI ICHPOI(IMOD)=KCHPOI IF(IMOD.LT.NBMOD1) GOTO 541 C==== FIN DE BOUCLE SUR LES CHPOINTS =================================== 999 CONTINUE SEGSUP,ILO,IPE SEGSUP,NTRAV END