C NOR2D3 SOURCE CB215821 20/11/25 13:34:54 10792 SUBROUTINE NOR2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL, & MLENNE,MLENMI,MPOVCL, & MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2, & SCMB,INDLI, & TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NBCOT, & NSOMM,NBMAX) C C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : NORV2 C C DESCRIPTION : Appelle par NORV1 C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) C C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS C C************************************************************************ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (a-h,o-z) -INC SMLENTI -INC SMELEME -INC SMCHPOI -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMLREEL POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME, & MELTFA.MELEME, MELEP2.MELEME POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL, & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL, & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI, & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI,MLEFA2.MLENTI -INC SMCHAML INTEGER NBNN,NBREF C C**** Variables de COOPTIO C C C**** Variables de COOPTIO C c INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR c & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ c & ,IOPER, IOSGB, IOGRA, IOSAU, IORES c & ,IECHO, IIMPI, IOSPI c & ,IDIM C & ,MCOORD c & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE c & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU c & ,NORINC,NORVAL,NORIND,NORVAD c & ,NUCROU, IPSAUV C**** Variable de SMLENTI, SMCHPOI C INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM C C**** Les includes C INTEGER I1,ICOMP,ICOMGR,IGEOM & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM & ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF & ,NTOT,NSOMM,NCOMP,NFAC,NCEN & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2 & ,NLS1,NLS2,NLFCL & ,ISOUS,IELEM,INOEUD,ICELL INTEGER ICEN2 REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,VALZ,XG,XD,XF,XS1,XS2 & ,YG,YD,YF,YS1,YS2,ZG,ZD,ZF,ZS1,ZS2, & PSCA,XNORM,VECX,VECY,VECZ,PSCAGX,PSCAGY,PSCAGZ, & PSCADX,PSCADY,PSCADZ,K11G,K22G,K21G,K31G,K32G,K33G, & K11D,K22D,K21D,K31D,K32D,K33D,VXG1,VXG2, & VXAU,VYAU,VZAU,VXD1,VXD2,VYG1,VYG2,VYD1,VYD2,VZG1, & VZG2,VZD1,VZD2,TRG1,TRG2, & TRD1,TRD2,TRG,TRD REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2, & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,VZ, & COEF1X,COEF2X,COEF1Y,COEF2Y,COEF1Z,COEF2Z, & CX,CY,CZ,ANCX,ANCY,ANCZ,DIFFX,DIFFY,DIFFZ,XLONGG,XLONGD, & VALD,VALG,COEF,GX,GY,GZ,XMINK11,XMAXK11,XMINK22,XMAXK22, & QIMPX,QIMPY,QIMPZ,QIMPS,XLAMBDA1,XLAMBDA2 c REAL*8 VECXG1(3),VECYG1(3) c REAL*8 VECXG2(3),VECYG2(3) c REAL*8 VECXD1(3),VECYD1(3) c REAL*8 VECXD2(3),VECYD2(3) REAL*8 VECXG(4,4),VECYG(4,4),VECZG(4,4) REAL*8 VECXD(4,4),VECYD(4,4),VECZD(4,4) REAL*8 VOLUG(4),SURFAGX(4),SURFAGY(4),SURFAGZ(4),COEFG(4,4) REAL*8 VOLUD(4),SURFADX(4),SURFADY(4),SURFADZ(4),COEFD(4,4) INTEGER NGS(4),NLS(4),XS(4),YS(4),ZS(4) INTEGER NLOCFG(4,4),NLOCFD(4,4) REAL*8 EPS INTEGER ICRIT CHARACTER*8 TYPE C CHARACTER*(4) NOMCOM(18) C DATA NOMCOM /'P1DX','P1DY', C & 'P2DX','P2DY', C & 'P3DX','P3DY', C & 'P4DX','P4DY', C & 'P5DX','P5DY', C & 'P6DX','P6DY', C & 'P7DX','P7DY', C & 'P8DX','P8DY', C & 'P9DX','P9DY'/ INTEGER NDIM SEGMENT MMAT1 REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM) INTEGER IC(NDIM) ENDSEGMENT INTEGER K1,K2 SEGMENT INDICE INTEGER NUME(K1,K2) ENDSEGMENT POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE SEGMENT MATRICE REAL*8 MAT(K1,K2) ENDSEGMENT POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE INTEGER K3 SEGMENT POINT2 INTEGER POINT(K3) ENDSEGMENT POINTEUR IPO2.POINT2 SEGMENT MATRICE2 REAL*8 MAT2(K1,K2) ENDSEGMENT POINTEUR MATR1.MATRICE2,MATR2.MATRICE2 SEGMENT REP INTEGER ID(K3) ENDSEGMENT POINTEUR TAB.REP,INDLI.REP INTEGER K5 SEGMENT NBFAC INTEGER NBFACEL(K5) INTEGER IMELEM(K5) ENDSEGMENT INTEGER K6 SEGMENT NBCOT INTEGER NBCOTE(K6) INTEGER IMECOTE(K6) ENDSEGMENT c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS c SOUS DOMAINE MAUX = MELTFA MAUX2 = MELEFP NMAI1 = 0 NMAI2 = 0 NMAI3 = 0 C NMAI4 = 0 C Initialisation sinon NAN... DO II=1,4 SURFAGX(II)=0.D0 SURFAGY(II)=0.D0 SURFAGZ(II)=0.D0 SURFADX(II)=0.D0 SURFADY(II)=0.D0 SURFADZ(II)=0.D0 ENDDO NBSO = MAX(1,MELTFA.LISOUS(/1)) c WRITE(6,*) 'NBSO MAILLE= ',NBSO c WRITE(6,*) 'MELTFA= ',MELTFA IF (NBSO.EQ.1) THEN K5 = MELTFA.NUM(/2) ELSEIF (NBSO.EQ.2) THEN IPT1 = MELTFA.LISOUS(1) SEGACT IPT1 N1 = IPT1.NUM(/2) NMAI1 = N1 SEGDES IPT1 IPT2 = MELTFA.LISOUS(2) SEGACT IPT2 N2 = IPT2.NUM(/2) NMAI2 = N2 SEGDES IPT2 K5 = N1 + N2 ELSEIF (NBSO.EQ.3) THEN IPT1 = MELTFA.LISOUS(1) SEGACT IPT1 N1 = IPT1.NUM(/2) NMAI1 = N1 SEGDES IPT1 IPT2 = MELTFA.LISOUS(2) SEGACT IPT2 N2 = IPT2.NUM(/2) NMAI2 = N2 SEGDES IPT2 IPT3 = MELTFA.LISOUS(3) SEGACT IPT3 N3 = IPT3.NUM(/2) NMAI3 = N3 SEGDES IPT3 K5 = N1 + N2 + N3 ELSEIF (NBSO.EQ.4) THEN IPT1 = MELTFA.LISOUS(1) SEGACT IPT1 N1 = IPT1.NUM(/2) NMAI1 = N1 SEGDES IPT1 IPT2 = MELTFA.LISOUS(2) SEGACT IPT2 N2 = IPT2.NUM(/2) NMAI2 = N2 SEGDES IPT2 IPT3 = MELTFA.LISOUS(3) SEGACT IPT3 N3 = IPT3.NUM(/2) NMAI3 = N3 SEGDES IPT3 IPT4 = MELTFA.LISOUS(4) SEGACT IPT4 N4 = IPT4.NUM(/2) C NMAI4 = N4 SEGDES IPT4 K5 = N1 + N2 + N3 + N4 ENDIF c WRITE(6,*) 'K5= ',K5 IF (NBSO.EQ.1) THEN DO I = 1,K5 NTYPE = MELTFA.ITYPEL c WRITE(6,*) 'NTYPE= ',NTYPE IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = MELTFA ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = MELTFA ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = MELTFA ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = MELTFA ENDIF c SEGDES MELTFA ENDDO ELSEIF (NBSO.EQ.2) THEN IPT1 = MELTFA.LISOUS(1) SEGACT IPT1 IPT2 = MELTFA.LISOUS(2) SEGACT IPT2 DO I = 1,K5 N1 = IPT1.NUM(/2) IF (I.LE.N1) THEN NTYPE = IPT1.ITYPEL IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = IPT1 ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = IPT1 ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = IPT1 ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = IPT1 ENDIF ELSE NTYPE = IPT2.ITYPEL IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = IPT2 ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = IPT2 ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = IPT2 ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = IPT2 ENDIF ENDIF ENDDO ELSEIF (NBSO.EQ.3) THEN IPT1 = MELTFA.LISOUS(1) SEGACT IPT1 NTYPE = IPT1.ITYPEL c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL IPT2 = MELTFA.LISOUS(2) SEGACT IPT2 NTYPE = IPT2.ITYPEL c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL IPT3 = MELTFA.LISOUS(3) SEGACT IPT3 NTYPE = IPT3.ITYPEL c WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL N1 = IPT1.NUM(/2) N2 = IPT2.NUM(/2) N3 = IPT3.NUM(/2) DO I = 1,K5 IF (I.LE.N1) THEN NTYPE = IPT1.ITYPEL IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = IPT1 ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = IPT1 ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = IPT1 ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = IPT1 ENDIF ELSEIF (I.LE.(N1+N2)) THEN NTYPE = IPT2.ITYPEL IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = IPT2 ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = IPT2 ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = IPT2 ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = IPT2 ENDIF ELSE NTYPE = IPT3.ITYPEL IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = IPT3 ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = IPT3 ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = IPT3 ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = IPT3 ENDIF ENDIF ENDDO ELSEIF (NBSO.EQ.4) THEN IPT1 = MELTFA.LISOUS(1) SEGACT IPT1 NTYPE = IPT1.ITYPEL c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL IPT2 = MELTFA.LISOUS(2) SEGACT IPT2 NTYPE = IPT2.ITYPEL c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL IPT3 = MELTFA.LISOUS(3) SEGACT IPT3 NTYPE = IPT3.ITYPEL c WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL IPT4 = MELTFA.LISOUS(4) SEGACT IPT4 NTYPE = IPT4.ITYPEL c WRITE(6,*) 'NTYPE= ',IPT4.ITYPEL N1 = IPT1.NUM(/2) N2 = IPT2.NUM(/2) N3 = IPT3.NUM(/2) N4 = IPT4.NUM(/2) DO I = 1,K5 IF (I.LE.N1) THEN NTYPE = IPT1.ITYPEL IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = IPT1 ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = IPT1 ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = IPT1 ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = IPT1 ENDIF ELSEIF (I.LE.(N1+N2)) THEN NTYPE = IPT2.ITYPEL IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = IPT2 ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = IPT2 ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = IPT2 ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = IPT2 ENDIF ELSEIF (I.LE.(N1+N2+N3)) THEN NTYPE = IPT3.ITYPEL IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = IPT3 ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = IPT3 ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = IPT3 ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = IPT3 ENDIF ELSE NTYPE = IPT4.ITYPEL IF (NTYPE .EQ. 16) THEN NBFACEL(I) = 6 IMELEM(I) = IPT4 ELSEIF (NTYPE .EQ. 25) THEN NBFACEL(I) = 5 IMELEM(I) = IPT4 ELSEIF (NTYPE .EQ. 23) THEN NBFACEL(I) = 4 IMELEM(I) = IPT4 ELSEIF (NTYPE .EQ. 9) THEN NBFACEL(I) = 5 IMELEM(I) = IPT4 ENDIF ENDIF ENDDO ENDIF C ON EST ICI CORRIGER K5 MLEFA2 = MLEFA CALL KRIPAD(MELEFA,MLEFA2) c CAS OU LES FACES SONT DES TRIANGLES OU DES FACES NFAI1 = 0 NBSOF = MAX(1,MELEFP.LISOUS(/1)) c WRITE(6,*) 'NBSO FACE= ',NBSOF IF (NBSOF.EQ.1) THEN K6 = MELEFP.NUM(/2) ELSEIF (NBSOF.EQ.2) THEN IPT5 = MELEFP.LISOUS(1) SEGACT IPT5 N1 = IPT5.NUM(/2) NFAI1 = N1 SEGDES IPT5 IPT6 = MELEFP.LISOUS(2) SEGACT IPT6 N2 = IPT6.NUM(/2) C NFAI2 = N2 SEGDES IPT6 K6 = N1 + N2 ENDIF c WRITE(6,*) 'K6= ',K6 SEGINI NBCOT c WRITE(6,*) 'POINT1' C ON EST ICI IF (NBSOF.EQ.1) THEN DO I = 1,K6 NTYPE = MELEFP.ITYPEL c WRITE(6,*) 'NTYPE= ',NTYPE IF (NTYPE .EQ. 5) THEN NBCOTE(I) = 3 IMECOTE(I) = MELEFP ELSE NBCOTE(I) = 4 IMECOTE(I) = MELEFP ENDIF c SEGDES MELTFA ENDDO ELSEIF (NBSOF.EQ.2) THEN c WRITE(6,*) 'POINT2' IPT5 = MELEFP.LISOUS(1) SEGACT IPT5 IPT6 = MELEFP.LISOUS(2) SEGACT IPT6 c WRITE(6,*) 'IPT5= ',IPT5.ITYPEL c WRITE(6,*) 'IPT6= ',IPT6.ITYPEL DO I = 1,K6 N1 = IPT5.NUM(/2) C MISE A JOUR DE MLEFA.LECT IF (I.LE.N1) THEN N0 = IPT5.NUM(/1) NGFAUX = IPT5.NUM(N0,I) MLEFA2.LECT(NGFAUX) = I c WRITE(6,*) 'NGFAUX = ',NGFAUX, c & 'MLEFA2=',MLEFA2.LECT(NGFAUX) IF (IPT5.ITYPEL .EQ. 5) THEN NBCOTE(I) = 3 IMECOTE(I) = IPT5 ELSE NBCOTE(I) = 4 IMECOTE(I) = IPT5 ENDIF c SEGDES IPT5 ELSE N0 = IPT6.NUM(/1) NGFAUX = IPT6.NUM(N0,I-NFAI1) MLEFA2.LECT(NGFAUX) = I c WRITE(6,*) 'NGFAUX = ',NGFAUX, c & 'MLEFA2=',MLEFA2.LECT(NGFAUX) IF (IPT6.ITYPEL .EQ. 5) THEN NBCOTE(I) = 3 IMECOTE(I) = IPT6 ELSE NBCOTE(I) = 4 IMECOTE(I) = IPT6 ENDIF c SEGDES IPT6 ENDIF c WRITE(6,*) 'I= ',I c WRITE(6,*) 'NBCOTE= ',NBCOTE(I) c WRITE(6,*) 'IMECOTE= ',IMECOTE(I) ENDDO ENDIF C IL FAUDRA EGALEMENT CREER DES POINTEUR POUR LES FACES DE CHAQUE ELEMENT C EXEMPLE LES PRISMES C SEGMENT SERVANT A UN PRECALCUL DE NBMAX c WRITE(6,*) 'NSOMM= ',NSOMM K3 = NSOMM SEGINI INDLI SEGINI TAB DO I = 1,K3 INDLI.ID(I) = 0 TAB.ID(I) = 0 ENDDO NFAC=MELEFL.NUM(/2) NBMAX = 0 C PRECALCUL DE NBMAX DO NLCF= 1, NFAC, 1 c WRITE(6,*) 'NLCF= ',NLCF NGCF=MELEFL.NUM(2,NLCF) NGCG=MELEFL.NUM(1,NLCF) NGCD=MELEFL.NUM(3,NLCF) NLCG=MLECEN.LECT(NGCG) NLCD=MLECEN.LECT(NGCD) c NFAUX = MELEFA.NUM(NLCF,1) c WRITE(6,*) 'NFAUX= ',NFAUX c c NGFAUX = MELEFA.NUM(NLCF,1) c WRITE(6,*) 'NGFAUX = ',NGFAUX, c & 'MLEFA2=',MLEFA2.LECT(NGFAUX) c NBNO = MELEFP.NUM(/1) - 1 NBNO = NBCOTE(NLCF) c WRITE(6,*) 'NLCF= ',NLCF c WRITE(6,*) 'NBNO= ',NBNO MELEFP = IMECOTE(NLCF) IF (NLCF.GT.NFAI1) THEN NLCFAUX = NLCF - NFAI1 ELSE NLCFAUX = NLCF ENDIF DO IA = 1,NBNO NGS1=MELEFP.NUM(IA,NLCFAUX) NLS1=MLESOM.LECT(NGS1) NLS1=MLESOM.LECT(NGS1) INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1 NBMAX = MAX(NBMAX,INDLI.ID(NLS1)) ENDDO ENDDO SEGSUP INDLI SEGSUP TAB c NBMAX = 6 NBMAX = NBMAX +1 c WRITE(6,*) 'DANS NORV1 NBMAX= ',NBMAX c WRITE(6,*) 'NBSOM= ',NSOMM C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL c INITIALISATION DES MATRICES c NBMAX = 10 K3 = NSOMM SEGINI INDLI SEGINI TAB DO I = 1,K3 INDLI.ID(I) = 0 TAB.ID(I) = 0 ENDDO K1 = NBMAX K2 = NSOMM SEGINI IND2 SEGINI IND SEGINI IND22 SEGINI VAL1 SEGINI VAL2 SEGINI SCMB * K1 = NBMAX * K2 = (NBMAX+1) C INITIALISATION DU POINTEUR MATRICE2 K3 = NSOMM SEGINI IPO2 DO I = 1,K3 K1 = NBMAX K2 = NBMAX + 1 SEGINI MATR1 IPO2.POINT(I) = MATR1 SEGDES MATR1 ENDDO c DO I = 1,K3 c MATR1 = IPO2.POINT(I) c SEGACT MATR1 *MOD c MATR1.MAT2(1,1) = 4.D0 c MATR1.MAT2(2,2) = 3.D0 c WRITE(6,*) 'MATR1=', MATR1.MAT2(1,1) c WRITE(6,*) 'MATR1=', MATR1.MAT2(2,2) c SEGDES MATR1 c ENDDO NFAC=MELEFL.NUM(/2) c WRITE(6,*) 'NFAC= ',NFAC NAUX1 = 0 DO NLCF= 1, NFAC, 1 C INDICE = 0 c ON TIENT COMPTE DU CHANGEMENT DE NUMEROTATION NGCF=MELEFL.NUM(2,NLCF) NGCG=MELEFL.NUM(1,NLCF) NGCD=MELEFL.NUM(3,NLCF) NLCG=MLECEN.LECT(NGCG) NLCD=MLECEN.LECT(NGCD) SCNX=MPONOR.VPOCHA(NLCF,1) SCNY=MPONOR.VPOCHA(NLCF,2) SCNZ=MPONOR.VPOCHA(NLCF,3) SCN1X = SCNX SCN1Y = SCNY SCN1Z = SCNZ C 4=IDIM+1 ICELL=(4*(NGCG -1))+1 XG=MCOORD.XCOOR(ICELL) YG=MCOORD.XCOOR(ICELL+1) ZG=MCOORD.XCOOR(ICELL+2) ICELL=(4*(NGCD -1))+1 XD=MCOORD.XCOOR(ICELL) YD=MCOORD.XCOOR(ICELL+1) ZD=MCOORD.XCOOR(ICELL+2) ICELL=(4*(NGCF -1))+1 XF=MCOORD.XCOOR(ICELL) YF=MCOORD.XCOOR(ICELL+1) ZF=MCOORD.XCOOR(ICELL+2) C MISE A ZERO DE NLOC DO JA=1,4 DO IA=1,3 NLOCFG(IA,JA) = 0 NLOCFD(IA,JA) = 0 ENDDO ENDDO MELTFA = IMELEM(NLCG) NBF = NBFACEL(NLCG) IF (NLCG.LE.NMAI1) THEN NGAUX = NLCG ELSEIF ((NLCG.GT.NMAI1).AND.(NLCG.LE.(NMAI1+NMAI2))) THEN NGAUX = NLCG - NMAI1 ELSEIF ((NLCG.GT.(NMAI1+NMAI2)).AND. & (NLCG.LE.(NMAI1+NMAI2+NMAI3))) THEN NGAUX = NLCG - (NMAI1+NMAI2) ELSEIF (NLCG.GT.(NMAI1+NMAI2+NMAI3)) THEN NGAUX = NLCG - (NMAI1+NMAI2+NMAI3) ENDIF c WRITE(6,*) 'NLCG= ',NLCG c WRITE(6,*) 'NBF= ',NBF c WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL c WRITE(6,*) 'MELTFA= ',MELTFA c WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1) c WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2) c WRITE(6,*) 'NGAUX ',MELTFA.NUM(/2) c SEGACT MELTFA C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE NLCF1 = MLEFA2.LECT(NGCF) NBNO = NBCOTE(NLCF1) MELEFP = IMECOTE(NLCF1) IF (NLCF1.GT.NFAI1) THEN NLCF1AUX = NLCF1 - NFAI1 ELSE NLCF1AUX = NLCF1 ENDIF DO JA = 1,NBNO NGS(JA) = MELEFP.NUM(JA,NLCF1AUX) c IF (NLCF.EQ.14) then c WRITE(6,*) 'NGAUX= ',NGAUX,'JA= ',JA,'NGS= ',NGS(JA) c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF c ENDIF ICOUR = 0 DO J = 1,NBF N1 = MELTFA.NUM(J,NGAUX) NL1 = MLEFA2.LECT(N1) NBNO2 = NBCOTE(NL1) MELEP2 = IMECOTE(NL1) IF (NL1.GT.NFAI1) THEN NL1AUX = NL1 - NFAI1 ELSE NL1AUX = NL1 ENDIF c IF (NLCF.EQ.14) then c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1,'NL1AUX= ',NL1AUX c ENDIF DO IA =1,NBNO2 NSOM1 = MELEP2.NUM(IA,NL1AUX) c IF (NLCF.EQ.14) then c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1 c ENDIF IF (NSOM1.EQ.NGS(JA)) THEN ICELL=(4*(N1 -1))+1 XF=MCOORD.XCOOR(ICELL) YF=MCOORD.XCOOR(ICELL+1) ZF=MCOORD.XCOOR(ICELL+2) ICOUR = ICOUR + 1 VECXG(ICOUR,JA) = (XF - XG) VECYG(ICOUR,JA) = (YF - YG) VECZG(ICOUR,JA) = (ZF - ZG) NLOCFG(ICOUR,JA) = N1 C ON PERMUTE C ICI IF (N1.EQ.NGCF) THEN NAUX = NLOCFG(1,JA) VXAU = VECXG(1,JA) VYAU = VECYG(1,JA) VZAU = VECZG(1,JA) VECXG(1,JA) = (XF - XG) VECYG(1,JA) = (YF - YG) VECZG(1,JA) = (ZF - ZG) NLOCFG(1,JA) = N1 VECXG(ICOUR,JA) = VXAU VECYG(ICOUR,JA) = VYAU VECZG(ICOUR,JA) = VZAU NLOCFG(ICOUR,JA) = NAUX ENDIF ENDIF ENDDO ENDDO c IF (NLCF.EQ.14) THEN c WRITE(6,*) 'JA= ',JA c WRITE(6,*) 'ICOUR= ',ICOUR c ENDIF ENDDO MELTFA = IMELEM(NLCD) NBF = NBFACEL(NLCD) c WRITE(6,*) 'NLCD= ',NLCD c WRITE(6,*) 'NBF= ',NBF c WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL IF (NLCD.LE.NMAI1) THEN NDAUX = NLCD ELSEIF ((NLCD.GT.NMAI1).AND.(NLCD.LE.(NMAI1+NMAI2))) THEN NDAUX = NLCD - NMAI1 ELSEIF ((NLCD.GT.(NMAI1+NMAI2)).AND. & (NLCD.LE.(NMAI1+NMAI2+NMAI3))) THEN NDAUX = NLCD - (NMAI1+NMAI2) ELSEIF (NLCD.GT.(NMAI1+NMAI2+NMAI3)) THEN NDAUX = NLCD - (NMAI1+NMAI2+NMAI3) ENDIF C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE DO JA = 1,NBNO NGS(JA) = MELEFP.NUM(JA,NLCF1AUX) c WRITE(6,*) 'NDAUX= ',NDAUX,'JA= ',JA,'NGS= ',NGS(JA) c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF ICOUR = 0 DO J = 1,NBF N1 = MELTFA.NUM(J,NDAUX) NL1 = MLEFA2.LECT(N1) c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1 NBNO2 = NBCOTE(NL1) MELEP2 = IMECOTE(NL1) IF (NL1.GT.NFAI1) THEN NL1AUX = NL1 - NFAI1 ELSE NL1AUX = NL1 ENDIF DO IA =1,NBNO2 NSOM1 = MELEP2.NUM(IA,NL1AUX) c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1 IF (NSOM1.EQ.NGS(JA)) THEN ICELL=(4*(N1 -1))+1 XF=MCOORD.XCOOR(ICELL) YF=MCOORD.XCOOR(ICELL+1) ZF=MCOORD.XCOOR(ICELL+2) ICOUR = ICOUR + 1 VECXD(ICOUR,JA) = (XF - XD) VECYD(ICOUR,JA) = (YF - YD) VECZD(ICOUR,JA) = (ZF - ZD) NLOCFD(ICOUR,JA) = N1 C ON PERMUTE IF (N1.EQ.NGCF) THEN NAUX = NLOCFD(1,JA) VXAU = VECXD(1,JA) VYAU = VECYD(1,JA) VZAU = VECZD(1,JA) VECXD(1,JA) = (XF - XD) VECYD(1,JA) = (YF - YD) VECZD(1,JA) = (ZF - ZD) NLOCFD(1,JA) = N1 VECXD(ICOUR,JA) = VXAU VECYD(ICOUR,JA) = VYAU VECZD(ICOUR,JA) = VZAU NLOCFD(ICOUR,JA) = NAUX ENDIF ENDIF ENDDO ENDDO c WRITE(6,*) 'JA= ',JA c WRITE(6,*) 'ICOUR= ',ICOUR ENDDO CALCUL DES VOLUMES c DO JA = 1,NBNO c DO KA=1,ICOUR c WRITE(6,*)'JA= ',JA,'KA= ',KA c WRITE(6,*) 'VECG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA) c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA) c ENDDO c ENDDO DO JA = 1,NBNO DO KA = 1,ICOUR C PRODUIT MIXTES C PRODUIT VECTORIEL IF (KA.EQ.1) THEN PSCAGX = (VECYG(2,JA)*VECZG(3,JA)) - & (VECZG(2,JA)*VECYG(3,JA)) PSCAGY = (VECZG(2,JA)*VECXG(3,JA)) - & (VECXG(2,JA)*VECZG(3,JA)) PSCAGZ = (VECXG(2,JA)*VECYG(3,JA)) - & (VECYG(2,JA)*VECXG(3,JA)) VOLUG(JA) = (VECXG(1,JA)* PSCAGX) + & (VECYG(1,JA)* PSCAGY) + & (VECZG(1,JA)* PSCAGZ) SURFAGX(KA) = 0.5D0* PSCAGX SURFAGY(KA) = 0.5D0* PSCAGY SURFAGZ(KA) = 0.5D0* PSCAGZ IF ( VOLUG(JA).GT.0) THEN SURFAGX(KA) = - SURFAGX(KA) SURFAGY(KA) = - SURFAGY(KA) SURFAGZ(KA) = - SURFAGZ(KA) ENDIF VOLUG(JA) = 1.D0/6.D0*ABS(VOLUG(JA)) ENDIF IF (KA.EQ.2) THEN PSCAGX = (VECYG(3,JA)*VECZG(1,JA)) - & (VECZG(3,JA)*VECYG(1,JA)) PSCAGY = (VECZG(3,JA)*VECXG(1,JA)) - & (VECXG(3,JA)*VECZG(1,JA)) PSCAGZ = (VECXG(3,JA)*VECYG(1,JA)) - & (VECYG(3,JA)*VECXG(1,JA)) SURFAGX(KA) = 0.5D0* PSCAGX SURFAGY(KA) = 0.5D0* PSCAGY SURFAGY(KA) = 0.5D0* PSCAGY SURFAGZ(KA) = 0.5D0* PSCAGZ PSCA = (VECXG(2,JA)* PSCAGX) + (VECYG(2,JA)* PSCAGY) + & (VECZG(2,JA)* PSCAGZ) IF ( PSCA.GT.0) THEN SURFAGX(KA) = - SURFAGX(KA) SURFAGY(KA) = - SURFAGY(KA) SURFAGZ(KA) = - SURFAGZ(KA) ENDIF ENDIF IF (KA.EQ.3) THEN PSCAGX = (VECYG(1,JA)*VECZG(2,JA)) - & (VECZG(1,JA)*VECYG(2,JA)) PSCAGY = (VECZG(1,JA)*VECXG(2,JA)) - & (VECXG(1,JA)*VECZG(2,JA)) PSCAGZ = (VECXG(1,JA)*VECYG(2,JA)) - & (VECYG(1,JA)*VECXG(2,JA)) SURFAGX(KA) = 0.5D0* PSCAGX SURFAGY(KA) = 0.5D0* PSCAGY SURFAGZ(KA) = 0.5D0* PSCAGZ PSCA = (VECXG(3,JA)* PSCAGX) + (VECYG(3,JA)* PSCAGY) + & (VECZG(3,JA)* PSCAGZ) IF ( PSCA.GT.0) THEN SURFAGX(KA) = - SURFAGX(KA) SURFAGY(KA) = - SURFAGY(KA) SURFAGZ(KA) = - SURFAGZ(KA) ENDIF ENDIF c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1 IF (ICHTE.EQ.0) THEN COEFG(KA,JA) = ( (SURFAGX(KA)*SCN1X) + (SURFAGY(KA)*SCN1Y) + & (SURFAGZ(KA)*SCN1Z)) & / (3.D0*VOLUG(JA)) ELSE C TENSEUR IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN K11G = MPOTEN.VPOCHA(NLCG,1) K22G = MPOTEN.VPOCHA(NLCG,2) K33G = MPOTEN.VPOCHA(NLCG,3) K21G = MPOTEN.VPOCHA(NLCG,4) K31G = MPOTEN.VPOCHA(NLCG,5) K32G = MPOTEN.VPOCHA(NLCG,6) ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN K11G = MPOTEN.VPOCHA(NLCG,1) K22G = K11G K33G = K11G K21G = 0.0D0 K31G = 0.0D0 K32G = 0.0D0 ELSE WRITE(6,*) 'TENSEUR NON PREVU' STOP ENDIF PSCAGX = (K11G*SURFAGX(KA)) + (K21G*SURFAGY(KA)) + & (K31G*SURFAGZ(KA)) PSCAGY = (K21G*SURFAGX(KA)) + (K22G*SURFAGY(KA)) + & (K32G*SURFAGZ(KA)) PSCAGZ = (K31G*SURFAGX(KA)) + (K32G*SURFAGY(KA)) + & (K33G*SURFAGZ(KA)) COEFG(KA,JA) = (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) + & (PSCAGZ*SCN1Z) COEFG(KA,JA) = COEFG(KA,JA) / (3.D0*VOLUG(JA)) ENDIF c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA) c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA) c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA) c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z ENDDO c WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA) c WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA) c WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA) c WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA) c WRITE(6,*)'NLCF= ',NLCF,'COEFG = ', c & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA) c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z c WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1) c WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2) c WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3) ENDDO CALCUL DES VOLUMES DO JA = 1,NBNO NGS(JA) = MELEFP.NUM(JA,NLCF1AUX) NLS(JA)=MLESOM.LECT(NGS(JA)) DO KA = 1,ICOUR C PRODUIT MIXTES C PRODUIT VECTORIEL IF (KA.EQ.1) THEN PSCADX = (VECYD(2,JA)*VECZD(3,JA)) - & (VECZD(2,JA)*VECYD(3,JA)) PSCADY = (VECZD(2,JA)*VECXD(3,JA)) - & (VECXD(2,JA)*VECZD(3,JA)) PSCADZ = (VECXD(2,JA)*VECYD(3,JA)) - & (VECYD(2,JA)*VECXD(3,JA)) VOLUD(JA) = (VECXD(1,JA)* PSCADX) + & (VECYD(1,JA)* PSCADY) + & (VECZD(1,JA)* PSCADZ) SURFADX(KA) = 0.5D0* PSCADX SURFADY(KA) = 0.5D0* PSCADY SURFADZ(KA) = 0.5D0* PSCADZ IF ( VOLUD(JA).GT.0) THEN SURFADX(KA) = - SURFADX(KA) SURFADY(KA) = - SURFADY(KA) SURFADZ(KA) = - SURFADZ(KA) ENDIF VOLUD(JA) = 1.D0/6.D0*ABS(VOLUD(JA)) ENDIF IF (KA.EQ.2) THEN PSCADX = (VECYD(3,JA)*VECZD(1,JA)) - & (VECZD(3,JA)*VECYD(1,JA)) PSCADY = (VECZD(3,JA)*VECXD(1,JA)) - & (VECXD(3,JA)*VECZD(1,JA)) PSCADZ = (VECXD(3,JA)*VECYD(1,JA)) - & (VECYD(3,JA)*VECXD(1,JA)) SURFADX(KA) = 0.5D0* PSCADX SURFADY(KA) = 0.5D0* PSCADY SURFADY(KA) = 0.5D0* PSCADY SURFADZ(KA) = 0.5D0* PSCADZ PSCA = (VECXD(2,JA)* PSCADX) + (VECYD(2,JA)* PSCADY) + & (VECZD(2,JA)* PSCADZ) IF ( PSCA.GT.0) THEN SURFADX(KA) = - SURFADX(KA) SURFADY(KA) = - SURFADY(KA) SURFADZ(KA) = - SURFADZ(KA) ENDIF ENDIF IF (KA.EQ.3) THEN PSCADX = (VECYD(1,JA)*VECZD(2,JA)) - & (VECZD(1,JA)*VECYD(2,JA)) PSCADY = (VECZD(1,JA)*VECXD(2,JA)) - & (VECXD(1,JA)*VECZD(2,JA)) PSCADZ = (VECXD(1,JA)*VECYD(2,JA)) - & (VECYD(1,JA)*VECXD(2,JA)) SURFADX(KA) = 0.5D0* PSCADX SURFADY(KA) = 0.5D0* PSCADY SURFADZ(KA) = 0.5D0* PSCADZ PSCA = (VECXD(3,JA)* PSCADX) + (VECYD(3,JA)* PSCADY) + & (VECZD(3,JA)* PSCADZ) IF ( PSCA.GT.0) THEN SURFADX(KA) = - SURFADX(KA) SURFADY(KA) = - SURFADY(KA) SURFADZ(KA) = - SURFADZ(KA) ENDIF ENDIF c WRITE(6,*) 'NLCF=',NLCF c WRITE(6,*) 'NLCD=',NLCD c WRITE(6,*) 'NLCG=',NLCG c WRite(6,*) 'AG1=',AG1 c WRite(6,*) 'AG2=',AG2 c WRite(6,*) 'AD1=',AD1 c WRite(6,*) 'AD2=',AD2 c WRite(6,*) 'PSCAG1=',PSCAG1 c WRite(6,*) 'PSCAG2=',PSCAG2 c WRite(6,*) 'PSCAD1=',PSCAD1 c WRite(6,*) 'PSCAD2=',PSCAD2 c WRite(6,*) 'COEF1D=',COEF1D c WRite(6,*) 'COEF2D=',COEF2D c WRite(6,*) 'BETA1GD=',BETA1GD c WRite(6,*) 'BETA2GD=',BETA2GD c WRite(6,*) 'INDD2=',INDD2 c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1 IF (ICHTE.EQ.0) THEN COEFD(KA,JA) = ( (SURFADX(KA)*SCN1X) + (SURFADY(KA)*SCN1Y) + & (SURFADZ(KA)*SCN1Z)) & / (3.D0*VOLUD(JA)) ELSE C TENSEUR IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN K11D = MPOTEN.VPOCHA(NLCD,1) K22D = MPOTEN.VPOCHA(NLCD,2) K33D = MPOTEN.VPOCHA(NLCD,3) K21D = MPOTEN.VPOCHA(NLCD,4) K31D = MPOTEN.VPOCHA(NLCD,5) K32D = MPOTEN.VPOCHA(NLCD,6) ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN K11D = MPOTEN.VPOCHA(NLCD,1) K22D = K11D K33D = K11D K21D = 0.0D0 K31D = 0.0D0 K32D = 0.0D0 ELSE WRITE(6,*) 'TENSEUR NON PREVU' STOP ENDIF PSCADX = (K11D*SURFADX(KA)) + (K21D*SURFADY(KA)) + & (K31D*SURFADZ(KA)) PSCADY = (K21D*SURFADX(KA)) + (K22D*SURFADY(KA)) + & (K32D*SURFADZ(KA)) PSCADZ = (K31D*SURFADX(KA)) + (K32D*SURFADY(KA)) + & (K33D*SURFADZ(KA)) COEFD(KA,JA) = (PSCADX*SCN1X) + (PSCADY*SCN1Y) & + (PSCADZ*SCN1Z) COEFD(KA,JA) = COEFD(KA,JA) / (3.D0*VOLUD(JA)) ENDIF c WRITE(6,*) 'JA = ',JA,'KA= ',KA,'VOLUD(JA) = ',VOLUD(JA) c WRITE(6,*)'SURFAD = ',SURFADX(KA),SURFADY(KA),SURFADZ(KA) c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA) ENDDO c WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA) c WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA) c WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA) c WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA) c WRITE(6,*)'NLCF= ',NLCF,'COEFD = ', c & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA) c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z c WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1) c WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2) c WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3) ENDDO CALCUL DES VOLUMES c WRITE(6,*) 'NLCF= ',NLCF c WRITE(6,*) 'NGCF= ',NGCF c WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G c WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D DO JA = 1,NBNO C XX1 = ABS(COEFG(1,JA)) C XX2 = ABS(COEFD(1,JA)) C IF ((XX1.LT.1e-8) .OR.(XX2.LT.1E-8)) THEN C INDICE = 1 C ENDIF MARQ = 0 DO I5 = 1,INDLI.ID(NLS(JA)) INDAUX = IND2.NUME(I5,NLS(JA)) IF (INDAUX.EQ.NGCF) THEN MARQ = 1 IAFF = I5 GOTO 4 ENDIF ENDDO 4 CONTINUE IF (MARQ.EQ.0) THEN INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 ICOU = INDLI.ID(NLS(JA)) IND2.NUME(ICOU,NLS(JA)) = NGCF ELSE ICOU = IAFF ENDIF COEF = COEFG(1,JA)-COEFD(1,JA) MATR1 = IPO2.POINT(NLS(JA)) c SEGINI MATR1 SEGACT MATR1 *MOD MATR1.MAT2(ICOU,ICOU) = COEF MARQ = 0 DO I5 = 1,INDLI.ID(NLS(JA)) INDAUX = IND2.NUME(I5,NLS(JA)) IF (INDAUX.EQ.NLOCFG(2,JA)) THEN MARQ = 1 IAFF = I5 GOTO 5 ENDIF ENDDO 5 CONTINUE IF (MARQ.EQ.0) THEN INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 ICOUCO = INDLI.ID(NLS(JA)) IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(2,JA) ELSE ICOUCO = IAFF ENDIF ICOUG2 = ICOUCO MATR1.MAT2(ICOU,ICOUCO) = COEFG(2,JA) MARQ = 0 DO I5 = 1,INDLI.ID(NLS(JA)) INDAUX = IND2.NUME(I5,NLS(JA)) IF (INDAUX.EQ.NLOCFG(3,JA)) THEN MARQ = 1 IAFF = I5 GOTO 6 ENDIF ENDDO 6 CONTINUE IF (MARQ.EQ.0) THEN INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 ICOUCO = INDLI.ID(NLS(JA)) IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(3,JA) ELSE ICOUCO = IAFF ENDIF ICOUG3 = ICOUCO MATR1.MAT2(ICOU,ICOUCO) = COEFG(3,JA) MARQ = 0 DO I5 = 1,INDLI.ID(NLS(JA)) INDAUX = IND2.NUME(I5,NLS(JA)) IF (INDAUX.EQ.NLOCFD(2,JA)) THEN MARQ = 1 IAFF = I5 GOTO 59 ENDIF ENDDO 59 CONTINUE IF (MARQ.EQ.0) THEN INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 ICOUCO = INDLI.ID(NLS(JA)) IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(2,JA) ELSE ICOUCO = IAFF ENDIF ICOUD2 = ICOUCO MATR1.MAT2(ICOU,ICOUCO) = - COEFD(2,JA) MARQ = 0 DO I5 = 1,INDLI.ID(NLS(JA)) INDAUX = IND2.NUME(I5,NLS(JA)) IF (INDAUX.EQ.NLOCFD(3,JA)) THEN MARQ = 1 IAFF = I5 GOTO 69 ENDIF ENDDO 69 CONTINUE IF (MARQ.EQ.0) THEN INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 ICOUCO = INDLI.ID(NLS(JA)) IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(3,JA) ELSE ICOUCO = IAFF ENDIF ICOUD3 = ICOUCO MATR1.MAT2(ICOU,ICOUCO) = - COEFD(3,JA) c ON EST ICI SCMB.MAT(ICOU,NLS(JA)) = & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA)) & *MPOCHP.VPOCHA(NLCG,1)) - & ((COEFD(1,JA)+COEFD(2,JA)+COEFD(3,JA))* & MPOCHP.VPOCHA(NLCD,1)) c SCMB.MAT(ICOU,NLS(JA)) = COEF* SCMB.MAT(ICOU,NLS(JA)) c NLS1 = NLS(JA) c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, c & 'SCMB', SCMB.MAT(ICOU,NLS1), c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF, c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2), c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3), c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2), c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3) * ON EST ICI * IL FAUT VERIFIER CE QUI EST AVANT * COEF POUR INVERSER LA MATRICE * ON CORRIGE ICI VAL1.MAT(ICOU,NLS(JA)) = & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) c VAL1.MAT(ICOU,NLS(JA)) = COEF*VAL1.MAT(ICOU,NLS(JA)) VAL2.MAT(ICOU,NLS(JA)) = & - (COEFD(1,JA) + COEFD(2,JA) + COEFD(3,JA)) c VAL2.MAT(ICOU,NLS(JA)) = COEF*VAL2.MAT(ICOU,NLS(JA)) IND.NUME(ICOU,NLS(JA)) = NGCG IND22.NUME(ICOU,NLS(JA)) = NGCD * CONDITION AUX LIMITE DE DIRICICHLET IF (NGCG.EQ.NGCD) THEN NLFCL=MLENCL.LECT(NGCF) IF (NLFCL.GT.0) THEN c WRITE(6,*) 'NLCF= ',NLCF c WRITE(6,*) 'NGCF= ',NGCF c WRITE(6,*) 'VAL=',MPOVCL.VPOCHA(NLFCL,1) COEF = MAX(ABS(COEFG(1,JA)),ABS(COEFG(2,JA))) COEF = MAX(COEF,ABS(COEFG(3,JA))) MATR1.MAT2(ICOU,ICOU) = COEF MATR1.MAT2(ICOU,ICOUG2) = 0.0D0 MATR1.MAT2(ICOU,ICOUG3) = 0.0D0 MATR1.MAT2(ICOU,ICOUD2) = 0.0D0 MATR1.MAT2(ICOU,ICOUD3) = 0.0D0 SCMB.MAT(ICOU,NLS(JA)) = (COEF*MPOVCL.VPOCHA(NLFCL,1)) VAL1.MAT(ICOU,NLS(JA)) = 0.D0 VAL2.MAT(ICOU,NLS(JA)) = COEF c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN IND.NUME(ICOU,NLS(JA)) = NGCG IND22.NUME(ICOU,NLS(JA)) = NGCF ELSE NLFNE=MLENNE.LECT(NGCF) c CONDITION DE FLUX IF (NLFNE.GT.0) THEN QIMPX = MPOVNE.VPOCHA(NLFNE,1) C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE QIMPS = (QIMPX) c WRITE(6,*) 'NGCF= ',NGCF c WRITE(6,*) 'QIMPS= ',QIMPS COEF = COEFG(1,JA) MATR1.MAT2(ICOU,ICOUD2) = 0.0D0 MATR1.MAT2(ICOU,ICOUD3) = 0.0D0 MATR1.MAT2(ICOU,ICOU) = COEF MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA) MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA) SCMB.MAT(ICOU,NLS(JA)) = & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1)) & + (QIMPS) VAL1.MAT(ICOU,NLS(JA)) = & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) VAL2.MAT(ICOU,NLS(JA)) = 1.D0 IND.NUME(ICOU,NLS(JA)) = NGCG IND22.NUME(ICOU,NLS(JA)) = NGCF NLS1 = NLS(JA) c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, c & 'SCMB', SCMB.MAT(ICOU,NLS1) c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, c & 'IND= ',IND.NUME(ICOU,NLS1), c & 'IND22= ',IND22.NUME(ICOU,NLS1), c & 'SCMB', SCMB.MAT(ICOU,NLS1), c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1), c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1), c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1), c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1), c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1) ELSE c CONDITION MIXTE NLFMI=MLENMI.LECT(NGCF) IF (NLFMI.GT.0) THEN XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1) XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2) QIMPX = MPOVMI.VPOCHA(NLFMI,3) C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE QIMPS = (QIMPX) c WRITE(6,*) 'NLCF= ',NLCF c WRITE(6,*) 'NGCF= ',NGCF c WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2 COEF = COEFG(1,JA) c WRITE(6,*) 'COEF= ',COEF c WRITE(6,*) 'COEF= ',COEF,'QIMPS= ',QIMPS MATR1.MAT2(ICOU,ICOUD2) = 0.0D0 MATR1.MAT2(ICOU,ICOUD3) = 0.0D0 MATR1.MAT2(ICOU,ICOU) = (XLAMBDA1*COEF) - & (1.D0*XLAMBDA2) MATR1.MAT2(ICOU,ICOUG2) = (XLAMBDA1*COEFG(2,JA)) MATR1.MAT2(ICOU,ICOUG3) = (XLAMBDA1*COEFG(3,JA)) c ON EST ICI SCMB.MAT(ICOU,NLS(JA)) = & (XLAMBDA1*((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))* & MPOCHP.VPOCHA(NLCG,1))) & + (1.D0*QIMPS) VAL1.MAT(ICOU,NLS(JA)) = XLAMBDA1* & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) VAL2.MAT(ICOU,NLS(JA)) = 1.D0 IND.NUME(ICOU,NLS(JA)) = NGCG IND22.NUME(ICOU,NLS(JA)) = NGCF NLS1 = NLS(JA) c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, c & 'IND= ',IND.NUME(ICOU,NLS1), c & 'IND22= ',IND22.NUME(ICOU,NLS1), c & 'SCMB', SCMB.MAT(ICOU,NLS1), c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1), c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1), c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1), c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1), c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1) ELSE C PAR DEFAUT FLUX NUL QIMPS = 0 COEF = COEFG(1,JA) MATR1.MAT2(ICOU,ICOU) = COEF MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA) MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA) SCMB.MAT(ICOU,NLS(JA)) = & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1)) VAL1.MAT(ICOU,NLS(JA)) = & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) VAL2.MAT(ICOU,NLS(JA)) = 0.D0 IND.NUME(ICOU,NLS(JA)) = NGCG IND22.NUME(ICOU,NLS(JA)) = NGCD ENDIF ENDIF ENDIF ENDIF c WRITE(6,*) 'COEF1 = ',COEFGG,'COEF2= ',COEF2,'COEF3= ', c & COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1), c & 'HD= ',MPOCHP.VPOCHA(NLCD,1) NAUX1 = MAX(NAUX1,INDLI.ID(NLS(JA))) c WRITE(6,*) 'NLCF= ',NLCF,'NAUX1 = ',NAUX1 c WRITE(6,*) 'NLS= ',NLS(JA),'NGS= ',NGS(JA), c & 'INDLI.ID',INDLI.ID(NLS(JA)) c WRITE(6,*) 'JA= ',JA c WRITE(6,*) 'NLOCFG= ',NLOCFG(1,JA),NLOCFG(2,JA),NLOCFG(3,JA) c WRITE(6,*) 'NLOCFD= ',NLOCFD(1,JA),NLOCFD(2,JA),NLOCFD(3,JA) c DO I5 = 1,INDLI.ID(NLS(JA)) c INDAUX = IND2.NUME(I5,NLS(JA)) c WRITE(6,*) 'I5= ','JA= ','NLS= ',NLS(JA), c & 'IND2= ',IND2.NUME(I5,NLS(JA)) c ENDDO C ON DESACTIVE (FIN DE LA BOUCLE SUR LES POINTS) c SEGDES MATRICE2 c SEGACT MATRICE2 NLS1 = NLS(JA) IF (ABS(COEF).LT. (-1.D0)) THEN NLFCL=MLENCL.LECT(NGCF) WRITE(6,*) 'CLIMD = ',NLFCL NLFNE=MLENNE.LECT(NGCF) WRITE(6,*) 'CLIMN = ',NLFNE WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, & 'SCMB', SCMB.MAT(ICOU,NLS1), & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF, & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2), & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3), & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2), & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3), & 'COEFG1JA', COEFG(1,JA),'COEFD1JA',COEFD(1,JA) c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA) c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA) c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA) WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA) WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA) WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA) WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA) WRITE(6,*)'NLCF= ',NLCF,'COEFG = ', & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA) WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1) WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2) WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3) WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA) WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA) WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA) WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA) WRITE(6,*)'NLCF= ',NLCF,'COEFD = ', & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA) WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1) WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2) WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3) WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D ENDIF SEGDES MATR1 * MOD ENDDO c IF (INDICE.EQ.1) THEN c WRITE(6,*)'NLCF= ',NLCF,'COEFG(1) OU COEFD(1) TRES PETIT' c ENDIF ENDDO IF (NAUX1.GT.NBMAX) THEN WRITE(6,*) 'ERREUR DANS LES PARAMETRES' c STOP ENDIF c DO J= 1,INDLI.ID(NLS1) c WRITE(6,*) 'MELVA1=',MELVA1.VELCHE(J,NLCF) c WRITE(6,*) 'MELVA2=',MELVA1.VELCHE(J,NLCF) c WRITE(6,*) 'MELEME=',MELEME.NUM(J,NLCF) c ENDDO MELTFA = MAUX MELEFP = MAUX2 IF (NBSO.EQ.2) THEN SEGDES IPT1 SEGDES IPT2 ELSEIF (NBSO.EQ.3) THEN SEGDES IPT1 SEGDES IPT2 SEGDES IPT3 ELSEIF (NBSO.EQ.4) THEN SEGDES IPT1 SEGDES IPT2 SEGDES IPT3 SEGDES IPT4 ENDIF IF (NBSOF.EQ.2) THEN SEGDES IPT5 SEGDES IPT6 ENDIF c MAUX = MELEFP c MELEFP = IMECOTE(1) c NGCF=MELEFP.NUM(4,1) c WRITE(6,*) 'NGCF= ',NGCF c MELEFP = MAUX c DO NLS1=1,NSOMM,1 c MATR1 = IPO2.POINT(NLS1) c SEGACT MATR1 c c DO I=1,INDLI.ID(NLS1) c DO J = 1,INDLI.ID(NLS1) c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J) c ENDDO c ENDDO c ENDDO c SEGDES MATR1 END