C RIGIX SOURCE PV090527 26/04/30 21:16:20 12529 subroutine RIGIX (ivamat,ivacar,NMATT,CMATE, & IMODEL,IPINF,LOCIRI,NBGMAT,NELMAT,IMAT) C********************************************************* c C PROCEDURE UTILISEE DANS LE CAS D'ELEMENTS XFEM c POUR LE CALCUL DE RIGIDITE ELEMENTAIRES C C********************************************************* C Liste des modifications : C -as 2009/09/03 : ajout de IMAT en entrée de RIGIX pour le traitement C d'une matrice de Hooke en entrée (cas IMAT=2) C -YT 2010/02/11 : Developpement XFEM 3D C -BP 2011/01 : modification des boucles pour eviter trop de segadj C -BP 2013/10 : ajout de DIM3 pour les contraintes planes C -GG 2017/09 : Modification de mise à 0 les DDL non enrichis C C********************************************************* C PARTIE DECLARATIVE C********************************************************* IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMMODEL -INC SMCHAML -INC SMINTE -INC SMRIGID -INC SMELEME -INC SMLREEL -INC CCHAMP C POINTEUR MCHEX1.MCHELM,MINT1.MINTE,MINT2.MINTE -INC TMPTVAL CHARACTER*8 CMATE CYT PARAMETER (NDDLMAX=20,NBNIMAX=10) PARAMETER (NDDLMAX=30,NBNIMAX=10) CHARACTER*4 MOTINC(NDDLMAX),MOTDUA(NDDLMAX) DATA MOTINC/'UX ','UY ','UZ ','AX ','AY ','AZ ', >'B1X ','B1Y ','B1Z ','C1X ','C1Y ','C1Z ','D1X ','D1Y ', >'D1Z ','E1X ','E1Y ','E1Z ','B2X ','B2Y ','B2Z ','C2X ', >'C2Y ','C2Z ','D2X ','D2Y ','D2Z ','E2X ','E2Y ','E2Z '/ DATA MOTDUA/'FX ','FY ', 'FZ ','FAX ','FAY ','FAZ ', >'FB1X','FB1Y','FB1Z','FC1X','FC1Y','FC1Z','FD1X','FD1Y', >'FD1Z','FE1X','FE1Y','FE1Z','FB2X','FB2Y','FB2Z','FC2X', >'FC2Y','FC2Z','FD2X','FD2Y','FD2Z','FE2X','FE2Y','FE2Z'/ C CYT DATA MOTINC/'UX ','UY ','AX ','AY ', CYT >'B1X ','B1Y ','C1X ','C1Y ','D1X ','D1Y ','E1X ','E1Y ', CYT >'B2X ','B2Y ','C2X ','C2Y ','D2X ','D2Y ','E2X ','E2Y '/ CYT DATA MOTDUA/ 'FX ','FY ','FAX ','FAY ', CYT >'FB1X','FB1Y','FC1X','FC1Y','FD1X','FD1Y','FE1X','FE1Y', CYT >'FB2X','FB2Y','FC2X','FC2Y','FD2X','FD2Y','FE2X','FE2Y'/ PARAMETER (NBENRMAX=30) C NBENRMAX deja defini dans rigixr.eso INTEGER LOCIRI(10,(1+NBENRMAX)) DIMENSION MLRE(NBENRMAX+1) C Segment (type LISTENTI) contenant les informations sur un element SEGMENT WRK1 REAL*8 DDHOOK(LHOOK,LHOOK),XE(3,NBBB) REAL*8 REL(LRE,LRE),RINT(LRE,LRE) ENDSEGMENT C SEGMENT WRK2 REAL*8 SHPWRK(6,NBNO),BGENE(LHOOK,LRE) c REAL*8 LV7WRK(NBENRMA2,2,6,NBNO) REAL*8 LV7WRK(NBENRMA2,2,6,NBBB) ENDSEGMENT C SEGMENT MVELCH REAL*8 VALMAT(NV1) ENDSEGMENT C SEGMENT MRACC INTEGER TLREEL(NBENRMA2,NBI) INTEGER MELRIG(NBELEM) ENDSEGMENT C********************************************************* c C RECUPERATION + ACTIVATIONS + VALEURS UTILES c C********************************************************* C sont deja actifs dans rigi1.eso : C SEGACT MMODEL,IMODEL,MELVAL c IVAMAT MPTVAL=IVAMAT C++++ Recup + Activation de la geometrie ++++++++++++++++ MELEME= IMAMOD SEGACT MELEME C++++ RECUP DES INFOS EF ++++++++++++++++++++++++++++++++ c + OBTENUES PAR ELQUOI DANS RIGI1 PENDANT PHASE 1 C segment INFO deja actif dans RIGI1 c + rigi1 n appelle pas elquoi, c'est modeli qui l'a fait c mais du coup, on na pas de segment minte c (car depend de si pt de g pour rigi, pour sigma....) c c'est + simple de rappeler elquoi ici MELE = NEFMOD NGAU1 = INFELE(6) LRE = INFELE(9) LHOOK = INFELE(10) MINT1 = INFMOD(6) segact,MINT1 MINT2 = INFMOD(10) MFR = INFELE(13) IELE = INFELE(14) NDDL = INFELE(15) NSTRS = INFELE(16) c write(ioimp,*)'-> RIGIX INFELE',(INFELE(iou),iou=1,16) c + AUTRES INFOS C nbre de noeuds par element NBNN1 = NUM(/1) C nbre d elements NBEL1 = NUM(/2) c REM: pour se passer du dimensionnement du nbre d'enrichissement dans c elquoi et le realiser localement , on pourrait ecrire: c LRE = NDDLMAX*NBNN1 c NDDL= NDDLMAX C sous decoupage et points de Gauss de l element geometrique de base CYT if(MELE.eq.263) then cbp if(MELE.eq.263.or.MELE.eq.264) then if (MINT2.ne.0) then segact,MINT2 NGAU2 = MINT2.POIGAU(/1) else NGAU2=0 endif c write(*,*) 'dim de MINT2=6,',(MINT2.SHPTOT(/2)),(MINT2.SHPTOT(/3)) c write(*,*) 'MINT2',(MINT2.QSIGAU(iou),iou=1,NGAU2) c nbre maxi de fonction de forme par noeud (fonction std comprise) c NBNI = NDDL/IDIM inutile! C++++ Recup des infos d enrichissement +++++++++++++++++++ c recup du MCHEX1 d'enrichissement NBENR1=0 MCHAM1=0 NOBMO1=IVAMOD(/1) if (NOBMO1.ne.0) then do iobmo1=1,NOBMO1 if ((TYMODE(iobmo1)).eq.'MCHAML') then MCHEX1 = IVAMOD(iobmo1) segact,MCHEX1 if ((MCHEX1.TITCHE).eq.'ENRICHIS') then MCHAM1 = MCHEX1.ICHAML(1) segact,MCHAM1 goto 1000 endif endif enddo write(ioimp,*) 'Le modele est vide (absence d enrichissement)' * return else write(ioimp,*) 'Aucun MCHAML enrichissement dans le Modele' * return endif 1000 continue c niveau d enrichissement(s) du modele (ddls std u exclus) c NBENR1= 0 si std, 1 si H seul, 2 si H+F1, 3 si H+F1+F2, etc... if (MCHAM1.ne.0) NBENR1=MCHAM1.IELVAL(/1) c* write(ioimp,*) 'niveau d enrichissement(s) du modele',NBENR1 C********************************************************* c c PREPARATION DES OBJETS RESULTATS c C********************************************************* C C++++ RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX c MOTINC et MODUA en dur pour l instant C++++ REMPLISSAGE DE DESCR de taille maxi c (on ajustera en enlevant si besoin) NLIGRP = LRE NLIGRD = LRE SEGINI DESCR IPDSCR = DESCR C KINC = 0 C----->> BOUCLE SUR LES fonctions de Forme DO IENR=1,NBNIMAX C------->> BOUCLE SUR LES NOEUDS DO I=1,NBNN1 C--------->> BOUCLE SUR LA DIMENSION DO KDIM=1,IDIM KINC = KINC + 1 CYT LISINC(KINC) = MOTINC((IDIM*(IENR-1))+KDIM) CYT LISDUA(KINC) = MOTDUA((IDIM*(IENR-1))+KDIM) LISINC(KINC) = MOTINC((3*(IENR-1))+KDIM) LISDUA(KINC) = MOTDUA((3*(IENR-1))+KDIM) NOELEP(KINC) = I NOELED(KINC) = I ENDDO ENDDO ENDDO IF (KINC.NE.LRE) THEN WRITE(ioimp,*) 'IL Y A UNE ERREUR DANS DESCR' WRITE(ioimp,*) 'KINC , LRE = ',KINC,LRE RETURN ENDIF C SEGDES DESCR C C C++++ INITIALISATIONS... C c ... des tables LOCIRI et MLRE c MLRE contient le nombre d'inconnues de chaque sous-zone c determinee depuis le nombre de fonctions de forme c ienr= 1: U+H(1+1=2), 2: U+H+F1(2+4=6), 3: U+H+F1+F2(6+4=10) if (NBENR1.ne.0) then do ienr=1,NBENR1 nbniJ = 2 + ((ienr-1)*4) MLRE(1+ienr) = IDIM*NBNN1*nbniJ c -LOCIRI LOCIRI(5,1+ienr)= NIFOUR enddo endif C Tables + longues car 1er indice correspond au fontion de forme std MLRE(1) = IDIM*NBNN1*1 LOCIRI(5,1)= NIFOUR c on complete avec des 0 if (NBENR1.lt.(NBENRMAX+1)) then do ienr=(NBENR1+1),(NBENRMAX) MLRE(1+ienr) = 0 enddo endif c c ...DU SEGMENT WRK1 NBENRMA2 = NBENRMAX NBBB = NBNN1 SEGINI,WRK1 c ...DU SEGMENT WRK2 c NBNO = NBNI NBNO = LRE/IDIM SEGINI,WRK2 c ...DU SEGMENT MVELCH NV1 = NMATT SEGINI,MVELCH C c ...DU SEGMENT MRACC NBENRMA2 = NBENRMAX NBI = NBNN1 NBELEM = NUM(/2) segini,MRACC C C C********************************************************* C C>>>>>>>>>>>>>>>>>>>>>>>>>>> 1ere BOUCLE SUR LES ELEMENTS C NBENR = 0 DO 2000 J=1,NBEL1 c write(ioimp,*) '===boucle1=== EF',J,' /NBEL1 ================' C C C********************************************************* C POUR CHAQUE ELEMENT, ... C********************************************************* C C++++ NBENRJ = niveau d enrichissement de l element ++++ C =0 si EF std =1 si U+H =2 si U+H+F1 =3 si U+H+F1+F2 NBENRJ=0 if (NBENR1.ne.0) then do IENR=1,NBENR1 MELVA1 = MCHAM1.IELVAL(IENR) segact,MELVA1 do I=1,NBNN1 mlree1 = MELVA1.IELCHE(I,J) if(mlree1.ne.0) NBENRJ=max(NBENRJ,IENR) enddo enddo endif NBENR=max(NBENRJ,NBENR) c c++++ Selon le niveau d enrichissement NBENRJ... C c++++ ...on ajuste la 3eme dimension de XMATRI.RE c (=nbre d element de ce niveau d enrichissement) C on la stocke temporairement dans LOCIRI(4, ) meme si c est pas propre LOCIRI(4,1+NBENRJ) = LOCIRI(4,1+NBENRJ) + 1 c C++++ ...on copie cet element a la geo correspondante IPT1 = LOCIRI(1,1+NBENRJ) c si elle n existe pas, il faut la creer if (IPT1 .eq. 0) then NBNN = NBNN1 NBELEM = 1 NBSOUS = 0 NBREF = 0 segini,IPT1 IPT1.ITYPEL = ITYPEL LOCIRI(1,1+NBENRJ)=IPT1 c si elle existe, il faut l agrandir else NBNN = NBNN1 NBELEM = (IPT1.NUM(/2)) + 1 NBSOUS = 0 NBREF = 0 segadj,IPT1 endif c Ajout de la connectivite de l'element courant do I=1,NBNN1 IPT1.NUM(I,NBELEM) = NUM(I,J) enddo c on retient la position NBELEM de l element J MELRIG(J)= NBELEM C++++ ...on crée le descr qui va bien si il n existe pas DES1 = LOCIRI(3,1+NBENRJ) if (DES1.eq.0) then segini,DES1=DESCR NLIGRP = MLRE(1+NBENRJ) NLIGRD = MLRE(1+NBENRJ) segadj,DES1 LOCIRI(3,1+NBENRJ) = DES1 * on remet en ro des1 segact,DES1 endif 2000 CONTINUE C FIN DE 1ere BOUCLE SUR LES ELEMENTS <<<<<<<<<<<<<<<<<<<<< C C********************************************************* C********************************************************* C POUR CHAQUE NIVEAU D ENRICHISSEMENT, ... C********************************************************* do IENR=1,(NBENR1+1) c attention : IENR = IENRvrai + 1 NELRIG = LOCIRI(4,IENR) C++++ ...ON CRÉE XMATRI DE LA BONNE TAILLE TOUT DE SUITE if (NELRIG.ne.0) then NLIGRP = MLRE(IENR) NLIGRD = MLRE(IENR) rigrel=0 segini,XMATRI LOCIRI(4,IENR)=XMATRI * on remet en ro ipt1 C++++ ...ON DESACTIVE IPT1 IPT1 = LOCIRI(1,IENR) segact ipt1 endif enddo C********************************************************* C C>>>>>>>>>>>>>>>>>>>>>>>>>>> 2eme BOUCLE SUR LES ELEMENTS C DO 2001 J=1,NBEL1 c write(*,*) '===boucle 2=== EF',J,' /NBEL1 ================' C C********************************************************* C POUR CHAQUE ELEMENT, ... C********************************************************* C C++++ ON RECUPERE LES COORDONNEES DES NOEUDS DE L ELEMENT CALL DOXE(XCOOR,IDIM,NBNN1,NUM,J,XE) C++++ NBENRJ = niveau d enrichissement de l element ++++ C =0 si EF std =1 si U+H =2 si U+H+F1 =3 si U+H+F1+F2 NBENRJ=0 if (NBENR1.ne.0) then do IENR=1,(NBENR1) MELVA1 = MCHAM1.IELVAL(IENR) segact,MELVA1 do I=1,NBNN1 mlree1 = MELVA1.IELCHE(I,J) C on en profite pour remplir MRACC table de raccourcis pour cet element TLREEL(IENR,I) = mlree1 if (mlree1.ne.0) then NBENRJ = max(NBENRJ,IENR) C et on active la listreel segact,mlree1 endif enddo enddo endif if (NBENRMA2.gt.NBENR1) then do IENR2=(NBENR1+1),NBENRMA2 do I=1,NBNN1 TLREEL(IENR2,I) = 0 enddo enddo endif C c++++ on recupere XMATRI XMATRI = LOCIRI(4,1+NBENRJ) c++++ quelques indices pour dimensionner au plus juste c nbre total de ddl de l'élément considéré NLIGRD = MLRE(1+NBENRJ) NLIGRP = MLRE(1+NBENRJ) c nbre fonction de forme=((Ni_std+Ni_enrichi)*nbnoeud)=Ninconnues/idim NBNI = (MLRE(1+NBENRJ)) / IDIM c position de cet element pour cet enrichissement IELRIG = MELRIG(J) c write(*,*) 'EF',J,' NBENRJ=',NBENRJ, c &'donc',NLIGRD,' ddls et ',NBNI,' fonctions de forme' c C++++ ON MET A ZERO LA SOMME QUE L ON VA CALCULER c CALL ZERO(RINT,LRE,NLIGRP) * CALL ZERO(RINT,NLIGRD,NLIGRP) c |-> impossible car ZERO considere qu il sagit de la dimension de SHPWRK CALL ZEROX(RINT,NLIGRD,NLIGRP,LRE) c c REM : il est interessant au niveau du tems cpu d'utiliser moins de pts c de Gauss lorsque l element n est pas enrichi car cela n'apporte c rien de plus. c On utilise MINT2 = INFELE(12) qui contient le segment d'integration C de l'EF std (QUA4 par ex. pour XQ4R) if ((NBENRJ.eq.0).and.(MINT2.ne.0)) then MINTE = MINT2 NBPGAU= NGAU2 else MINTE = MINT1 NBPGAU= NGAU1 endif C********************************************************* C C>>>>>>>>>> BOUCLE SUR LES POINTS DE GAUSS C DO 2500 KGAU=1,NBPGAU c c write(ioimp,*) '-pt de G ',KGAU,' / ',NBPGAU,'----' C C********************************************************* C Initialisation à 0 C********************************************************* c CALL ZERO(SHPWRK,6,NBNO) CALL ZERO(SHPWRK,6,NBNI) C i6zz = 3 IF (IDIM.EQ.3) i6zz = 4 C c do ienr7=1,NBENRMAX do ienr7=1,NBENRJ do inod7=1,NBNN1 c do i6=1,6 CYT do i6=1,3 do i6=1,i6zz LV7WRK(ienr7,1,i6,inod7) = 0.D0 LV7WRK(ienr7,2,i6,inod7) = 0.D0 enddo enddo enddo c********************************************************* c Calcul des fonction de forme std dans repere local c********************************************************* ccccc BOUCLE SUR LES NOEUDS ccccccccccccccccccccccccccccc c (et donc sur les Ni std) DO 2510 I=1,NBNN1 C++++ Calcul des Ni std c (rappel: 1:Ni 2:Ni,qsi 3:Ni,eta avec i=1,4) SHPWRK(1,I) = SHPTOT(1,I,KGAU) SHPWRK(2,I) = SHPTOT(2,I,KGAU) SHPWRK(3,I) = SHPTOT(3,I,KGAU) IF (IDIM.EQ.3) SHPWRK(4,I) = SHPTOT(4,I,KGAU) 2510 CONTINUE ccccc fin de BOUCLE SUR LES NOEUDS ccccccccccccccccccccccc c********************************************************* c Passage des fonctions de forme std dans repere global c********************************************************* C++++ CALCUL DES Ni,x Ni,y (i=1,4) + CALCUL DE det(J) CALL JACOBI(XE,SHPWRK,IDIM,NBNN1,DJAC) c if(J.eq.1.and.KGAU.eq.1) c &write(*,*) 'Ni(i=1,4)=',(SHPWRK(1,iou),iou=1,NBNN1) c********************************************************* c Si on est pas du tout enrichi on peut sauter une grosse partie c********************************************************* if(NBENRJ.eq.0) goto 2999 c********************************************************* c Calcul des level set + leurs derivees dans repere global c********************************************************* ccccc BOUCLE SUR LES enrichissements ccccccccccccccccccc do 2520 ienr=1,NBENRJ c MELVA1=MCHAM1.IELVAL(IENR) c segact,MELVA1 ccccc BOUCLE SUR LES NOEUDS ccccccccccccccccccccccccccc DO 2521 I=1,NBNN1 C++++ Le I eme noeud est-il ienr-enrichi? mlree1= TLREEL(IENR,I) if(mlree1.eq.0) goto 2521 c Calcul du repere local de fissure(=PSI,PHI) c (rappel: 1,1:psi 1,2:phi 2,1 psi,x ...etc...) do 2522 inode=1,NBNN1 c pour le H-enrichissement, on n a pas gardé PSI (inutile) if (ienr.ne.1) then c valeur de PSI au inode^ieme noeud xpsi1 = mlree1.PROG(inode) c qu on multiplie par la valeur de Ni^std au pt de G considéré LV7WRK(ienr,1,1,I)= LV7WRK(ienr,1,1,I) & + (SHPWRK(1,inode)*xpsi1) LV7WRK(ienr,1,2,I)= LV7WRK(ienr,1,2,I) & + (SHPWRK(2,inode)*xpsi1) LV7WRK(ienr,1,3,I)= LV7WRK(ienr,1,3,I) & + (SHPWRK(3,inode)*xpsi1) IF (IDIM.EQ.3) LV7WRK(ienr,1,4,I)= LV7WRK(ienr,1,4,I) & + (SHPWRK(4,inode)*xpsi1) c valeur de PHI au inode^ieme noeud xphi1 = mlree1.PROG(NBNN1+inode) else xphi1 = mlree1.PROG(inode) endif LV7WRK(ienr,2,1,I)= LV7WRK(ienr,2,1,I) & + (SHPWRK(1,inode)*xphi1) LV7WRK(ienr,2,2,I)= LV7WRK(ienr,2,2,I) & + (SHPWRK(2,inode)*xphi1) LV7WRK(ienr,2,3,I)= LV7WRK(ienr,2,3,I) & + (SHPWRK(3,inode)*xphi1) IF (IDIM.EQ.3) LV7WRK(ienr,2,4,I)= LV7WRK(ienr,2,4,I) & + (SHPWRK(4,inode)*xphi1) 2522 continue 2521 continue ccccc fin de BOUCLE SUR LES NOEUDS ccccccccccccccccccccccc 2520 CONTINUE ccccc fin de BOUCLE SUR LES enrichissements cccccccccccccccc c on a construit C LV7WRK(ienr, PSI/PHI, valeur/deriveeparqsi/pareta, iNOEUD) c********************************************************* c Ajout des fonctions de forme d enrichissement c + leurs derivees dans repere global c********************************************************* CALL SHAPX(MELE,LV7WRK,NBENRMAX,NBENRJ,TLREEL,SHPWRK,IRET) c retour a la partie commune aux EF enrichi et non enrichi 2999 continue C********************************************************* c write(*,*) 'C CALCUL DE B' C********************************************************* call ZERO(BGENE,LHOOK,LRE) KB=1 C boucle sur tous les Ni DO 3001 II=1,NBNI BGENE(1,KB) = SHPWRK(2,II) BGENE(2,KB+1) = SHPWRK(3,II) BGENE(4,KB) = SHPWRK(3,II) BGENE(4,KB+1) = SHPWRK(2,II) IF (IDIM.EQ.3) THEN BGENE(3,KB+2)=SHPWRK(4,II) BGENE(5,KB) =SHPWRK(4,II) BGENE(5,KB+2)=SHPWRK(2,II) BGENE(6,KB+1)=SHPWRK(4,II) BGENE(6,KB+2)=SHPWRK(3,II) ENDIF KB = KB + IDIM 3001 CONTINUE C********************************************************* c write(*,*) 'C CALCUL DE D (=MATRICE DE HOOKE)' C********************************************************* c c+++++cas DOHOOO IF (IMAT.EQ.2) THEN MELVAL=IVAL(1) IBMN=MIN(J ,IELCHE(/2)) IGMN=MIN(KGAU,IELCHE(/1)) MLREEL=IELCHE(IGMN,IBMN) SEGACT MLREEL IF (KGAU.LE.NBGMAT.AND.(J.LE.NELMAT.OR.NBGMAT.GT.1)) 1 CALL DOHOOO(PROG,LHOOK,DDHOOK) c+++++cas DOHMAS ELSE IF (IMAT.EQ.1) THEN DO 4001 IM=1,NMATT IF (IVAL(IM).NE.0) THEN MELVAL=IVAL(IM) IBMN=MIN(J ,VELCHE(/2)) IGMN=MIN(KGAU,VELCHE(/1)) if (ibmn.gt.0.and.igmn.gt.0) then VALMAT(IM)=VELCHE(IGMN,IBMN) else VALMAT(IM)=0.D0 endif ELSE VALMAT(IM)=0.D0 ENDIF 4001 CONTINUE C CALL DOHMAS(VALMAT,CMATE,IFOUR,LHOOK,1,DDHOOK,IRET) IF (IRET.EQ.0) THEN MOTERR(1:8)=CMATE MOTERR(9:16)=NOMFR(MFR/2+1) INTERR(1)=IFOUR CALL ERREUR(81) RETURN ENDIF ENDIF C C********************************************************* c write(*,*) 'C CALCUL DE Bt.D.B' C********************************************************* C PRISE EN COMPTE DU POIDS D'INTEGRATION DJAC = ABS(DJAC) * POIGAU(KGAU) c CAS DES CONTRAINTES PLANES C recuperation de l'epaisseur: DIM3 donnée facultative du materiau IF (IFOUR.EQ.-2) THEN MPTVAL=IVACAR IF (IVACAR.NE.0) THEN MELVAL=IVAL(1) IF (MELVAL.NE.0) THEN IGMN=MIN(KGAU,VELCHE(/1)) IBMN=MIN(J,VELCHE(/2)) DIM3=VELCHE(IGMN,IBMN) ELSE DIM3=1.D0 ENDIF ENDIF DJAC=DJAC*DIM3 MPTVAL=IVAMAT ENDIF CALL ZEROX(REL,NLIGRD,NLIGRP,LRE) CALL BDBST(BGENE,DJAC,DDHOOK,LRE,LHOOK,REL) * CALL BDBST(BGENE,DJAC,DDHOOK,NLIGRP,LHOOK,REL) c |-> impossible car BDBST considere qu il sagit de la dimension de bgene c pour gagner du temps cpu il faudrait qqchose du type: c CALL BDBSTX(BGENE,DJAC,DDHOOK,NLIGRP,LHOOK,LRE,REL) C********************************************************* C CUMUL DANS RINT(II,JJ) C********************************************************* DO II=1,NLIGRD DO JJ=1,NLIGRP RINT(II,JJ) = RINT(II,JJ) + REL(II,JJ) enddo enddo c c 2500 CONTINUE C FIN DE BOUCLE SUR LES POINTS DE GAUSS <<<<<<<<<<<<<< C C********************************************************* C write(*,*) 'C STOCKAGE DANS XMATRI de RE(II,JJ)' c et de XMATRI dans IMATRI C********************************************************* C DO 6001 II=1,NLIGRD DO 6002 JJ=1,NLIGRP c XMATRI.RE(II,JJ,nelrig) = RINT(II,JJ) c RE(II,JJ,NELRIG) = RINT(II,JJ) RE(II,JJ,IELRIG) = RINT(II,JJ) c si NON enrichi, on met tout a 0 sauf la diago c if(mlree1.eq.0) RE(II,JJ) = 0. inutile 6002 CONTINUE 6001 CONTINUE c c 2001 CONTINUE C FIN DE BOUCLE SUR LES ELEMENTS <<<<<<<<<<<<<<<<<<<<< SEGSUP,WRK1,WRK2,MVELCH SEGSUP,MRACC c c desactivation des maillages et segment imatri do ienr=1,(1+NBENR1) XMATRI = LOCIRI(4,ienr) if(XMATRI.ne.0) segdes,XMATRI enddo c SEGDES dans RIGI1 = IMODEL C RETURN END