C NLOCA1 SOURCE CB215821 24/04/12 21:16:48 11897 C_______________________________________________________________________ C C CALCUL DE LA MOYENNE NONLOCALE C C C Entrees: C ________ C C IPCHI Pointeur sur un MCHAML de ss-type indifferent C IPCHCO Pointeur sur un MCHAML de Connectivite C (ss-type CONNECTIVITE NON LOCAL) C INODI 0 PAR DEFAUT C 1 SI ON NE VEUT PAS DIVISER PAR LE VOLUME C C Sorties: C ________ C C IPCHO Pointeur sur un MCHAML de meme ss-type que IPCHI C avec les composantes moyennees C les composantes non reconnues sont recopiees C C IRET 1 ou 0 suivant succes ou pas C C C Appele par: NLOCAL C ----------- C C Appel a: C -------- C C NLOVEP verification et preparation de la moyenne C TRTRVE point translate C TRSYPT point symetrique par rapport a un point C TRSYDR point symetrique par rapport a une droite C TRSYPL point symetrique par rapport a un plan C DOXE, JACOBI C C C.GIRY F.DUFOUR VERSION PRENANT EN COMPTE L'ETAT DE CONTRAINTE C SEPTEMBRE 2010 C C NONLOCAL ORIGINAL C P.PEGON OCTOBRE 92 D'APRES C. LA BORDERIE AVRIL 1992 D'APRES P. PEGON C_______________________________________________________________________ C SUBROUTINE NLOCA1(IPCHI,IPCHCO,IPCHO,INODI,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C -INC PPARAM -INC CCOPTIO C -INC SMMODEL -INC SMELEME -INC SMCOORD -INC SMCHAML -INC SMLENTI -INC SMLREEL -INC SMLMOTS -INC SMINTE -INC CCREEL SEGMENT,WRK1 REAL*8 XE(3,NBNN) ENDSEGMENT * SEGMENT NLOC1 INTEGER ILOC2(NZONEF),MOLOC2(NZONEF) END SEGMENT * SEGMENT NLOC2 INTEGER MPCHAM (NDOUBL) INTEGER ILOC4 (NDOUBL) INTEGER MODLAC,MAILEF,MINTEF INTEGER MAILAC (NSZACC) INTEGER MINTAC (NSZACC) INTEGER ILOC3 (NSZACC) INTEGER ILOC3I,ILOC3O INTEGER MELCAR END SEGMENT * SEGMENT NLOC3 INTEGER MELVAC (NCOMP) END SEGMENT * SEGMENT NLOC4 INTEGER JCLE REAL*8 PT1(3),PT2(3),DISP INTEGER MELPNI,MELPLI END SEGMENT * SEGMENT,WRK2 REAL*8 XEJ(3,NBNJ),SHP(6,NBNJ) ENDSEGMENT * SEGMENT WRK3 REAL*8 SOMCOM(NCOMP,NBPGAU) REAL*8 SOMJAC( NBPGAU) END SEGMENT * POINTEUR MLCOMP.MLENTI POINTEUR MLNIMO.MLENTI C DIMENSION XXX(3),XXXJ(3),XXXV1(3),XXXV2(3),XXXV3(3),PTO(3) C DATA XMULTL/1.5/ C REAL*8 N2VEC2,NVEC2 REAL*8 N2VECPO2,NVECPO2 C NHRM=NIFOUR IRET=1 C C ON VERIFIE/PREPARE LES DONNEES C CALL NLOVEP(IPCHCO,IPCHI, IPCHO,NLOC1,IRET) IF (IRET.EQ.0) RETURN C C ON TRAITE L'INFORMATION C C BOUCLE SUR LES ZONES EFFECTIVES C NZONEF=ILOC2(/1) C DO ISOUCF=1,NZONEF C C write(IOIMP,*)'ZONE EFFECTIVE',ISOUCF NLOC2=ILOC2(ISOUCF) MINTE1=MINTEF IPT1=MAILEF NDOUBL=ILOC4(/1) NLOC3=ILOC3I NCOMP=MELVAC(/1) MMODEL=MODLAC * ON SE CONTENTE DE PRENDRE LE IMODEL DU PREMIER SOUS MODELE IMODEL=KMODEL(1) IMNLOC=-1*INFMOD(13) NCOMPE=NCOMP IF(IMNLOC.EQ.2) NCOMPE=1 C C NOMBRE DE POINTS DE GAUSS PAR ELEMENTS POUR LA SS ZONE A MOYENNER C NBPGAU=MINTE1.POIGAU(/1) C C NOMBRE D'ELEMENTS ET DE NOEUDS POUR LA SS ZONE A MOYENNER C NBELEM=IPT1.NUM(/2) NBNN =IPT1.NUM(/1) SEGINI WRK1 SEGINI WRK3 C C DEBUT DE LA BOUCLE SUR LES ELEMENTS C DO IB=1,NBELEM C write(IOIMP,*)' ELEMENT NUMERO',IB C C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB C CALL DOXE(XCOOR,IDIM,NBNN,IPT1.NUM,IB,XE) C C INITIALISATION DES DIVERSES INTEGRATIONS C DO IGAU=1,NBPGAU SOMJAC(IGAU)=0.D0 DO IE1=1,NCOMP SOMCOM(IE1,IGAU)=0.D0 END DO END DO C C ON BOUCLE SUR LES DOUBLONS C DO IDOUBL=1,NDOUBL NLOC4=ILOC4(IDOUBL) ICLE=JCLE C C ON RECUPERE LE NUMERO D'ORDRE DES SOUS ZONES ACCESSIBLES C MELVAL=MELPNI MLNIMO=IELCHE(1,IB) C write(IOIMP,*)' DOUBLON ICLE MLNIMO ',IDOUBL,ICLE,MLNIMO C C CET ELEMENT EST IL EN CONNECTIVITE ? C IF (MLNIMO.NE.0)THEN SEGACT,MLNIMO C C ON RECUPERE LA LISTE DES ELEMENTS ACCESSIBLES DANS C LE CHAMELEM DE CONNECTIVITE C MELVAL=MELPLI MLENTI=IELCHE(1,IB) C C ON CREE UN MLENT1 QUI PERMETTRA DE TROUVER LE DEBUT DE L'INFORMATION C CONCERNANT CHAQUE SS ZONE C JG=1 SEGINI MLENT1 MLENT1.LECT(1)=1 NSOUSA=MLNIMO.LECT(/1) IF (NSOUSA.GT.1)THEN DO IISOUJ=2,NSOUSA JG=MLENT1.LECT(/1)+1 SEGADJ MLENT1 MLENT1.LECT(JG)=MLENT1.LECT(JG-1)+ 1 LECT(MLENT1.LECT(JG-1))+1 END DO ENDIF C C DEBUT DE LA BOUCLE SUR LES PTS D'INTEGRATION C DO IGAU=1,NBPGAU C C ON RECUPERE LA LONGUEUR CARACTERISTIQUE C MELVAL=MELCAR XLONG=VELCHE(MIN(IGAU,VELCHE(/1)),MIN(IB,VELCHE(/2))) C write(IOIMP,*)' GAUSS-P,XLONG ',IGAU,XLONG C C ON CHERCHE LA POSITION ABSOLUE DU POINT D"INTEGRATION C DO IE1=1,3 r_z = 0.D0 DO IE2=1,NBNN r_z=r_z+XE(IE1,IE2)*MINTE1.SHPTOT(1,IE2,IGAU) END DO XXX(IE1)=r_z END DO C write(IOIMP,*)' XXX ',XXX C C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES ACCESSIBLES C DO IISOUJ=1,NSOUSA IISOUS=MLNIMO.LECT(IISOUJ) NLOC3=ILOC3(IISOUS) IPT2=MAILAC(IISOUS) MINTE2=MINTAC(IISOUS) C NBPGAJ=MINTE2.POIGAU(/1) NBNJ =IPT2.NUM(/1) C IG1=MLENT1.LECT(IISOUJ) NBELEJ=LECT(IG1) C write(IOIMP,*)' ZONES-AC,IISOUS ',IISOUJ,IISOUS C C DEBUT DE LA BOUCLE SUR LES ELEMENTS ACCESSIBLES C SEGINI,WRK2 DO IIBJ=1,NBELEJ IG1=IG1+1 IBJ=LECT(IG1) C write(IOIMP,*)' ELEMENT_AC ',IBJ C C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IIBJ C CALL DOXE(XCOOR,IDIM,NBNJ,IPT2.NUM,IBJ,XEJ) C C DEBUT DE LA BOUCLE SUR LES PTS D'INTEGRATION C DO IGAUJ=1,NBPGAJ C C ON CHERCHE LA POSITION ABSOLUE DU POINT D"INTEGRATION C DO IE1=1,3 r_z = 0.D0 DO IE2=1,NBNJ r_z = r_z + XEJ(IE1,IE2) * & MINTE2.SHPTOT(1,IE2,IGAUJ) END DO XXXJ(IE1)=r_z END DO C write(IOIMP,*)' GAUSS-AC ',IGAUJ C write(IOIMP,*)' XXXJ-AS ',XXXJ C C ON TRANSFORME CES COORDONNEES EN FONCTION DES SYMETRIE OU DE LA C TRANSLATION C C+CG CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C MODIFICATIONS POUR LA SYMMETRIE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DO IE1=1,3 PTO(IE1)=0.D0 PTO(IE1)=0.D0 PTO(IE1)=0.D0 END DO DZERO=0.D0 IF(ICLE.EQ.2)CALL TRTRVE(XXXJ,1,PT1 ) IF(ICLE.EQ.3)CALL TRSYPT(XXXJ,1,PT1 ) IF(ICLE.EQ.4)CALL TRSYDR(XXXJ,1,PT1,PT2 ) IF(ICLE.EQ.5)CALL TRSYPL(XXXJ,1,PT1,DISP) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C write(IOIMP,*)' XXXJ-PS ',XXXJ C C ON REMPLIT LES SHP C DO IE1=1,6 DO IE2=1,NBNJ SHP(IE1,IE2)=MINTE2.SHPTOT(IE1,IE2,IGAUJ) END DO END DO C C ON CALCULE LE JACOBIEN C CALL JACOBI(XEJ,SHP,IDIM,NBNJ,DJAC) C C ON CALCULE LA VALEUR DE LA GAUSSIENNE C C C ON DIFFERENCIE ICI SELON LE TYPE DE MOYENNE C C C 1-ER CAS OPTION 'MOYE' C IF(IMNLOC.EQ.1) THEN C XXLONG=(XXX(1)-XXXJ(1))**2+(XXX(2)-XXXJ(2))**2+ 1 (XXX(3)-XXXJ(3))**2 XXLONG=SQRT(XXLONG) C write(IOIMP,*)' XXLONG,DJAC ',XXLONG,DJAC IF(XXLONG.LE.XMULTL*XLONG)THEN GDEX=EXP(-(2*XXLONG/XLONG)**2) DJAC=MINTE2.POIGAU(IGAUJ)*GDEX*ABS(DJAC) DO IE1=1,NCOMP MELVAL=MELVAC(IE1) C C ON DOIT RETROUVER LE NUMERO D'ELEMENT ATTACHE AU CHAMELEM C CORRESPONDANT A CELUI DU MELEME C IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) SOMCOM(IE1,IGAU)=SOMCOM(IE1,IGAU) 1 +VELCHE(IGMN,IBMN)*DJAC C write(IOIMP,*)' VELCHE,DJAC ',VELCHE(IGMN,IBMN),DJAC END DO SOMJAC(IGAU)=SOMJAC(IGAU)+DJAC ENDIF C C ELSE C C 2-EME CAS OPTION 'SB' C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C NONLOCAL BASE SUR L'ETAT DE CONTRAINTE C CG FD C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CHAMP PIC TRACTION FT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MELVAL=MELVAC(14) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) FT1 = VELCHE(IGMN,IBMN) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CHAMP TAILLE MINIMALE ELEMENT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MELVAL=MELVAC(15) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) TAL1 = VELCHE(IGMN,IBMN) TAI1 = TAL1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CONTRAINTE PRINCIPALE I CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MELVAL=MELVAC(2) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COEFI=VELCHE(IGMN,IBMN) COEFIB=FT1*TAI1/XLONG IF(ABS(COEFI).LE.COEFIB) THEN COEFI=COEFIB ENDIF CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C VECTEUR PRINCIPAL I CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MELVAL=MELVAC(5) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COX1=VELCHE(IGMN,IBMN) MELVAL=MELVAC(6) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COY1=VELCHE(IGMN,IBMN) MELVAL=MELVAC(7) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COZ1=VELCHE(IGMN,IBMN) IF(ICLE.EQ.4) THEN XXXV1(1)=COX1 XXXV1(2)=COY1 XXXV1(3)=COZ1 CALL TRSYDR(XXXV1,1,PTO,PT2) COX1=XXXV1(1) COY1=XXXV1(2) COZ1=XXXV1(3) ENDIF IF(ICLE.EQ.5) THEN XXXV1(1)=COX1 XXXV1(2)=COY1 XXXV1(3)=COZ1 CALL TRSYPL(XXXV1,1,PT1,DZERO) COX1=XXXV1(1) COY1=XXXV1(2) COZ1=XXXV1(3) ENDIF CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CONTRAINTE PRINCIPALE II CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MELVAL=MELVAC(3) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COEFJ=VELCHE(IGMN,IBMN) COEFJB=FT1*TAI1/XLONG IF(ABS(COEFJ).LE.COEFJB) THEN COEFJ=COEFJB ENDIF CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C VECTEUR PRINCIPAL II CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MELVAL=MELVAC(8) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COX2=VELCHE(IGMN,IBMN) MELVAL=MELVAC(9) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COY2=VELCHE(IGMN,IBMN) MELVAL=MELVAC(10) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COZ2=VELCHE(IGMN,IBMN) IF(ICLE.EQ.4) THEN XXXV2(1)=COX2 XXXV2(2)=COY2 XXXV2(3)=COZ2 CALL TRSYDR(XXXV2,1,PTO,PT2) COX2=XXXV2(1) COY2=XXXV2(2) COZ2=XXXV2(3) ENDIF IF(ICLE.EQ.5) THEN XXXV2(1)=COX2 XXXV2(2)=COY2 XXXV2(3)=COZ2 CALL TRSYPL(XXXV2,1,PT1,DZERO) COX2=XXXV2(1) COY2=XXXV2(2) COZ2=XXXV2(3) ENDIF CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CONTRAINTE PRINCIPALE III CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MELVAL=MELVAC(4) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COEFK=VELCHE(IGMN,IBMN) COEFKB=FT1*TAI1/XLONG IF(ABS(COEFK).LE.COEFKB) THEN COEFK=COEFKB ENDIF CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C VECTEUR PRINCIPAL III CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC MELVAL=MELVAC(11) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COX3=VELCHE(IGMN,IBMN) MELVAL=MELVAC(12) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COY3=VELCHE(IGMN,IBMN) MELVAL=MELVAC(13) IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) COZ3=VELCHE(IGMN,IBMN) IF(ICLE.EQ.4) THEN XXXV3(1)=COX3 XXXV3(2)=COY3 XXXV3(3)=COZ3 CALL TRSYDR(XXXV3,1,PTO,PT2) COX3=XXXV3(1) COY3=XXXV3(2) COZ3=XXXV3(3) ENDIF IF(ICLE.EQ.5) THEN XXXV3(1)=COX3 XXXV3(2)=COY3 XXXV3(3)=COZ3 CALL TRSYPL(XXXV3,1,PT1,DZERO) COX3=XXXV3(1) COY3=XXXV3(2) COZ3=XXXV3(3) ENDIF CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CALCUL DE L'ANGLE ENTRE U1 ET (X-S)u1u2 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC VEC11=((XXX(2)-XXXJ(2))*COZ3)- 1 ((XXX(3)-XXXJ(3))*COY3) VEC12=((XXX(3)-XXXJ(3))*COX3)- 1 ((XXX(1)-XXXJ(1))*COZ3) VEC13=((XXX(1)-XXXJ(1))*COY3)- 1 ((XXX(2)-XXXJ(2))*COX3) VEC21=(COY3*VEC13)- (COZ3*VEC12) VEC22=(COZ3*VEC11)- (COX3*VEC13) VEC23=(COX3*VEC12)- (COY3*VEC11) N2VEC2=(VEC21**2)+(VEC22**2)+(VEC23**2) NVEC2=SQRT(N2VEC2) CTETA=((COX1*VEC21)+(COY1*VEC22)+(COZ1*VEC23)) 1 /(NVEC2 +10.E-10) STETA=((COX2*VEC21)+(COY2*VEC22)+(COZ2*VEC23)) 1 /(NVEC2 +10.E-10) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CALCUL DE L'ANGLE ENTRE U3 ET (X-S) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC VECPO1=(XXX(1)-XXXJ(1)) VECPO2=(XXX(2)-XXXJ(2)) VECPO3=(XXX(3)-XXXJ(3)) N2VECPO2=(VECPO1**2)+(VECPO2**2)+(VECPO3**2) NVECPO2=SQRT(N2VECPO2) CPHI=((COX3*VECPO1)+(COY3*VECPO2)+(COZ3*VECPO3)) 1 /(NVECPO2 +10.E-10) SPHI=((VECPO1*VEC21)+(VECPO2*VEC22)+ 1 (VECPO3*VEC23))/((NVEC2*NVECPO2) +10.E-10) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CORRECTION POUR PRENDRE EN COMPTE LE CAS OU SEUL SIGMA1 EST NON C NUL CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC XXLONG1=XLONG*COEFI/FT1 XXLONG2=XLONG*COEFJ/FT1 XXLONG3=XLONG*COEFK/FT1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CALCUL DU RAYON D'INTERACTION CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC COEF1=((SPHI**2)*(CTETA**2))/(XXLONG1**2) COEF2=((SPHI**2)*(STETA**2))/(XXLONG2**2) COEF3=(CPHI**2)/(XXLONG3**2) PHOLC=(COEF1+COEF2+COEF3) if (abs(pholc).lt.xpetit) pholc=xpetit PHOLC=(1)/pholc IF(PHOLC.GE.XLONG)THEN PHOLC=XLONG ENDIF C write(IOIMP,*)' XXLONG,DJAC ',XXLONG,DJAC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SELECTION D'UNE ZONE AUTOUR DU POINT DE GAUSS CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IF(NVECPO2.LE.XMULTL*XLONG)THEN GDEX=EXP(-(2*NVECPO2)**2/PHOLC ) DJAC=MINTE2.POIGAU(IGAUJ)*GDEX*ABS(DJAC) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C modif NCOMP DO IE1=1,1 MELVAL=MELVAC(IE1) C C ON DOIT RETROUVER LE NUMERO D'ELEMENT ATTACHE AU CHAMELEM C CORRESPONDANT A CELUI DU MELEME C IBMN=MIN(IBJ ,VELCHE(/2)) IGMN=MIN(IGAUJ,VELCHE(/1)) SOMCOM(IE1,IGAU)=SOMCOM(IE1,IGAU) 1 +VELCHE(IGMN,IBMN)*DJAC C write(IOIMP,*)' VELCHE,DJAC ',VELCHE(IGMN,IBMN),DJAC END DO SOMJAC(IGAU)=SOMJAC(IGAU)+DJAC ENDIF C ENDIF C C C FIN DE LA BOUCLE SUR LES PTS D'INTEGRATION C END DO C C FIN DE LA BOUCLE SUR LES ELEMENTS ACCESSIBLES C END DO C SEGSUP,WRK2 C C FIN DE LA BOUCLE SUR LES DIFFERENTES ZONES ACCESSIBLES C END DO C C FIN DE LA BOUCLE SUR LES PTS D'INTEGRATION C END DO SEGSUP MLENT1 C C FIN DU TEST D'EXISTENCE DE CONNECTIVITE SUR L'ELEMENT C ENDIF C C FIN DE LA BOUCLE SUR LES DOUBLONS C END DO C NLOC3=ILOC3O DO IE1=1,NCOMPE MELVAL=MELVAC(IE1) DO IGAU=1,NBPGAU IF (INODI.EQ.0) THEN VELCHE(IGAU,IB)=SOMCOM(IE1,IGAU)/SOMJAC(IGAU) ELSE VELCHE(IGAU,IB)=SOMCOM(IE1,IGAU) ENDIF END DO END DO C C FIN DE LA BOUCLE SUR LES ELEMENTS C END DO C SEGSUP WRK1,WRK3 C C FIN DE LA BOUCLE SUR LES SOUS ZONES EFFECTIVES C END DO C C DESACTIVATIONS/SUPRESSION C WARNING SUR LES DOUBLONS DE MODEL! C DO IZONEF=1,NZONEF NLOC2=ILOC2(IZONEF) NDOUBL=ILOC4(/1) DO IDOUBL=1,NDOUBL NLOC4=ILOC4(IDOUBL) MELVAL=MELPNI MELVAL=MELPLI SEGSUP,NLOC4 ENDDO NSZACC=ILOC3(/1) DO ISZACC=1,NSZACC NLOC3=ILOC3(ISZACC) SEGSUP,NLOC3 ENDDO NLOC3=ILOC3I NCOMP=MELVAC(/1) SEGSUP,NLOC3 NLOC3=ILOC3O NCOMP=MELVAC(/1) SEGSUP,NLOC3 MMODEL=MODLAC MELEME=MAILEF ENDDO DO IZONEF=1,NZONEF NLOC2=ILOC2(IZONEF) SEGSUP,NLOC2 ENDDO SEGSUP,NLOC1 END