Télécharger la plaquette Cast3M


fr en

Télécharger sym2d3.eso

Retour à la liste

Numérotation des lignes : 

sym2d3

  1. C SYM2D3    SOURCE    OF166741  24/12/13    21:17:35     12097          
  2.  
  3.        SUBROUTINE SYM2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  4.      &             MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL,
  5.      &             MLENNE,MLENMI,MPOVCL,
  6.      &             MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2,
  7.      &             SCMB,INDLI,
  8.      &             TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NBCOT,
  9.      &             NSOMM,NBMAX)
  10. C
  11. C************************************************************************
  12. C
  13. C PROJET            :  CASTEM 2000
  14. C
  15. C NOM               :  NORV2
  16. C
  17. C DESCRIPTION       : Appelle par NORV1
  18. C
  19. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  20. C
  21. C AUTEUR            :  C. LE POTIER, DM2S/SFME/MTMS
  22. C
  23. C************************************************************************
  24. C
  25.       IMPLICIT INTEGER(I-N)
  26.       IMPLICIT REAL*8 (a-h,o-z)
  27. -INC SMLENTI
  28. -INC SMELEME
  29. -INC SMCHPOI
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC SMCOORD
  34. -INC SMLREEL
  35.  
  36.       POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  37.      &         MELTFA.MELEME, MELEP2.MELEME
  38.       POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  39.      & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  40.      & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL
  41.       POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  42.      &         MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI,MLEFA2.MLENTI
  43. -INC SMCHAML
  44.       INTEGER NBNN,NBREF
  45.  
  46. C**** Variable de SMLENTI, SMCHPOI
  47. C
  48.       INTEGER JG, N, NC,  NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  49. C
  50. C**** Les includes
  51. C
  52.       INTEGER I1,ICOMP,ICOMGR,IGEOM
  53.      &     ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  54.      &     ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF
  55.      &     ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  56.      &     ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  57.      &     ,NLS1,NLS2,NLFCL
  58.      &     ,ISOUS,IELEM,INOEUD,ICELL
  59.       INTEGER ICEN2
  60.       REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,VALZ,XG,XD,XF,XS1,XS2
  61.      &     ,YG,YD,YF,YS1,YS2,ZG,ZD,ZF,ZS1,ZS2,
  62.      &     PSCA,XNORM,VECX,VECY,VECZ,PSCAGX,PSCAGY,PSCAGZ,
  63.      &     PSCADX,PSCADY,PSCADZ,K11G,K22G,K21G,K31G,K32G,K33G,
  64.      &     K11D,K22D,K21D,K31D,K32D,K33D,VXG1,VXG2,
  65.      &     VXAU,VYAU,VZAU,VXD1,VXD2,VYG1,VYG2,VYD1,VYD2,VZG1,
  66.      &     VZG2,VZD1,VZD2,TRG1,TRG2,
  67.      &     TRD1,TRD2,TRG,TRD
  68.       REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  69.      & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,VZ,
  70.      & COEF1X,COEF2X,COEF1Y,COEF2Y,COEF1Z,COEF2Z,
  71.      & CX,CY,CZ,ANCX,ANCY,ANCZ,DIFFX,DIFFY,DIFFZ,XLONGG,XLONGD,
  72.      & VALD,VALG,COEF,GX,GY,GZ,XMINK11,XMAXK11,XMINK22,XMAXK22,
  73.      & QIMPX,QIMPY,QIMPZ,QIMPS,XLAMBDA1,XLAMBDA2
  74.  
  75. c      REAL*8 VECXG1(3),VECYG1(3)
  76. c      REAL*8 VECXG2(3),VECYG2(3)
  77. c      REAL*8 VECXD1(3),VECYD1(3)
  78. c      REAL*8 VECXD2(3),VECYD2(3)
  79. c      REAL*8 EPS
  80. c      INTEGER ICRIT
  81. c      CHARACTER*(4) NOMCOM(18)
  82. c      CHARACTER*8 TYPE
  83.  
  84.       REAL*8 VECXG(4,4),VECYG(4,4),VECZG(4,4)
  85.       REAL*8 VECXD(4,4),VECYD(4,4),VECZD(4,4)
  86.       REAL*8 VOLUG(4),SURFAGX(4),SURFAGY(4),SURFAGZ(4),COEFG(4,4)
  87.       REAL*8 VOLUD(4),SURFADX(4),SURFADY(4),SURFADZ(4),COEFD(4,4)
  88.       REAL*8 XARG(4,4),YARG(4,4),ZARG(4,4),XCOUR,YCOUR,ZCOUR
  89.       REAL*8 XFACG(4,4),YFACG(4,4),ZFACG(4,4),XCO,YCO,ZCO
  90.       REAL*8 XARD(4,4),YARD(4,4),ZARD(4,4)
  91.       REAL*8 XFACD(4,4),YFACD(4,4),ZFACD(4,4)
  92.       REAL*8 XA,YA,ZA,DIST1,DIST2
  93.       REAL*8 VAUX(3),VAUY(3),VAUZ(3)
  94.       REAL*8 PVECX,PVECY,PVECZ
  95.       INTEGER NGS(4),NLS(4),XS(4),YS(4),ZS(4)
  96.       INTEGER NLOCFG(4,4),NLOCFD(4,4)
  97.       REAL*8 EPS,ALPHA
  98.       INTEGER ICRIT
  99.       CHARACTER*(4) NOMCOM(18)
  100.       CHARACTER*8 TYPE
  101. C
  102.       DATA NOMCOM  /'P1DX','P1DY',
  103.      &     'P2DX','P2DY',
  104.      &     'P3DX','P3DY',
  105.      &     'P4DX','P4DY',
  106.      &     'P5DX','P5DY',
  107.      &     'P6DX','P6DY',
  108.      &     'P7DX','P7DY',
  109.      &     'P8DX','P8DY',
  110.      &     'P9DX','P9DY'/
  111.  
  112.       INTEGER NDIM
  113.       SEGMENT MMAT1
  114.       REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  115.       INTEGER IC(NDIM)
  116.       ENDSEGMENT
  117.  
  118.       INTEGER K1,K2
  119.       SEGMENT INDICE
  120.       INTEGER NUME(K1,K2)
  121.       ENDSEGMENT
  122.       POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  123.  
  124.       SEGMENT MATRICE
  125.       REAL*8 MAT(K1,K2)
  126.       ENDSEGMENT
  127.       POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  128.  
  129.       INTEGER K3
  130.       SEGMENT POINT2
  131.       INTEGER POINT(K3)
  132.       ENDSEGMENT
  133.       POINTEUR IPO2.POINT2
  134.  
  135.       SEGMENT MATRICE2
  136.       REAL*8 MAT2(K1,K2)
  137.       ENDSEGMENT
  138.       POINTEUR MATR1.MATRICE2,MATR2.MATRICE2
  139.  
  140.  
  141.       SEGMENT REP
  142.       INTEGER  ID(K3)
  143.       ENDSEGMENT
  144.       POINTEUR TAB.REP,INDLI.REP
  145.  
  146.       INTEGER K5
  147.       SEGMENT NBFAC
  148.       INTEGER NBFACEL(K5)
  149.       INTEGER IMELEM(K5)
  150.       ENDSEGMENT
  151.  
  152.       INTEGER K6
  153.       SEGMENT NBCOT
  154.       INTEGER NBCOTE(K6)
  155.       INTEGER IMECOTE(K6)
  156.       ENDSEGMENT
  157.  
  158.  
  159.  
  160. c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS
  161. c SOUS DOMAINE
  162.        ALPHA = 2.0/3.0
  163.  
  164.  
  165.        MAUX = MELTFA
  166.        MAUX2 = MELEFP
  167.        NMAI1 = 0
  168.        NMAI2 = 0
  169.        NMAI3 = 0
  170.        NMAI4 = 0
  171.        NBSO = MAX(1,MELTFA.LISOUS(/1))
  172. c       WRITE(6,*) 'NBSO MAILLE= ',NBSO
  173. c       WRITE(6,*) 'MELTFA= ',MELTFA
  174.        IELTFA = MELTFA
  175.        IF (NBSO.EQ.1) THEN
  176.        K5 = MELTFA.NUM(/2)
  177.        ELSEIF (NBSO.EQ.2) THEN
  178.        IPT1 = MELTFA.LISOUS(1)
  179.        SEGACT IPT1
  180.        N1 = IPT1.NUM(/2)
  181.        NMAI1 = N1
  182.        SEGDES IPT1
  183.        IPT2 = MELTFA.LISOUS(2)
  184.        SEGACT IPT2
  185.        N2 = IPT2.NUM(/2)
  186.        NMAI2 = N2
  187.        SEGDES IPT2
  188.        K5 = N1 + N2
  189.        ELSEIF (NBSO.EQ.3) THEN
  190.        IPT1 = MELTFA.LISOUS(1)
  191.        SEGACT IPT1
  192.        N1 = IPT1.NUM(/2)
  193.        NMAI1 = N1
  194.        SEGDES IPT1
  195.        IPT2 = MELTFA.LISOUS(2)
  196.        SEGACT IPT2
  197.        N2 = IPT2.NUM(/2)
  198.        NMAI2 = N2
  199.        SEGDES IPT2
  200.        IPT3 = MELTFA.LISOUS(3)
  201.        SEGACT IPT3
  202.        N3 = IPT3.NUM(/2)
  203.        NMAI3 = N3
  204.        SEGDES IPT3
  205.        K5 = N1 + N2 + N3
  206.        ELSEIF (NBSO.EQ.4) THEN
  207.        IPT1 = MELTFA.LISOUS(1)
  208.        SEGACT IPT1
  209.        N1 = IPT1.NUM(/2)
  210.        NMAI1 = N1
  211.        SEGDES IPT1
  212.        IPT2 = MELTFA.LISOUS(2)
  213.        SEGACT IPT2
  214.        N2 = IPT2.NUM(/2)
  215.        NMAI2 = N2
  216.        SEGDES IPT2
  217.        IPT3 = MELTFA.LISOUS(3)
  218.        SEGACT IPT3
  219.        N3 = IPT3.NUM(/2)
  220.        NMAI3 = N3
  221.        SEGDES IPT3
  222.        IPT4 = MELTFA.LISOUS(4)
  223.        SEGACT IPT4
  224.        N4 = IPT4.NUM(/2)
  225.        NMAI4 = N4
  226.        SEGDES IPT4
  227.        K5 = N1 + N2 + N3 + N4
  228.        ENDIF
  229. c       WRITE(6,*) 'K5= ',K5
  230.  
  231.  
  232.  
  233.        IF (NBSO.EQ.1) THEN
  234.        DO I = 1,K5
  235.            NTYPE = MELTFA.ITYPEL
  236. c           WRITE(6,*) 'NTYPE= ',NTYPE
  237.            IF (NTYPE .EQ. 16) THEN
  238.            NBFACEL(I) = 6
  239.            IMELEM(I) = MELTFA
  240.            ELSEIF (NTYPE .EQ. 25) THEN
  241.            NBFACEL(I) = 5
  242.            IMELEM(I) = MELTFA
  243.            ELSEIF (NTYPE .EQ. 23) THEN
  244.            NBFACEL(I) = 4
  245.            IMELEM(I) = MELTFA
  246.            ELSEIF (NTYPE .EQ. 9) THEN
  247.            NBFACEL(I) = 5
  248.            IMELEM(I) = MELTFA
  249.            ENDIF
  250. c       SEGDES MELTFA
  251.        ENDDO
  252.        ELSEIF (NBSO.EQ.2) THEN
  253.          IPT1 = MELTFA.LISOUS(1)
  254.          SEGACT IPT1
  255.          IPT2 = MELTFA.LISOUS(2)
  256.          SEGACT IPT2
  257.        DO I = 1,K5
  258.          N1 = IPT1.NUM(/2)
  259.          IF (I.LE.N1) THEN
  260.            NTYPE = IPT1.ITYPEL
  261.            IF (NTYPE .EQ. 16) THEN
  262.            NBFACEL(I) = 6
  263.            IMELEM(I) =  IPT1
  264.            ELSEIF (NTYPE .EQ. 25) THEN
  265.            NBFACEL(I) = 5
  266.            IMELEM(I) = IPT1
  267.            ELSEIF (NTYPE .EQ. 23) THEN
  268.            NBFACEL(I) = 4
  269.            IMELEM(I) = IPT1
  270.            ELSEIF (NTYPE .EQ. 9) THEN
  271.            NBFACEL(I) = 5
  272.            IMELEM(I) = IPT1
  273.            ENDIF
  274.          ELSE
  275.            NTYPE = IPT2.ITYPEL
  276.            IF (NTYPE .EQ. 16) THEN
  277.            NBFACEL(I) = 6
  278.            IMELEM(I) =  IPT2
  279.            ELSEIF (NTYPE .EQ. 25) THEN
  280.            NBFACEL(I) = 5
  281.            IMELEM(I) = IPT2
  282.            ELSEIF (NTYPE .EQ. 23) THEN
  283.            NBFACEL(I) = 4
  284.            IMELEM(I) = IPT2
  285.            ELSEIF (NTYPE .EQ. 9) THEN
  286.            NBFACEL(I) = 5
  287.            IMELEM(I) = IPT2
  288.            ENDIF
  289.         ENDIF
  290.       ENDDO
  291.       ELSEIF (NBSO.EQ.3) THEN
  292.          IPT1 = MELTFA.LISOUS(1)
  293.          SEGACT IPT1
  294.            NTYPE = IPT1.ITYPEL
  295. c           WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL
  296.          IPT2 = MELTFA.LISOUS(2)
  297.          SEGACT IPT2
  298.            NTYPE = IPT2.ITYPEL
  299. c           WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL
  300.          IPT3 = MELTFA.LISOUS(3)
  301.          SEGACT IPT3
  302.            NTYPE = IPT3.ITYPEL
  303. c           WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL
  304.          N1 = IPT1.NUM(/2)
  305.          N2 = IPT2.NUM(/2)
  306.          N3 = IPT3.NUM(/2)
  307.        DO I = 1,K5
  308.          IF (I.LE.N1) THEN
  309.            NTYPE = IPT1.ITYPEL
  310.            IF (NTYPE .EQ. 16) THEN
  311.            NBFACEL(I) = 6
  312.            IMELEM(I) =  IPT1
  313.            ELSEIF (NTYPE .EQ. 25) THEN
  314.            NBFACEL(I) = 5
  315.            IMELEM(I) = IPT1
  316.            ELSEIF (NTYPE .EQ. 23) THEN
  317.            NBFACEL(I) = 4
  318.            IMELEM(I) = IPT1
  319.            ELSEIF (NTYPE .EQ. 9) THEN
  320.            NBFACEL(I) = 5
  321.            IMELEM(I) = IPT1
  322.            ENDIF
  323.          ELSEIF (I.LE.(N1+N2)) THEN
  324.            NTYPE = IPT2.ITYPEL
  325.            IF (NTYPE .EQ. 16) THEN
  326.            NBFACEL(I) = 6
  327.            IMELEM(I) =  IPT2
  328.            ELSEIF (NTYPE .EQ. 25) THEN
  329.            NBFACEL(I) = 5
  330.            IMELEM(I) = IPT2
  331.            ELSEIF (NTYPE .EQ. 23) THEN
  332.            NBFACEL(I) = 4
  333.            IMELEM(I) = IPT2
  334.            ELSEIF (NTYPE .EQ. 9) THEN
  335.            NBFACEL(I) = 5
  336.            IMELEM(I) = IPT2
  337.            ENDIF
  338.          ELSE
  339.            NTYPE = IPT3.ITYPEL
  340.            IF (NTYPE .EQ. 16) THEN
  341.            NBFACEL(I) = 6
  342.            IMELEM(I) =  IPT3
  343.            ELSEIF (NTYPE .EQ. 25) THEN
  344.            NBFACEL(I) = 5
  345.            IMELEM(I) = IPT3
  346.            ELSEIF (NTYPE .EQ. 23) THEN
  347.            NBFACEL(I) = 4
  348.            IMELEM(I) = IPT3
  349.            ELSEIF (NTYPE .EQ. 9) THEN
  350.            NBFACEL(I) = 5
  351.            IMELEM(I) = IPT3
  352.            ENDIF
  353.          ENDIF
  354.          ENDDO
  355.       ELSEIF (NBSO.EQ.4) THEN
  356.          IPT1 = MELTFA.LISOUS(1)
  357.          SEGACT IPT1
  358.            NTYPE = IPT1.ITYPEL
  359. c           WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL
  360.          IPT2 = MELTFA.LISOUS(2)
  361.          SEGACT IPT2
  362.            NTYPE = IPT2.ITYPEL
  363. c           WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL
  364.          IPT3 = MELTFA.LISOUS(3)
  365.          SEGACT IPT3
  366.          NTYPE = IPT3.ITYPEL
  367.          WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL
  368.          IPT4 = MELTFA.LISOUS(4)
  369.          SEGACT IPT4
  370.            NTYPE = IPT4.ITYPEL
  371.                    WRITE(6,*) 'NTYPE= ',IPT4.ITYPEL
  372.          N1 = IPT1.NUM(/2)
  373.          N2 = IPT2.NUM(/2)
  374.          N3 = IPT3.NUM(/2)
  375.          N4 = IPT4.NUM(/2)
  376.               DO I = 1,K5
  377.          IF (I.LE.N1) THEN
  378.            NTYPE = IPT1.ITYPEL
  379.            IF (NTYPE .EQ. 16) THEN
  380.            NBFACEL(I) = 6
  381.            IMELEM(I) =  IPT1
  382.            ELSEIF (NTYPE .EQ. 25) THEN
  383.            NBFACEL(I) = 5
  384.            IMELEM(I) = IPT1
  385.            ELSEIF (NTYPE .EQ. 23) THEN
  386.            NBFACEL(I) = 4
  387.            IMELEM(I) = IPT1
  388.            ELSEIF (NTYPE .EQ. 9) THEN
  389.            NBFACEL(I) = 5
  390.            IMELEM(I) = IPT1
  391.            ENDIF
  392.          ELSEIF (I.LE.(N1+N2)) THEN
  393.            NTYPE = IPT2.ITYPEL
  394.            IF (NTYPE .EQ. 16) THEN
  395.            NBFACEL(I) = 6
  396.            IMELEM(I) =  IPT2
  397.            ELSEIF (NTYPE .EQ. 25) THEN
  398.            NBFACEL(I) = 5
  399.            IMELEM(I) = IPT2
  400.            ELSEIF (NTYPE .EQ. 23) THEN
  401.            NBFACEL(I) = 4
  402.            IMELEM(I) = IPT2
  403.            ELSEIF (NTYPE .EQ. 9) THEN
  404.            NBFACEL(I) = 5
  405.            IMELEM(I) = IPT2
  406.            ENDIF
  407.          ELSEIF (I.LE.(N1+N2+N3)) THEN
  408.            NTYPE = IPT3.ITYPEL
  409.            IF (NTYPE .EQ. 16) THEN
  410.            NBFACEL(I) = 6
  411.            IMELEM(I) =  IPT3
  412.            ELSEIF (NTYPE .EQ. 25) THEN
  413.            NBFACEL(I) = 5
  414.            IMELEM(I) = IPT3
  415.            ELSEIF (NTYPE .EQ. 23) THEN
  416.            NBFACEL(I) = 4
  417.            IMELEM(I) = IPT3
  418.            ELSEIF (NTYPE .EQ. 9) THEN
  419.            NBFACEL(I) = 5
  420.            IMELEM(I) = IPT3
  421.            ENDIF
  422.          ELSE
  423.            NTYPE = IPT4.ITYPEL
  424.            IF (NTYPE .EQ. 16) THEN
  425.            NBFACEL(I) = 6
  426.            IMELEM(I) =  IPT4
  427.            ELSEIF (NTYPE .EQ. 25) THEN
  428.            NBFACEL(I) = 5
  429.            IMELEM(I) = IPT4
  430.            ELSEIF (NTYPE .EQ. 23) THEN
  431.            NBFACEL(I) = 4
  432.            IMELEM(I) = IPT4
  433.            ELSEIF (NTYPE .EQ. 9) THEN
  434.            NBFACEL(I) = 5
  435.            IMELEM(I) = IPT4
  436.            ENDIF
  437.          ENDIF
  438.         ENDDO
  439.         ENDIF
  440.  
  441. C ON EST ICI CORRIGER K5
  442.  
  443.        MLEFA2 = MLEFA
  444.        CALL KRIPAD(MELEFA,MLEFA2)
  445. c CAS OU LES FACES SONT DES TRIANGLES OU DES FACES
  446.        NFAI1 = 0
  447.        NBSOF = MAX(1,MELEFP.LISOUS(/1))
  448. c       WRITE(6,*) 'NBSO FACE= ',NBSOF
  449.        IELTFA = MELTFA
  450.        IF (NBSOF.EQ.1) THEN
  451.        K6 = MELEFP.NUM(/2)
  452.        ELSEIF (NBSOF.EQ.2) THEN
  453.        IPT5 = MELEFP.LISOUS(1)
  454.        SEGACT IPT5
  455.        N1 = IPT5.NUM(/2)
  456.        NFAI1 = N1
  457.        SEGDES IPT5
  458.        IPT6 = MELEFP.LISOUS(2)
  459.        SEGACT IPT6
  460.        N2 = IPT6.NUM(/2)
  461.        NFAI2 = N2
  462.        SEGDES IPT6
  463.        K6 = N1 + N2
  464.        ENDIF
  465. c       WRITE(6,*) 'K6= ',K6
  466.  
  467.        SEGINI NBCOT
  468. c       WRITE(6,*) 'POINT1'
  469. C ON EST ICI
  470.        IF (NBSOF.EQ.1) THEN
  471.        DO I = 1,K6
  472.            NTYPE = MELEFP.ITYPEL
  473. c           WRITE(6,*) 'NTYPE= ',NTYPE
  474.            IF (NTYPE .EQ. 5) THEN
  475.            NBCOTE(I) = 3
  476.            IMECOTE(I) = MELEFP
  477.            ELSE
  478.            NBCOTE(I) = 4
  479.            IMECOTE(I) = MELEFP
  480.            ENDIF
  481. c       SEGDES MELTFA
  482.        ENDDO
  483.        ELSEIF (NBSOF.EQ.2) THEN
  484. c       WRITE(6,*) 'POINT2'
  485.          IPT5 = MELEFP.LISOUS(1)
  486.          SEGACT IPT5
  487.          IPT6 = MELEFP.LISOUS(2)
  488.          SEGACT IPT6
  489. c          WRITE(6,*) 'IPT5= ',IPT5.ITYPEL
  490. c          WRITE(6,*) 'IPT6= ',IPT6.ITYPEL
  491.        DO I = 1,K6
  492.          N1 = IPT5.NUM(/2)
  493. C MISE A JOUR DE MLEFA.LECT
  494.          IF (I.LE.N1) THEN
  495.          N0 = IPT5.NUM(/1)
  496.          NGFAUX = IPT5.NUM(N0,I)
  497.          MLEFA2.LECT(NGFAUX) = I
  498. c           WRITE(6,*)  'NGFAUX = ',NGFAUX,
  499. c     &                 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  500.            IF (IPT5.ITYPEL .EQ. 5) THEN
  501.            NBCOTE(I) = 3
  502.            IMECOTE(I) =  IPT5
  503.            ELSE
  504.            NBCOTE(I) = 4
  505.            IMECOTE(I) = IPT5
  506.            ENDIF
  507. c         SEGDES IPT5
  508.          ELSE
  509.          N0 = IPT6.NUM(/1)
  510.          NGFAUX = IPT6.NUM(N0,I-NFAI1)
  511.          MLEFA2.LECT(NGFAUX) = I
  512. c           WRITE(6,*)  'NGFAUX = ',NGFAUX,
  513. c     &                 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  514.            IF (IPT6.ITYPEL .EQ. 5) THEN
  515.            NBCOTE(I) = 3
  516.            IMECOTE(I) = IPT6
  517.            ELSE
  518.            NBCOTE(I) = 4
  519.            IMECOTE(I) =  IPT6
  520.            ENDIF
  521. c           SEGDES IPT6
  522.         ENDIF
  523. c           WRITE(6,*) 'I= ',I
  524. c           WRITE(6,*) 'NBCOTE= ',NBCOTE(I)
  525. c           WRITE(6,*) 'IMECOTE= ',IMECOTE(I)
  526.  
  527.         ENDDO
  528.         ENDIF
  529. C IL FAUDRA EGALEMENT CREER DES POINTEUR POUR LES FACES DE CHAQUE ELEMENT
  530. C EXEMPLE LES PRISMES
  531.  
  532. C SEGMENT  SERVANT A UN PRECALCUL DE NBMAX
  533. c      WRITE(6,*) 'NSOMM= ',NSOMM
  534.       K3 = NSOMM
  535.       SEGINI INDLI
  536.       SEGINI TAB
  537.       DO I = 1,K3
  538.         INDLI.ID(I) = 0
  539.         TAB.ID(I) = 0
  540.       ENDDO
  541.  
  542.       NFAC=MELEFL.NUM(/2)
  543.       NBMAX = 0
  544.  
  545. C PRECALCUL DE NBMAX
  546.       DO NLCF= 1, NFAC, 1
  547. c        WRITE(6,*) 'NLCF= ',NLCF
  548.          NGCF=MELEFL.NUM(2,NLCF)
  549.          NGCG=MELEFL.NUM(1,NLCF)
  550.          NGCD=MELEFL.NUM(3,NLCF)
  551.          NLCG=MLECEN.LECT(NGCG)
  552.          NLCD=MLECEN.LECT(NGCD)
  553. c         NFAUX = MELEFA.NUM(NLCF,1)
  554. c         WRITE(6,*) 'NFAUX= ',NFAUX
  555. c
  556. c           NGFAUX = MELEFA.NUM(NLCF,1)
  557. c           WRITE(6,*)  'NGFAUX = ',NGFAUX,
  558. c     &                 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  559. c         NBNO = MELEFP.NUM(/1) - 1
  560.          NBNO = NBCOTE(NLCF)
  561. c         WRITE(6,*) 'NLCF= ',NLCF
  562. c         WRITE(6,*) 'NBNO= ',NBNO
  563.          MELEFP = IMECOTE(NLCF)
  564.          IF (NLCF.GT.NFAI1) THEN
  565.          NLCFAUX = NLCF - NFAI1
  566.          ELSE
  567.          NLCFAUX = NLCF
  568.          ENDIF
  569.          DO IA = 1,NBNO
  570.          NGS1=MELEFP.NUM(IA,NLCFAUX)
  571.          NLS1=MLESOM.LECT(NGS1)
  572.          NLS1=MLESOM.LECT(NGS1)
  573.          INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  574.          NBMAX = MAX(NBMAX,INDLI.ID(NLS1))
  575.          ENDDO
  576.  
  577.  
  578.       ENDDO
  579.  
  580.  
  581.  
  582.       SEGSUP INDLI
  583.       SEGSUP TAB
  584.  
  585. c      NBMAX = 6
  586.       NBMAX = NBMAX +1
  587. c      WRITE(6,*) 'DANS NORV1 NBMAX= ',NBMAX
  588. c      WRITE(6,*) 'NBSOM= ',NSOMM
  589.  
  590.  
  591.  
  592.  
  593. C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL
  594. c INITIALISATION DES MATRICES
  595. c      NBMAX = 10
  596.       K3 = NSOMM
  597.       SEGINI INDLI
  598.       SEGINI TAB
  599.       DO I = 1,K3
  600.         INDLI.ID(I) = 0
  601.         TAB.ID(I) = 0
  602.       ENDDO
  603.  
  604.       K1 = NBMAX
  605.       K2 = NSOMM
  606.       SEGINI IND2
  607.       SEGINI IND
  608.       SEGINI IND22
  609.       SEGINI VAL1
  610.       SEGINI VAL2
  611.       SEGINI SCMB
  612.  
  613. *      K1 = NBMAX
  614. *      K2 = (NBMAX+1)
  615.  
  616. C INITIALISATION DU POINTEUR MATRICE2
  617.       K3 = NSOMM
  618.       SEGINI IPO2
  619.       DO I = 1,K3
  620.       K1 =   NBMAX
  621.       K2 =   NBMAX + 1
  622.       SEGINI MATR1
  623.       IPO2.POINT(I) =  MATR1
  624.       SEGDES  MATR1
  625.       ENDDO
  626.  
  627.  
  628.  
  629.  
  630. c      DO I = 1,K3
  631. c      MATR1 = IPO2.POINT(I)
  632. c      SEGACT MATR1 *MOD
  633. c      MATR1.MAT2(1,1) =  4.D0
  634. c      MATR1.MAT2(2,2) =  3.D0
  635. c      WRITE(6,*) 'MATR1=', MATR1.MAT2(1,1)
  636. c      WRITE(6,*) 'MATR1=', MATR1.MAT2(2,2)
  637. c      SEGDES MATR1
  638. c      ENDDO
  639.  
  640.  
  641.  
  642.  
  643.       NFAC=MELEFL.NUM(/2)
  644.  
  645. c      WRITE(6,*) 'NFAC= ',NFAC
  646.       NAUX1 = 0
  647.       DO NLCF= 1, NFAC, 1
  648.          INDICE = 0
  649.  
  650. c ON TIENT COMPTE DU CHANGEMENT DE NUMEROTATION
  651.          NGCF=MELEFL.NUM(2,NLCF)
  652.  
  653.          NGCG=MELEFL.NUM(1,NLCF)
  654.          NGCD=MELEFL.NUM(3,NLCF)
  655.          NLCG=MLECEN.LECT(NGCG)
  656.          NLCD=MLECEN.LECT(NGCD)
  657.  
  658.  
  659.  
  660.  
  661.          SCNX=MPONOR.VPOCHA(NLCF,1)
  662.          SCNY=MPONOR.VPOCHA(NLCF,2)
  663.          SCNZ=MPONOR.VPOCHA(NLCF,3)
  664.          SCN1X = SCNX
  665.          SCN1Y = SCNY
  666.          SCN1Z = SCNZ
  667.  
  668.  
  669. C        4=IDIM+1
  670.          ICELL=(4*(NGCG -1))+1
  671.          XG=MCOORD.XCOOR(ICELL)
  672.          YG=MCOORD.XCOOR(ICELL+1)
  673.          ZG=MCOORD.XCOOR(ICELL+2)
  674.          ICELL=(4*(NGCD -1))+1
  675.          XD=MCOORD.XCOOR(ICELL)
  676.          YD=MCOORD.XCOOR(ICELL+1)
  677.          ZD=MCOORD.XCOOR(ICELL+2)
  678.          ICELL=(4*(NGCF -1))+1
  679.          XF=MCOORD.XCOOR(ICELL)
  680.          YF=MCOORD.XCOOR(ICELL+1)
  681.          ZF=MCOORD.XCOOR(ICELL+2)
  682.  
  683. C MISE A ZERO DE NLOC
  684.             DO JA=1,4
  685.               DO IA=1,3
  686.               NLOCFG(IA,JA) = 0
  687.               NLOCFD(IA,JA) = 0
  688.               ENDDO
  689.             ENDDO
  690.  
  691.          MELTFA =  IMELEM(NLCG)
  692.          NBF = NBFACEL(NLCG)
  693.          IF (NLCG.LE.NMAI1) THEN
  694.          NGAUX = NLCG
  695.          ELSEIF ((NLCG.GT.NMAI1).AND.(NLCG.LE.(NMAI1+NMAI2))) THEN
  696.          NGAUX = NLCG - NMAI1
  697.          ELSEIF ((NLCG.GT.(NMAI1+NMAI2)).AND.
  698.      &                 (NLCG.LE.(NMAI1+NMAI2+NMAI3))) THEN
  699.          NGAUX = NLCG - (NMAI1+NMAI2)
  700.          ELSEIF (NLCG.GT.(NMAI1+NMAI2+NMAI3)) THEN
  701.          NGAUX = NLCG - (NMAI1+NMAI2+NMAI3)
  702.          ENDIF
  703.  
  704. c         SEGACT MELTFA
  705.  
  706. C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE
  707.          NLCF1 = MLEFA2.LECT(NGCF)
  708.          NBNO = NBCOTE(NLCF1)
  709.          MELEFP = IMECOTE(NLCF1)
  710.          IF (NLCF1.GT.NFAI1) THEN
  711.          NLCF1AUX = NLCF1 - NFAI1
  712.          ELSE
  713.          NLCF1AUX = NLCF1
  714.          ENDIF
  715.  
  716.          DO JA = 1,NBNO
  717.          NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  718.              ICELL=(4*(NGS(JA) -1))+1
  719.              XA = MCOORD.XCOOR(ICELL)
  720.              YA = MCOORD.XCOOR(ICELL+1)
  721.              ZA = MCOORD.XCOOR(ICELL+2)
  722. c              WRITE(6,*) 'NLCF= ',NLCF,'JA= ',JA,
  723. c     &        'XA= ',XA,'YA= ',YA,'ZA= ',ZA
  724.  
  725.  
  726. C ON CALCULE P2 ET P3, VOIR RAPPORT PAGE 17
  727.              DIST2 = -100000000000.
  728. Con CALCULE LE PLUS GRAND
  729.              DO I1 =1,NBNO
  730.              NSOM1 = MELEFP.NUM(I1,NLCF1AUX)
  731.              ICELL=(4*(NSOM1 -1))+1
  732.              XCOUR=MCOORD.XCOOR(ICELL)
  733.              YCOUR=MCOORD.XCOOR(ICELL+1)
  734.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  735.              DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2)
  736.              DIST1 = SQRT( DIST1)
  737.              IF ((DIST1.GT.DIST2)) THEN
  738.                 DIST2 = DIST1
  739.                 ICOURANT = I1
  740.              ENDIF
  741.              ENDDO
  742.  
  743.              IF (JA.EQ.1) ICOURANT = 3
  744.              IF (JA.EQ.2) ICOURANT = 4
  745.              IF (JA.EQ.3) ICOURANT = 1
  746.              IF (JA.EQ.4) ICOURANT = 2
  747.  
  748. c SI LA FACE EST TRIANGULAIRE ICOURANT NE SERT A RIEN
  749.              IF (NBNO.EQ.3) THEN
  750.              ICOURANT = 0
  751.              ENDIF
  752.  
  753.  
  754.              INDFAC=2
  755. c              WRITE(6,*) 'ICOURANT= ',ICOURANT
  756. c              WRITE(6,*) 'JA= ',JA
  757.              DO I1 =1,NBNO
  758.              NSOM1 = MELEFP.NUM(I1,NLCF1AUX)
  759.              ICELL=(4*(NSOM1 -1))+1
  760.              XCOUR=MCOORD.XCOOR(ICELL)
  761.              YCOUR=MCOORD.XCOOR(ICELL+1)
  762.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  763.  
  764.              IF ((I1.NE.ICOURANT).AND.(I1.NE.JA)) THEN
  765.               XARG(INDFAC,JA) = 0.5D0*(XA+XCOUR)
  766.               YARG(INDFAC,JA) = 0.5D0*(YA+YCOUR)
  767.               ZARG(INDFAC,JA) = 0.5D0*(ZA+ZCOUR)
  768. c              WRITE(6,*) 'X= ',XARG(INDFAC,JA),
  769. c     &       'Y= ',YARG(INDFAC,JA),'Z= ',ZARG(INDFAC,JA)
  770. c              WRITE(6,*) 'XA= ',XA,
  771. c     &       'YA= ',YA,'ZA= ',ZA
  772. c              WRITE(6,*) 'XCOUR= ',XCOUR,
  773. c     &       'YCOUR= ',YCOUR,'ZCOUR= ',ZCOUR
  774.              INDFAC= INDFAC+1
  775.              ENDIF
  776.              ENDDO
  777.  
  778. c              WRITE(6,*) 'XA= ',XA,'YA= ',YA,'ZA= ',ZA
  779. c              WRITE(6,*) 'P2', 'X= ',XARG(2,JA),'Y= ',YARG(2,JA),'Z= ',
  780. c     &        ZARG(2,JA)
  781. c              WRITE(6,*) 'P3', 'X= ',XARG(3,JA),'Y= ',YARG(3,JA),'Z= ',
  782. c     &        ZARG(3,JA)
  783. c              WRITE(6,*) 'D', 'X= ',XF,'Y= ',YF,'Z= ',ZF
  784.  
  785.  
  786. c             IF (NLCF.EQ.14) then
  787. c         WRITE(6,*) 'NGAUX= ',NGAUX,'JA= ',JA,'NGS= ',NGS(JA)
  788. c         WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF
  789. c          ENDIF
  790.  
  791.          ICOUR = 1
  792.          DO J = 1,NBF
  793.             N1 = MELTFA.NUM(J,NGAUX)
  794.             NL1 = MLEFA2.LECT(N1)
  795.              NBNO2 = NBCOTE(NL1)
  796.              MELEP2 = IMECOTE(NL1)
  797.              IF (NL1.GT.NFAI1) THEN
  798.              NL1AUX = NL1 - NFAI1
  799.              ELSE
  800.              NL1AUX = NL1
  801.              ENDIF
  802. c             IF (NLCF.EQ.14) then
  803. c             WRITE(6,*) 'N1= ',N1,'NL1= ',NL1,'NL1AUX= ',NL1AUX
  804. c             ENDIF
  805.  
  806.  
  807.  
  808.  
  809.  
  810.              DO IA =1,NBNO2
  811.              NSOM1 = MELEP2.NUM(IA,NL1AUX)
  812.  
  813.  
  814.  
  815. c             IF (NLCF.EQ.14) then
  816. c             WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1
  817. c             ENDIF
  818.              IF (NSOM1.EQ.NGS(JA)) THEN
  819.  
  820.              ICELL=(4*(N1 -1))+1
  821.              XF=MCOORD.XCOOR(ICELL)
  822.              YF=MCOORD.XCOOR(ICELL+1)
  823.              ZF=MCOORD.XCOOR(ICELL+2)
  824.  
  825.  
  826.  
  827. C ON CALCULE P1 VOIR RAPPORT p 17
  828.              IF (N1.NE.NGCF) THEN
  829.              ICOUR = ICOUR + 1
  830.              VECXG(ICOUR,JA) = (XF - XG)
  831.              VECYG(ICOUR,JA) = (YF - YG)
  832.              VECZG(ICOUR,JA) = (ZF - ZG)
  833.              NLOCFG(ICOUR,JA) = N1
  834.              XFACG(ICOUR,JA) = XF
  835.              YFACG(ICOUR,JA) = YF
  836.              ZFACG(ICOUR,JA) = ZF
  837.  
  838.              DIST2 = -1.e+15
  839.              DO I1 =1,NBNO2
  840.              NSOM1 = MELEP2.NUM(I1,NL1AUX)
  841.              ICELL=(4*(NSOM1 -1))+1
  842.              XCOUR=MCOORD.XCOOR(ICELL)
  843.              YCOUR=MCOORD.XCOOR(ICELL+1)
  844.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  845.              DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2)
  846.              DIST1 = SQRT( DIST1)
  847.              IF ((DIST1.GT.DIST2)) THEN
  848.                 DIST2 = DIST1
  849.                 ICOURANT = I1
  850.              ENDIF
  851.              ENDDO
  852.              IF (IA.EQ.1) ICOURANT = 3
  853.              IF (IA.EQ.2) ICOURANT = 4
  854.              IF (IA.EQ.3) ICOURANT = 1
  855.              IF (IA.EQ.4) ICOURANT = 2
  856.              IF (NBNO2.EQ.3) THEN
  857.              ICOURANT = 0
  858.              ENDIF
  859.  
  860.  
  861.              NCON = 0
  862.              DO I1 =1,NBNO2
  863.              NSOM1 = MELEP2.NUM(I1,NL1AUX)
  864.              ICELL=(4*(NSOM1 -1))+1
  865.              XCOUR=MCOORD.XCOOR(ICELL)
  866.              YCOUR=MCOORD.XCOOR(ICELL+1)
  867.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  868.              XCO = 0.5D0*(XCOUR + XA)
  869.              YCO = 0.5D0*(YCOUR + YA)
  870.              ZCO = 0.5D0*(ZCOUR + ZA)
  871.              DIST1 = ((XCO-XARG(2,JA))**2) +
  872.      &                ((YCO-YARG(2,JA))**2) +
  873.      &                ((ZCO-ZARG(2,JA))**2)
  874.              DIST1 = SQRT(DIST1)
  875.  
  876.              IF (DIST1.LT.1e-5) THEN
  877.              VAX = XARG(ICOUR,JA)
  878.              VAY = YARG(ICOUR,JA)
  879.              VAZ = ZARG(ICOUR,JA)
  880. C CHANGEMENT INDICE
  881.              XARG(ICOUR,JA) = XCO
  882.              YARG(ICOUR,JA) = YCO
  883.              ZARG(ICOUR,JA) = ZCO
  884.              XARG(2,JA) = VAX
  885.              YARG(2,JA) = VAY
  886.              ZARG(2,JA) = VAZ
  887. c             WRITE(6,*) 'I1= ',I1,' ICI ON AFFECTE P1'
  888.              ENDIF
  889.  
  890.  
  891.              DIST2 = ((XCO-XARG(3,JA))**2) +
  892.      &                 ((YCO-YARG(3,JA))**2) +
  893.      &                 ((ZCO-ZARG(3,JA))**2)
  894.              DIST2 = SQRT(DIST2)
  895.              IF (DIST2.LT.1e-5) THEN
  896.              VAX = XARG(ICOUR,JA)
  897.              VAY = YARG(ICOUR,JA)
  898.              VAZ = ZARG(ICOUR,JA)
  899. C CHANGEMENT INDICE
  900.              XARG(ICOUR,JA) = XCO
  901.              YARG(ICOUR,JA) = YCO
  902.              ZARG(ICOUR,JA) = ZCO
  903.              XARG(3,JA) = VAX
  904.              YARG(3,JA) = VAY
  905.              ZARG(3,JA) = VAZ
  906. c             WRITE(6,*) 'I1= ',I1,' ICI ON AFFECTE P2'
  907.              ENDIF
  908.  
  909.              INDFAC=1
  910. c ON VERIFIE QUE LE POINT TROUVE EST BIEN DIFFERENT DE P2 ET P3
  911.              IF ((I1.NE.ICOURANT).AND.(I1.NE.IA).AND.
  912.      &           (DIST1.GT.1e-5).AND.(DIST2.GT.1e-5)) THEN
  913.               XARG(INDFAC,JA) = XCO
  914.               YARG(INDFAC,JA) = YCO
  915.               ZARG(INDFAC,JA) = ZCO
  916.              NCON = NCON + 1
  917. c        WRITE(6,*) 'JA = ',JA
  918. c        WRITE(6,*) 'XA= ',XA,'YA= ',YA,'ZA= ',ZA
  919. c        WRITE(6,*) 'P1', 'X= ',XARG(1,JA),'Y= ',YARG(1,JA),'Z= ',
  920. c     &   ZARG(1,JA)
  921.              ENDIF
  922.              ENDDO
  923.              IF (NCON.NE.1) THEN
  924.              WRITE(6,*) 'NLCF= ',NLCF,'NCON=',NCON
  925.              WRITE(6,*) 'P2', 'X= ',XARG(2,JA),'Y= ',YARG(2,JA),'Z= ',
  926.      &   ZARG(2,JA)
  927.              WRITE(6,*) 'P3', 'X= ',XARG(3,JA),'Y= ',YARG(3,JA),'Z= ',
  928.      &   ZARG(3,JA)
  929.              DO I1 =1,NBNO2
  930.              NSOM1 = MELEP2.NUM(I1,NL1AUX)
  931.              ICELL=(4*(NSOM1 -1))+1
  932.              XCOUR=MCOORD.XCOOR(ICELL)
  933.              YCOUR=MCOORD.XCOOR(ICELL+1)
  934.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  935.              XCO = 0.5D0*(XCOUR + XA)
  936.              YCO = 0.5D0*(YCOUR + YA)
  937.              ZCO = 0.5D0*(ZCOUR + ZA)
  938.              DIST1 = ((XCO-XARG(2,JA))**2) +
  939.      &                ((YCO-YARG(2,JA))**2) +
  940.      &                ((ZCO-ZARG(2,JA))**2)
  941.              DIST1 = SQRT(DIST1)
  942.              DIST2 = ((XCO-XARG(3,JA))**2) +
  943.      &                ((YCO-YARG(3,JA))**2) +
  944.      &                ((ZCO-ZARG(3,JA))**2)
  945.              DIST2 = SQRT(DIST2)
  946.              WRITE(6,*) 'TEST', 'XCO= ',XCO,'YCO ',YCO,'ZCO= ',
  947.      &       ZCO
  948.              WRITE(6,*) 'DIST1= ',DIST1,'DIST2= ',DIST2
  949.               WRITE(6,*) 'I1= ',I1,'XCOUR= ',XCOUR,
  950.      &       'YCOUR= ',YCOUR,'ZCOUR= ',ZCOUR
  951.              ENDDO
  952.              DIST2 = -100000000000.
  953.              DO I1 =1,NBNO
  954.              NSOM1 = MELEFP.NUM(I1,NLCF1AUX)
  955.              ICELL=(4*(NSOM1 -1))+1
  956.              XCOUR=MCOORD.XCOOR(ICELL)
  957.              YCOUR=MCOORD.XCOOR(ICELL+1)
  958.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  959.               WRITE(6,*) 'I1= ',I1,'XCOUR2= ',XCOUR,
  960.      &       'YCOUR2= ',YCOUR,'ZCOUR2= ',ZCOUR
  961.              DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2)
  962.              DIST1 = SQRT( DIST1)
  963.              IF ((DIST1.GT.DIST2)) THEN
  964.                 DIST2 = DIST1
  965.                 ICOURANT = I1
  966.              ENDIF
  967.               ENDDO
  968.               WRITE(6,*) 'ICOURANT= ',ICOURANT
  969.               WRITE(6,*) 'JA= ',JA
  970.  
  971.               ENDIF
  972.               ENDIF
  973. C ON PERMUTE
  974. C ICI
  975.  
  976.              IF (N1.EQ.NGCF) THEN
  977.              VECXG(1,JA) = (XF - XG)
  978.              VECYG(1,JA) = (YF - YG)
  979.              VECZG(1,JA) = (ZF - ZG)
  980.              XFACG(1,JA) = XF
  981.              YFACG(1,JA) = YF
  982.              ZFACG(1,JA) = ZF
  983.              NLOCFG(1,JA) = N1
  984.              ENDIF
  985.              ENDIF
  986.             ENDDO
  987.          ENDDO
  988. c         IF (NLCF.EQ.14) THEN
  989. c             WRITE(6,*) 'JA= ',JA
  990. c             WRITE(6,*) 'ICOUR= ',ICOUR
  991. c         ENDIF
  992.          ENDDO
  993.  
  994.  
  995.          MELTFA =  IMELEM(NLCD)
  996.          NBF = NBFACEL(NLCD)
  997. c         WRITE(6,*) 'NLCD= ',NLCD
  998. c         WRITE(6,*) 'NBF= ',NBF
  999. c         WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL
  1000.  
  1001.          IF (NLCD.LE.NMAI1) THEN
  1002.          NDAUX = NLCD
  1003.          ELSEIF ((NLCD.GT.NMAI1).AND.(NLCD.LE.(NMAI1+NMAI2))) THEN
  1004.          NDAUX = NLCD - NMAI1
  1005.          ELSEIF ((NLCD.GT.(NMAI1+NMAI2)).AND.
  1006.      &                  (NLCD.LE.(NMAI1+NMAI2+NMAI3))) THEN
  1007.          NDAUX = NLCD - (NMAI1+NMAI2)
  1008.          ELSEIF (NLCD.GT.(NMAI1+NMAI2+NMAI3)) THEN
  1009.          NDAUX = NLCD - (NMAI1+NMAI2+NMAI3)
  1010.          ENDIF
  1011.  
  1012. C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE
  1013.          DO JA = 1,NBNO
  1014.          NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  1015.              ICELL=(4*(NGS(JA) -1))+1
  1016.              XA = MCOORD.XCOOR(ICELL)
  1017.              YA = MCOORD.XCOOR(ICELL+1)
  1018.              ZA = MCOORD.XCOOR(ICELL+2)
  1019.  
  1020.  
  1021. C ON CALCULE P2 ET P3, VOIR RAPPORT PAGE 17
  1022.              DIST2 = -1.e+15
  1023. Con CALCULE LE PLUS GRAND
  1024.              DO I1 =1,NBNO
  1025.              NSOM1 = MELEFP.NUM(I1,NLCF1AUX)
  1026.              ICELL=(4*(NSOM1 -1))+1
  1027.              XCOUR=MCOORD.XCOOR(ICELL)
  1028.              YCOUR=MCOORD.XCOOR(ICELL+1)
  1029.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  1030.              DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2)
  1031.              DIST1 = SQRT( DIST1)
  1032.              IF ((DIST1.GT.DIST2)) THEN
  1033.                 DIST2 = DIST1
  1034.                 ICOURANT = I1
  1035.              ENDIF
  1036.              ENDDO
  1037.              IF (JA.EQ.1) ICOURANT = 3
  1038.              IF (JA.EQ.2) ICOURANT = 4
  1039.              IF (JA.EQ.3) ICOURANT = 1
  1040.              IF (JA.EQ.4) ICOURANT = 2
  1041.              IF (NBNO.EQ.3) THEN
  1042.              ICOURANT = 0
  1043.              ENDIF
  1044.  
  1045.  
  1046.              INDFAC=2
  1047.              DO I1 =1,NBNO
  1048.              NSOM1 = MELEFP.NUM(I1,NLCF1AUX)
  1049.              ICELL=(4*(NSOM1 -1))+1
  1050.              XCOUR=MCOORD.XCOOR(ICELL)
  1051.              YCOUR=MCOORD.XCOOR(ICELL+1)
  1052.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  1053.  
  1054.              IF ((I1.NE.ICOURANT).AND.(I1.NE.JA)) THEN
  1055.               XARD(INDFAC,JA) = 0.5D0*(XA+XCOUR)
  1056.               YARD(INDFAC,JA) = 0.5D0*(YA+YCOUR)
  1057.               ZARD(INDFAC,JA) = 0.5D0*(ZA+ZCOUR)
  1058.              INDFAC= INDFAC+1
  1059.              ENDIF
  1060.              ENDDO
  1061.  
  1062. c         WRITE(6,*) 'NDAUX= ',NDAUX,'JA= ',JA,'NGS= ',NGS(JA)
  1063. c         WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF
  1064.          ICOUR = 1
  1065.          DO J = 1,NBF
  1066.             N1 = MELTFA.NUM(J,NDAUX)
  1067.             NL1 = MLEFA2.LECT(N1)
  1068. c            WRITE(6,*) 'N1= ',N1,'NL1= ',NL1
  1069.  
  1070.              NBNO2 = NBCOTE(NL1)
  1071.              MELEP2 = IMECOTE(NL1)
  1072.              IF (NL1.GT.NFAI1) THEN
  1073.              NL1AUX = NL1  - NFAI1
  1074.              ELSE
  1075.              NL1AUX = NL1
  1076.              ENDIF
  1077.  
  1078.  
  1079.              DO IA =1,NBNO2
  1080.              NSOM1 = MELEP2.NUM(IA,NL1AUX)
  1081. c             WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1
  1082.              IF (NSOM1.EQ.NGS(JA)) THEN
  1083.  
  1084.              ICELL=(4*(N1 -1))+1
  1085.              XF=MCOORD.XCOOR(ICELL)
  1086.              YF=MCOORD.XCOOR(ICELL+1)
  1087.              ZF=MCOORD.XCOOR(ICELL+2)
  1088.  
  1089.  
  1090. C ON CALCULE P1 VOIR RAPPORT p 17
  1091.              IF (N1.NE.NGCF) THEN
  1092.              ICOUR = ICOUR + 1
  1093.              VECXD(ICOUR,JA) = (XF - XD)
  1094.              VECYD(ICOUR,JA) = (YF - YD)
  1095.              VECZD(ICOUR,JA) = (ZF - ZD)
  1096.              NLOCFD(ICOUR,JA) = N1
  1097.              XFACD(ICOUR,JA) = XF
  1098.              YFACD(ICOUR,JA) = YF
  1099.              ZFACD(ICOUR,JA) = ZF
  1100.  
  1101.              DIST2 = -1.e+15
  1102.              DO I1 =1,NBNO2
  1103.              NSOM1 = MELEP2.NUM(I1,NL1AUX)
  1104.              ICELL=(4*(NSOM1 -1))+1
  1105.              XCOUR=MCOORD.XCOOR(ICELL)
  1106.              YCOUR=MCOORD.XCOOR(ICELL+1)
  1107.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  1108.              DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2)
  1109.              DIST1 = SQRT( DIST1)
  1110.              IF ((DIST1.GT.DIST2)) THEN
  1111.                 DIST2 = DIST1
  1112.                 ICOURANT = I1
  1113.              ENDIF
  1114.              ENDDO
  1115.              IF (IA.EQ.1) ICOURANT = 3
  1116.              IF (IA.EQ.2) ICOURANT = 4
  1117.              IF (IA.EQ.3) ICOURANT = 1
  1118.              IF (IA.EQ.4) ICOURANT = 2
  1119. c BUG CORRIGE 15/06
  1120.              IF (NBNO.EQ.3) THEN
  1121.              ICOURANT = 0
  1122.              ENDIF
  1123.  
  1124.  
  1125.              INDFAC=3
  1126.              DO I1 =1,NBNO2
  1127.              NSOM1 = MELEP2.NUM(I1,NL1AUX)
  1128.              ICELL=(4*(NSOM1 -1))+1
  1129.              XCOUR=MCOORD.XCOOR(ICELL)
  1130.              YCOUR=MCOORD.XCOOR(ICELL+1)
  1131.              ZCOUR=MCOORD.XCOOR(ICELL+2)
  1132.              XCO = 0.5D0*(XCOUR + XA)
  1133.              YCO = 0.5D0*(YCOUR + YA)
  1134.              ZCO = 0.5D0*(ZCOUR + ZA)
  1135.              DIST1 = ((XCO-XARD(2,JA))**2) +
  1136.      &                ((YCO-YARD(2,JA))**2) +
  1137.      &                ((ZCO-ZARD(2,JA))**2)
  1138.  
  1139.              DIST1 = SQRT( DIST1)
  1140.              IF (DIST1.LT.1e-5) THEN
  1141.              VAX = XARD(ICOUR,JA)
  1142.              VAY = YARD(ICOUR,JA)
  1143.              VAZ = ZARD(ICOUR,JA)
  1144. C CHANGEMENT INDICE
  1145.              XARD(ICOUR,JA) = XCO
  1146.              YARD(ICOUR,JA) = YCO
  1147.              ZARD(ICOUR,JA) = ZCO
  1148.              XARD(2,JA) = VAX
  1149.              YARD(2,JA) = VAY
  1150.              ZARD(2,JA) = VAZ
  1151.              ENDIF
  1152.  
  1153.  
  1154.              DIST2 = ((XCO-XARD(3,JA))**2) +
  1155.      &                 ((YCO-YARD(3,JA))**2) +
  1156.      &                 ((ZCO-ZARD(3,JA))**2)
  1157.              DIST2 = SQRT( DIST2)
  1158.              IF (DIST2.LT.1e-5) THEN
  1159.              VAX = XARD(ICOUR,JA)
  1160.              VAY = YARD(ICOUR,JA)
  1161.              VAZ = ZARD(ICOUR,JA)
  1162. C CHANGEMENT INDICE
  1163.              XARD(ICOUR,JA) = XCO
  1164.              YARD(ICOUR,JA) = YCO
  1165.              ZARD(ICOUR,JA) = ZCO
  1166.              XARD(3,JA) = VAX
  1167.              YARD(3,JA) = VAY
  1168.              ZARD(3,JA) = VAZ
  1169.              ENDIF
  1170.  
  1171.              INDFAC=1
  1172. c ON VERIFIE QUE LE POINT TROUVE EST BIEN DIFFERENT DE P2 ET P3
  1173.              IF ((I1.NE.ICOURANT).AND.(I1.NE.IA).AND.
  1174.      &           (DIST1.GT.1e-5).AND.(DIST2.GT.1e-5)) THEN
  1175. c              WRITE(6,*) 'ON AFFECTE INDICE 1 ARD'
  1176. c              WRITE(6,*) 'JA= ',JA
  1177.               XARD(INDFAC,JA) = XCO
  1178.               YARD(INDFAC,JA) = YCO
  1179.               ZARD(INDFAC,JA) = ZCO
  1180.              ENDIF
  1181.              ENDDO
  1182.              ENDIF
  1183.  
  1184. C ON PERMUTE
  1185.              IF (N1.EQ.NGCF) THEN
  1186.              VECXD(1,JA) = (XF - XD)
  1187.              VECYD(1,JA) = (YF - YD)
  1188.              VECZD(1,JA) = (ZF - ZD)
  1189.              NLOCFD(1,JA) = N1
  1190.              XFACD(1,JA) = XF
  1191.              YFACD(1,JA) = YF
  1192.              ZFACD(1,JA) = ZF
  1193.              ENDIF
  1194.              ENDIF
  1195.             ENDDO
  1196.          ENDDO
  1197. c             WRITE(6,*) 'JA= ',JA
  1198. c             WRITE(6,*) 'ICOUR= ',ICOUR
  1199.          ENDDO
  1200.  
  1201. CALCUL DES VOLUMES
  1202. c         DO JA = 1,NBNO
  1203. c         DO KA=1,ICOUR
  1204. c         WRITE(6,*)'JA= ',JA,'KA= ',KA
  1205. c         WRITE(6,*) 'VECG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  1206. c         WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA)
  1207. c         ENDDO
  1208. c         ENDDO
  1209.  
  1210.          DO JA = 1,NBNO
  1211. c CALCUL DU VOLUME : ON SOMME LE VOLUME DES 6 TETRAEDRES
  1212.              ICELL=(4*(NGS(JA) -1))+1
  1213.              XA = MCOORD.XCOOR(ICELL)
  1214.              YA = MCOORD.XCOOR(ICELL+1)
  1215.              ZA = MCOORD.XCOOR(ICELL+2)
  1216.  
  1217. c        WRITE(6,*) 'JA = ',JA
  1218. c        WRITE(6,*) 'XA= ',XA,'YA= ',YA,'ZA= ',ZA
  1219. c        WRITE(6,*) 'P2', 'X= ',XARG(2,JA),'Y= ',YARG(2,JA),'Z= ',
  1220. c     &   ZARG(2,JA)
  1221. c        WRITE(6,*) 'P3', 'X= ',XARG(3,JA),'Y= ',YARG(3,JA),'Z= ',
  1222. c     &   ZARG(3,JA)
  1223. c        WRITE(6,*) 'D', 'X= ',XFACG(1,JA),'Y= ',YFACG(1,JA),'Z= ',
  1224. c     &   ZFACG(1,JA)
  1225. c         WRITE(6,*) 'B', 'X= ',XFACG(2,JA),'Y= ',YFACG(2,JA),'Z= ',
  1226. c     &   ZFACG(2,JA)
  1227. c        WRITE(6,*) 'C', 'X= ',XFACG(3,JA),'Y= ',YFACG(3,JA),'Z= ',
  1228. c     &   ZFACG(3,JA)
  1229. c        WRITE(6,*) 'P1', 'X= ',XARG(1,JA),'Y= ',YARG(1,JA),'Z= ',
  1230. c     &   ZARG(1,JA)
  1231. c        WRITE(6,*) 'A', 'X= ',XD,'Y= ',YD,'Z= ',ZD
  1232.  
  1233.              VAUX(1) = XA -  XARG(1,JA)
  1234.              VAUY(1) = YA -  YARG(1,JA)
  1235.              VAUZ(1) = ZA -  ZARG(1,JA)
  1236.  
  1237.              VAUX(2) = XA -  XARG(2,JA)
  1238.              VAUY(2) = YA -  YARG(2,JA)
  1239.              VAUZ(2) = ZA -  ZARG(2,JA)
  1240.  
  1241.              VAUX(3) = XA -  XARG(3,JA)
  1242.              VAUY(3) = YA -  YARG(3,JA)
  1243.              VAUZ(3) = ZA -  ZARG(3,JA)
  1244.  
  1245.              PVECX = VAUY(2)*VAUZ(3) - VAUZ(2)*VAUY(3)
  1246.              PVECY = VAUZ(2)*VAUX(3) - VAUX(2)*VAUZ(3)
  1247.              PVECZ = VAUX(2)*VAUY(3) - VAUY(2)*VAUX(3)
  1248.  
  1249.              VOL =
  1250.      &          1.D0/6.D0*ABS((VAUX(1)*PVECX) + (VAUY(1)*PVECY) +
  1251.      &                    (VAUZ(1)*PVECZ))
  1252.  
  1253.                 VOLUG(JA) = VOL
  1254.  
  1255.  
  1256.           DO KA = 1,ICOUR
  1257. C COMPLETER ICI
  1258. C PRODUIT MIXTES
  1259. C        PRODUIT VECTORIEL
  1260.                 IF (KA.EQ.1) THEN
  1261.  
  1262.                 VAUX(2) = XA -  XARG(2,JA)
  1263.                 VAUY(2) = YA -  YARG(2,JA)
  1264.                 VAUZ(2) = ZA -  ZARG(2,JA)
  1265.  
  1266.                 VAUX(3) = XA -  XARG(3,JA)
  1267.                 VAUY(3) = YA -  YARG(3,JA)
  1268.                 VAUZ(3) = ZA -  ZARG(3,JA)
  1269. c             WRITE(6,*) 'ZA= ',ZA,'ZARG(3)= ',ZARG(3,JA),
  1270. c     &       'DIFF',ZA -  ZARG(3,JA),'VAUXZ3',VAUZ(3)
  1271.  
  1272.  
  1273. c             WRITE(6,*) 'XA= ',XA,'YA= ',YA,'ZA= ',ZA
  1274. c             WRITE(6,*) 'P2', 'X= ',XARG(2,JA),'Y= ',YARG(2,JA),'Z= ',
  1275. c     &        ZARG(2,JA)
  1276. c             WRITE(6,*) 'P3', 'X= ',XARG(3,JA),'Y= ',YARG(3,JA),'Z= ',
  1277. c     &        ZARG(3,JA)
  1278. c             WRITE(6,*) 'D', 'X= ',XFACG(1,JA),'Y= ',YFACG(1,JA),'Z= ',
  1279. c     &        ZFACG(1,JA)
  1280. c             WRITE(6,*) 'JA = ',JA,'KA=',KA,'VAUX2',VAUX(2),
  1281. c     &          'VAUY2',VAUY(2),'VAUZ2',VAUZ(2)
  1282. c             WRITE(6,*) 'ZA= ',ZA,'ZARG(3)= ',ZARG(3,JA),
  1283. c     &       'DIFF',ZA -  ZARG(3,JA),'VAUXZ3',VAUZ(3)
  1284. c             WRITE(6,*) 'JA = ',JA,'KA=',KA,'VAUX3',VAUX(3),
  1285. c     &       'VAUY3',VAUY(3),'VAUZ3',VAUZ(3)
  1286.                PSCAGX = (VAUY(2)*VAUZ(3)) -
  1287.      &         (VAUZ(2)*VAUY(3))
  1288.                PSCAGY = (VAUZ(2)*VAUX(3)) -
  1289.      &          (VAUX(2)*VAUZ(3))
  1290.                PSCAGZ = (VAUX(2)*VAUY(3)) -
  1291.      &          (VAUY(2)*VAUX(3))
  1292.                PSCA = (VECXG(1,JA)* PSCAGX) + (VECYG(1,JA)* PSCAGY) +
  1293.      &              (VECZG(1,JA)* PSCAGZ)
  1294.                IF (PSCA.LT.0) THEN
  1295.                PSCAGX =  - PSCAGX
  1296.                PSCAGY =  - PSCAGY
  1297.                PSCAGZ =  - PSCAGZ
  1298.                ENDIF
  1299.                SURFAGX(KA) = 0.5D0* PSCAGX
  1300.                SURFAGY(KA) = 0.5D0* PSCAGY
  1301.                SURFAGZ(KA) = 0.5D0* PSCAGZ
  1302. c         WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  1303.                ENDIF
  1304.  
  1305.  
  1306.                IF (KA.EQ.2) THEN
  1307.                VAUX(2) = XA -  XARG(2,JA)
  1308.                VAUY(2) = YA -  YARG(2,JA)
  1309.                VAUZ(2) = ZA -  ZARG(2,JA)
  1310.  
  1311.                VAUX(3) = XA -  XARG(1,JA)
  1312.                VAUY(3) = YA -  YARG(1,JA)
  1313.                VAUZ(3) = ZA -  ZARG(1,JA)
  1314.  
  1315.                PSCAGX = (VAUY(2)*VAUZ(3)) -
  1316.      &         (VAUZ(2)*VAUY(3))
  1317.                 PSCAGY = (VAUZ(2)*VAUX(3)) -
  1318.      &          (VAUX(2)*VAUZ(3))
  1319.                 PSCAGZ = (VAUX(2)*VAUY(3)) -
  1320.      &          (VAUY(2)*VAUX(3))
  1321.  
  1322.                 PSCA = (VECXG(2,JA)* PSCAGX) + (VECYG(2,JA)* PSCAGY) +
  1323.      &              (VECZG(2,JA)* PSCAGZ)
  1324.                 IF (PSCA.LT.0) THEN
  1325.                 PSCAGX =  - PSCAGX
  1326.                 PSCAGY =  - PSCAGY
  1327.                 PSCAGZ =  - PSCAGZ
  1328.                 ENDIF
  1329.                 SURFAGX(KA) = 0.5D0* PSCAGX
  1330.                 SURFAGY(KA) = 0.5D0* PSCAGY
  1331.                 SURFAGZ(KA) = 0.5D0* PSCAGZ
  1332.  
  1333.                 ENDIF
  1334.  
  1335.  
  1336.                 IF (KA.EQ.3) THEN
  1337.                 VAUX(2) = XA -  XARG(3,JA)
  1338.                 VAUY(2) = YA -  YARG(3,JA)
  1339.                 VAUZ(2) = ZA -  ZARG(3,JA)
  1340.  
  1341.                 VAUX(3) = XA -  XARG(1,JA)
  1342.                 VAUY(3) = YA -  YARG(1,JA)
  1343.                 VAUZ(3) = ZA -  ZARG(1,JA)
  1344.  
  1345.                 PSCAGX = (VAUY(2)*VAUZ(3)) -
  1346.      &         (VAUZ(2)*VAUY(3))
  1347.                 PSCAGY = (VAUZ(2)*VAUX(3)) -
  1348.      &          (VAUX(2)*VAUZ(3))
  1349.                 PSCAGZ = (VAUX(2)*VAUY(3)) -
  1350.      &          (VAUY(2)*VAUX(3))
  1351.  
  1352.                 PSCA = (VECXG(3,JA)* PSCAGX) + (VECYG(3,JA)* PSCAGY) +
  1353.      &              (VECZG(3,JA)* PSCAGZ)
  1354.                 IF (PSCA.LT.0) THEN
  1355.                 PSCAGX =  - PSCAGX
  1356.                 PSCAGY =  - PSCAGY
  1357.                 PSCAGZ =  - PSCAGZ
  1358.                 ENDIF
  1359.                 SURFAGX(KA) = 0.5D0* PSCAGX
  1360.                 SURFAGY(KA) = 0.5D0* PSCAGY
  1361.                 SURFAGZ(KA) = 0.5D0* PSCAGZ
  1362.                 ENDIF
  1363.  
  1364. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  1365.            IF (ICHTE.EQ.0) THEN
  1366.            COEFG(KA,JA) = ( (SURFAGX(KA)*SCN1X) + (SURFAGY(KA)*SCN1Y) +
  1367.      &               (SURFAGZ(KA)*SCN1Z))
  1368.      &              / (VOLUG(JA))
  1369.  
  1370.            ELSE
  1371. C TENSEUR
  1372.            IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN
  1373.            K11G = MPOTEN.VPOCHA(NLCG,1)
  1374.            K22G = MPOTEN.VPOCHA(NLCG,2)
  1375.            K33G = MPOTEN.VPOCHA(NLCG,3)
  1376.            K21G = MPOTEN.VPOCHA(NLCG,4)
  1377.            K31G = MPOTEN.VPOCHA(NLCG,5)
  1378.            K32G = MPOTEN.VPOCHA(NLCG,6)
  1379.            ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  1380.            K11G = MPOTEN.VPOCHA(NLCG,1)
  1381.            K22G = K11G
  1382.            K33G = K11G
  1383.            K21G = 0.0D0
  1384.            K31G = 0.0D0
  1385.            K32G = 0.0D0
  1386.            ELSE
  1387.            WRITE(6,*) 'TENSEUR NON PREVU'
  1388.            STOP
  1389.            ENDIF
  1390.  
  1391.            PSCAGX = (K11G*SURFAGX(KA)) + (K21G*SURFAGY(KA)) +
  1392.      &     (K31G*SURFAGZ(KA))
  1393.            PSCAGY = (K21G*SURFAGX(KA)) + (K22G*SURFAGY(KA)) +
  1394.      &     (K32G*SURFAGZ(KA))
  1395.            PSCAGZ = (K31G*SURFAGX(KA)) + (K32G*SURFAGY(KA)) +
  1396.      &     (K33G*SURFAGZ(KA))
  1397.            COEFG(KA,JA) =  (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) +
  1398.      &     (PSCAGZ*SCN1Z)
  1399.            COEFG(KA,JA) = COEFG(KA,JA)  / (VOLUG(JA))
  1400.            ENDIF
  1401. c         WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA)  = ',VOLUG(JA)
  1402. c         WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA)
  1403. c         WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  1404. c         WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1405.           ENDDO
  1406. c         WRITE(6,*) 'JA = ',JA,'VOLUG(JA)  = ',VOLUG(JA)
  1407. c         WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA)
  1408. c         WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA)
  1409. c         WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA)
  1410. c         WRITE(6,*)'NLCF= ',NLCF,'COEFG = ',
  1411. c     &   COEFG(1,JA),COEFG(2,JA),COEFG(3,JA)
  1412. c         WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1413. c         WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  1414. c         WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2)
  1415. c         WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3)
  1416.  
  1417. c         WRITE(6,*) 'JA = ',JA,'VOLUG(JA)  = ',VOLUG(JA)
  1418. c         WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA)
  1419. c         WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA)
  1420. c         WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA)
  1421. c         WRITE(6,*)'NLCF= ',NLCF,'COEFG = ',
  1422. c     &   COEFG(1,JA),COEFG(2,JA),COEFG(3,JA)
  1423. c         WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1424. c         WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  1425. c         WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2)
  1426. c         WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3)
  1427.          ENDDO
  1428. CALCUL DES VOLUMES
  1429.  
  1430.          DO JA = 1,NBNO
  1431.             NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  1432.             NLS(JA)=MLESOM.LECT(NGS(JA))
  1433.  
  1434.              ICELL=(4*(NGS(JA) -1))+1
  1435.              XA = MCOORD.XCOOR(ICELL)
  1436.              YA = MCOORD.XCOOR(ICELL+1)
  1437.              ZA = MCOORD.XCOOR(ICELL+2)
  1438.  
  1439.              VAUX(1) = XA -  XARD(1,JA)
  1440.              VAUY(1) = YA -  YARD(1,JA)
  1441.              VAUZ(1) = ZA -  ZARD(1,JA)
  1442.  
  1443.              VAUX(2) = XA -  XARD(2,JA)
  1444.              VAUY(2) = YA -  YARD(2,JA)
  1445.              VAUZ(2) = ZA -  ZARD(2,JA)
  1446.  
  1447.              VAUX(3) = XA -  XARD(3,JA)
  1448.              VAUY(3) = YA -  YARD(3,JA)
  1449.              VAUZ(3) = ZA -  ZARD(3,JA)
  1450.  
  1451.              PVECX = VAUY(2)*VAUZ(3) - VAUZ(2)*VAUY(3)
  1452.              PVECY = VAUZ(2)*VAUX(3) - VAUX(2)*VAUZ(3)
  1453.              PVECZ = VAUX(2)*VAUY(3) - VAUY(2)*VAUX(3)
  1454.  
  1455.              VOL =
  1456.      &          1.D0/6.D0*ABS((VAUX(1)*PVECX) + (VAUY(1)*PVECY) +
  1457.      &                    (VAUZ(1)*PVECZ))
  1458.  
  1459. c             WRITE(6,*) 'XA= ',XA,'XARD(1)= ',XARD(1,JA)
  1460. c             WRITE(6,*) 'YA= ',YA,'YARD(1)= ',YARD(1,JA)
  1461. c             WRITE(6,*) 'ZA= ',ZA,'ZARD(1)= ',ZARD(1,JA)
  1462.  
  1463. c             WRITE(6,*) 'XA= ',XA,'XARD(2)= ',XARD(2,JA)
  1464. c             WRITE(6,*) 'YA= ',YA,'YARD(2)= ',YARD(2,JA)
  1465. c             WRITE(6,*) 'ZA= ',ZA,'ZARD(2)= ',ZARD(2,JA)
  1466.  
  1467. c             WRITE(6,*) 'XA= ',XA,'XARD(3)= ',XARD(3,JA)
  1468. c             WRITE(6,*) 'YA= ',YA,'YARD(3)= ',YARD(3,JA)
  1469. c             WRITE(6,*) 'ZA= ',ZA,'ZARD(3)= ',ZARD(3,JA)
  1470.  
  1471. c             WRITE(6,*) 'VAUX(1)= ',VAUX(1)
  1472. c             WRITE(6,*) 'VAUY(1)= ',VAUY(1)
  1473. c             WRITE(6,*) 'VAUZ(1)= ',VAUZ(1)
  1474.  
  1475. c             WRITE(6,*) 'VAUX(2)= ',VAUX(2)
  1476. c             WRITE(6,*) 'VAUY(2)= ',VAUY(2)
  1477. c             WRITE(6,*) 'VAUZ(2)= ',VAUZ(2)
  1478.  
  1479. c             WRITE(6,*) 'VAUX(3)= ',VAUX(3)
  1480. c             WRITE(6,*) 'VAUY(3)= ',VAUY(3)
  1481. c             WRITE(6,*) 'VAUZ(3)= ',VAUZ(3)
  1482.  
  1483. c CALCUL DU PREMIER VOLUME
  1484.                 VOLUD(JA) = VOL
  1485.  
  1486.  
  1487.           DO KA = 1,ICOUR
  1488. C COMPLETER ICI
  1489. C PRODUIT MIXTES
  1490. C        PRODUIT VECTORIEL
  1491.                 IF (KA.EQ.1) THEN
  1492.  
  1493.                 VAUX(2) = XA -  XARD(2,JA)
  1494.                 VAUY(2) = YA -  YARD(2,JA)
  1495.                 VAUZ(2) = ZA -  ZARD(2,JA)
  1496.  
  1497.                 VAUX(3) = XA -  XARD(3,JA)
  1498.                 VAUY(3) = YA -  YARD(3,JA)
  1499.                 VAUZ(3) = ZA -  ZARD(3,JA)
  1500.  
  1501.                 PSCADX = (VAUY(2)*VAUZ(3)) -
  1502.      &         (VAUZ(2)*VAUY(3))
  1503.                 PSCADY = (VAUZ(2)*VAUX(3)) -
  1504.      &          (VAUX(2)*VAUZ(3))
  1505.                 PSCADZ = (VAUX(2)*VAUY(3)) -
  1506.      &          (VAUY(2)*VAUX(3))
  1507.                 PSCA = (VECXD(1,JA)* PSCADX) + (VECYD(1,JA)* PSCADY) +
  1508.      &              (VECZD(1,JA)* PSCADZ)
  1509.                 IF (PSCA.LT.0) THEN
  1510.                 PSCADX =  - PSCADX
  1511.                 PSCADY =  - PSCADY
  1512.                 PSCADZ =  - PSCADZ
  1513.                 ENDIF
  1514.                 SURFADX(KA) = 0.5D0* PSCADX
  1515.                 SURFADY(KA) = 0.5D0* PSCADY
  1516.                 SURFADZ(KA) = 0.5D0* PSCADZ
  1517.  
  1518.  
  1519.                 ENDIF
  1520.  
  1521.                 IF (KA.EQ.2) THEN
  1522.                 VAUX(2) = XA -  XARD(2,JA)
  1523.                 VAUY(2) = YA -  YARD(2,JA)
  1524.                 VAUZ(2) = ZA -  ZARD(2,JA)
  1525.  
  1526.                 VAUX(3) = XA -  XARD(1,JA)
  1527.                 VAUY(3) = YA -  YARD(1,JA)
  1528.                 VAUZ(3) = ZA -  ZARD(1,JA)
  1529.  
  1530.                 PSCADX = (VAUY(2)*VAUZ(3)) -
  1531.      &         (VAUZ(2)*VAUY(3))
  1532.                 PSCADY = (VAUZ(2)*VAUX(3)) -
  1533.      &          (VAUX(2)*VAUZ(3))
  1534.                 PSCADZ = (VAUX(2)*VAUY(3)) -
  1535.      &          (VAUY(2)*VAUX(3))
  1536.  
  1537.                 PSCA = (VECXD(2,JA)* PSCADX) + (VECYD(2,JA)* PSCADY) +
  1538.      &              (VECZD(2,JA)* PSCADZ)
  1539.                 IF (PSCA.LT.0) THEN
  1540.                 PSCADX =  - PSCADX
  1541.                 PSCADY =  - PSCADY
  1542.                 PSCADZ =  - PSCADZ
  1543.                 ENDIF
  1544.                 SURFADX(KA) = 0.5D0* PSCADX
  1545.                 SURFADY(KA) = 0.5D0* PSCADY
  1546.                 SURFADZ(KA) = 0.5D0* PSCADZ
  1547.  
  1548.                 ENDIF
  1549.  
  1550.  
  1551.                 IF (KA.EQ.3) THEN
  1552.                 VAUX(2) = XA -  XARD(3,JA)
  1553.                 VAUY(2) = YA -  YARD(3,JA)
  1554.                 VAUZ(2) = ZA -  ZARD(3,JA)
  1555.  
  1556.                 VAUX(3) = XA -  XARD(1,JA)
  1557.                 VAUY(3) = YA -  YARD(1,JA)
  1558.                 VAUZ(3) = ZA -  ZARD(1,JA)
  1559.  
  1560.                 PSCADX = (VAUY(2)*VAUZ(3)) -
  1561.      &         (VAUZ(2)*VAUY(3))
  1562.                 PSCADY = (VAUZ(2)*VAUX(3)) -
  1563.      &          (VAUX(2)*VAUZ(3))
  1564.                 PSCADZ = (VAUX(2)*VAUY(3)) -
  1565.      &          (VAUY(2)*VAUX(3))
  1566.  
  1567.                 PSCA = (VECXD(3,JA)* PSCADX) + (VECYD(3,JA)* PSCADY) +
  1568.      &              (VECZD(3,JA)* PSCADZ)
  1569.                 IF (PSCA.LT.0) THEN
  1570.                 PSCADX =  - PSCADX
  1571.                 PSCADY =  - PSCADY
  1572.                 PSCADZ =  - PSCADZ
  1573.                 ENDIF
  1574.                 SURFADX(KA) = 0.5D0* PSCADX
  1575.                 SURFADY(KA) = 0.5D0* PSCADY
  1576.                 SURFADZ(KA) = 0.5D0* PSCADZ
  1577.  
  1578.                 ENDIF
  1579. c          WRITE(6,*) 'NLCF=',NLCF
  1580. c          WRITE(6,*) 'NLCD=',NLCD
  1581. c          WRITE(6,*) 'NLCD=',NLCG
  1582. c          WRite(6,*) 'AG1=',AG1
  1583. c          WRite(6,*) 'AG2=',AG2
  1584. c          WRite(6,*) 'AD1=',AD1
  1585. c          WRite(6,*) 'AD2=',AD2
  1586. c          WRite(6,*) 'PSCAG1=',PSCAG1
  1587. c          WRite(6,*) 'PSCAG2=',PSCAG2
  1588. c          WRite(6,*) 'PSCAD1=',PSCAD1
  1589. c          WRite(6,*) 'PSCAD2=',PSCAD2
  1590. c          WRite(6,*) 'COEF1D=',COEF1D
  1591. c          WRite(6,*) 'COEF2D=',COEF2D
  1592. c          WRite(6,*) 'BETA1GD=',BETA1GD
  1593. c          WRite(6,*) 'BETA2GD=',BETA2GD
  1594. c          WRite(6,*) 'INDD2=',INDD2
  1595.  
  1596. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  1597.            IF (ICHTE.EQ.0) THEN
  1598.            COEFD(KA,JA) = ( (SURFADX(KA)*SCN1X) + (SURFADY(KA)*SCN1Y) +
  1599.      &               (SURFADZ(KA)*SCN1Z))
  1600.      &              / (VOLUD(JA))
  1601.  
  1602.            ELSE
  1603. C TENSEUR
  1604.            IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN
  1605.            K11D = MPOTEN.VPOCHA(NLCD,1)
  1606.            K22D = MPOTEN.VPOCHA(NLCD,2)
  1607.            K33D = MPOTEN.VPOCHA(NLCD,3)
  1608.            K21D = MPOTEN.VPOCHA(NLCD,4)
  1609.            K31D = MPOTEN.VPOCHA(NLCD,5)
  1610.            K32D = MPOTEN.VPOCHA(NLCD,6)
  1611.            ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  1612.            K11D = MPOTEN.VPOCHA(NLCD,1)
  1613.            K22D = K11D
  1614.            K33D = K11D
  1615.            K21D = 0.0D0
  1616.            K31D = 0.0D0
  1617.            K32D = 0.0D0
  1618.            ELSE
  1619.            WRITE(6,*) 'TENSEUR NON PREVU'
  1620.            STOP
  1621.            ENDIF
  1622.  
  1623.            PSCADX = (K11D*SURFADX(KA)) + (K21D*SURFADY(KA)) +
  1624.      &     (K31D*SURFADZ(KA))
  1625.            PSCADY = (K21D*SURFADX(KA)) + (K22D*SURFADY(KA)) +
  1626.      &     (K32D*SURFADZ(KA))
  1627.            PSCADZ = (K31D*SURFADX(KA)) + (K32D*SURFADY(KA)) +
  1628.      &     (K33D*SURFADZ(KA))
  1629.            COEFD(KA,JA) =  (PSCADX*SCN1X) + (PSCADY*SCN1Y)
  1630.      &     + (PSCADZ*SCN1Z)
  1631.            COEFD(KA,JA) = COEFD(KA,JA)  / (VOLUD(JA))
  1632.            ENDIF
  1633. c         WRITE(6,*) 'JA = ',JA,'KA= ',KA,'VOLUD(JA)  = ',VOLUD(JA)
  1634. c         WRITE(6,*)'SURFAD = ',SURFADX(KA),SURFADY(KA),SURFADZ(KA)
  1635. c         WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA)
  1636.            ENDDO
  1637.  
  1638. c         WRITE(6,*) 'JA = ',JA,'VOLUD(JA)  = ',VOLUD(JA)
  1639. c         WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA)
  1640. c         WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA)
  1641. c         WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA)
  1642. c         WRITE(6,*)'NLCF= ',NLCF,'COEFD = ',
  1643. c     &   COEFD(1,JA),COEFD(2,JA),COEFD(3,JA)
  1644. c         WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1645. c         WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1)
  1646. c         WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2)
  1647. c         WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3)
  1648.  
  1649.          ENDDO
  1650. CALCUL DES VOLUMES
  1651.  
  1652. c         WRITE(6,*) 'NLCF= ',NLCF
  1653. c         WRITE(6,*) 'NGCF= ',NGCF
  1654. c         WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G
  1655. c         WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D
  1656.          DO JA = 1,NBNO
  1657.  
  1658.          XX1 = ABS(COEFG(1,JA))
  1659.          XX2 = ABS(COEFD(1,JA))
  1660.          IF ((XX1.LT.1e-8) .OR.(XX2.LT.1E-8)) THEN
  1661.          INDICE = 1
  1662.          ENDIF
  1663.  
  1664.                MARQ = 0
  1665.                DO I5 = 1,INDLI.ID(NLS(JA))
  1666.                INDAUX = IND2.NUME(I5,NLS(JA))
  1667.                IF (INDAUX.EQ.NGCF) THEN
  1668.                MARQ = 1
  1669.                IAFF = I5
  1670.                GOTO 4
  1671.                ENDIF
  1672.                ENDDO
  1673.  4              CONTINUE
  1674.  
  1675.  
  1676.                IF (MARQ.EQ.0) THEN
  1677.                INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1678.                ICOU = INDLI.ID(NLS(JA))
  1679.                IND2.NUME(ICOU,NLS(JA)) = NGCF
  1680.                ELSE
  1681.                ICOU = IAFF
  1682.                ENDIF
  1683.  
  1684.  
  1685.                COEF = COEFG(1,JA)-COEFD(1,JA)
  1686.                MATR1 = IPO2.POINT(NLS(JA))
  1687. c               SEGINI MATR1
  1688.                SEGACT MATR1 *MOD
  1689.                MATR1.MAT2(ICOU,ICOU) =  COEF
  1690.  
  1691.                MARQ = 0
  1692.                DO I5 = 1,INDLI.ID(NLS(JA))
  1693.                INDAUX = IND2.NUME(I5,NLS(JA))
  1694.                IF (INDAUX.EQ.NLOCFG(2,JA)) THEN
  1695.                MARQ = 1
  1696.                IAFF = I5
  1697.                GOTO 5
  1698.                ENDIF
  1699.                ENDDO
  1700.  5              CONTINUE
  1701.  
  1702.  
  1703.                 IF (MARQ.EQ.0) THEN
  1704.                 INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1705.                 ICOUCO = INDLI.ID(NLS(JA))
  1706.                 IND2.NUME(ICOUCO,NLS(JA)) =  NLOCFG(2,JA)
  1707.                 ELSE
  1708.                 ICOUCO = IAFF
  1709.                 ENDIF
  1710.                 ICOUG2 = ICOUCO
  1711.  
  1712.  
  1713.                MATR1.MAT2(ICOU,ICOUCO) = COEFG(2,JA)
  1714.  
  1715.                MARQ = 0
  1716.                DO I5 = 1,INDLI.ID(NLS(JA))
  1717.                INDAUX = IND2.NUME(I5,NLS(JA))
  1718.                IF (INDAUX.EQ.NLOCFG(3,JA)) THEN
  1719.                MARQ = 1
  1720.                IAFF = I5
  1721.                GOTO 6
  1722.                ENDIF
  1723.                ENDDO
  1724.  6              CONTINUE
  1725.  
  1726.  
  1727.                 IF (MARQ.EQ.0) THEN
  1728.                 INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1729.                 ICOUCO = INDLI.ID(NLS(JA))
  1730.                 IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(3,JA)
  1731.                 ELSE
  1732.                 ICOUCO = IAFF
  1733.                 ENDIF
  1734.                 ICOUG3 = ICOUCO
  1735.                 MATR1.MAT2(ICOU,ICOUCO) = COEFG(3,JA)
  1736.  
  1737.  
  1738.                MARQ = 0
  1739.                DO I5 = 1,INDLI.ID(NLS(JA))
  1740.                INDAUX = IND2.NUME(I5,NLS(JA))
  1741.                IF (INDAUX.EQ.NLOCFD(2,JA)) THEN
  1742.                MARQ = 1
  1743.                IAFF = I5
  1744.                GOTO 59
  1745.                ENDIF
  1746.                ENDDO
  1747.  59              CONTINUE
  1748.  
  1749.  
  1750.                 IF (MARQ.EQ.0) THEN
  1751.                 INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1752.                 ICOUCO = INDLI.ID(NLS(JA))
  1753.                 IND2.NUME(ICOUCO,NLS(JA)) =  NLOCFD(2,JA)
  1754.                 ELSE
  1755.                 ICOUCO = IAFF
  1756.                 ENDIF
  1757.                 ICOUD2 = ICOUCO
  1758.  
  1759.  
  1760.                 MATR1.MAT2(ICOU,ICOUCO) =  - COEFD(2,JA)
  1761.  
  1762.                MARQ = 0
  1763.                DO I5 = 1,INDLI.ID(NLS(JA))
  1764.                INDAUX = IND2.NUME(I5,NLS(JA))
  1765.                IF (INDAUX.EQ.NLOCFD(3,JA)) THEN
  1766.                MARQ = 1
  1767.                IAFF = I5
  1768.                GOTO 69
  1769.                ENDIF
  1770.                ENDDO
  1771.  69              CONTINUE
  1772.  
  1773.  
  1774.                 IF (MARQ.EQ.0) THEN
  1775.                 INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1776.                 ICOUCO = INDLI.ID(NLS(JA))
  1777.                 IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(3,JA)
  1778.                 ELSE
  1779.                 ICOUCO = IAFF
  1780.                 ENDIF
  1781.                 ICOUD3 = ICOUCO
  1782.                 MATR1.MAT2(ICOU,ICOUCO) = - COEFD(3,JA)
  1783.  
  1784. c ON EST ICI
  1785.  
  1786.            SCMB.MAT(ICOU,NLS(JA)) =
  1787.      &    ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))
  1788.      &     *ALPHA*MPOCHP.VPOCHA(NLCG,1))  -
  1789.      &    ((COEFD(1,JA)+COEFD(2,JA)+COEFD(3,JA))*
  1790.      &     ALPHA*MPOCHP.VPOCHA(NLCD,1))
  1791. c           SCMB.MAT(ICOU,NLS(JA)) = COEF* SCMB.MAT(ICOU,NLS(JA))
  1792.  
  1793.  
  1794. c          NLS1 = NLS(JA)
  1795. c       WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1796. c     &   'SCMB', SCMB.MAT(ICOU,NLS1),
  1797. c     &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF,
  1798. c     &  'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2),
  1799. c     &  'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3),
  1800. c     &  'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2),
  1801. c     &  'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3)
  1802. * ON EST ICI
  1803. * IL FAUT VERIFIER CE QUI EST AVANT
  1804.  
  1805.  
  1806. * COEF POUR INVERSER LA MATRICE
  1807.  
  1808. * ON CORRIGE ICI
  1809.             VAL1.MAT(ICOU,NLS(JA)) =
  1810.      &     ALPHA*(COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1811. c           VAL1.MAT(ICOU,NLS(JA)) = COEF*VAL1.MAT(ICOU,NLS(JA))
  1812.             VAL2.MAT(ICOU,NLS(JA)) =
  1813.      &      - (ALPHA*(COEFD(1,JA) + COEFD(2,JA) + COEFD(3,JA)))
  1814. c           VAL2.MAT(ICOU,NLS(JA)) = COEF*VAL2.MAT(ICOU,NLS(JA))
  1815.             IND.NUME(ICOU,NLS(JA)) = NGCG
  1816.             IND22.NUME(ICOU,NLS(JA)) = NGCD
  1817.  
  1818. * CONDITION AUX LIMITE DE DIRICICHLET
  1819.            IF (NGCG.EQ.NGCD) THEN
  1820.            NLFCL=MLENCL.LECT(NGCF)
  1821.            IF (NLFCL.GT.0) THEN
  1822. c           WRITE(6,*) 'NLCF= ',NLCF
  1823. c           WRITE(6,*) 'NGCF= ',NGCF
  1824. c           WRITE(6,*) 'VAL=',MPOVCL.VPOCHA(NLFCL,1)
  1825.            COEF = MAX(ABS(COEFG(1,JA)),ABS(COEFG(2,JA)))
  1826.            COEF = MAX(COEF,ABS(COEFG(3,JA)))
  1827.            MATR1.MAT2(ICOU,ICOU) =   COEF
  1828.            MATR1.MAT2(ICOU,ICOUG2) = 0.0D0
  1829.            MATR1.MAT2(ICOU,ICOUG3) = 0.0D0
  1830.            MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1831.            MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1832. c ICI
  1833.            SCMB.MAT(ICOU,NLS(JA)) = (COEF*ALPHA*MPOVCL.VPOCHA(NLFCL,1))
  1834.                VAL1.MAT(ICOU,NLS(JA)) = 0.D0
  1835.                VAL2.MAT(ICOU,NLS(JA)) =  ALPHA*COEF
  1836. c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN
  1837.                IND.NUME(ICOU,NLS(JA)) = NGCG
  1838.                IND22.NUME(ICOU,NLS(JA)) = NGCF
  1839.            ELSE
  1840.            NLFNE=MLENNE.LECT(NGCF)
  1841.  
  1842. c CONDITION DE FLUX
  1843.            IF (NLFNE.GT.0) THEN
  1844.            QIMPX = MPOVNE.VPOCHA(NLFNE,1)
  1845. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1846.            QIMPS = (QIMPX)
  1847.            QIMPS = -QIMPS
  1848. c           WRITE(6,*) 'NGCF= ',NGCF
  1849. c           WRITE(6,*) 'QIMPS= ',QIMPS
  1850.  
  1851.            COEF = COEFG(1,JA)
  1852.            MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1853.            MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1854.            MATR1.MAT2(ICOU,ICOU) =    COEF
  1855.            MATR1.MAT2(ICOU,ICOUG2) =  COEFG(2,JA)
  1856.            MATR1.MAT2(ICOU,ICOUG3) =  COEFG(3,JA)
  1857.  
  1858.            SCMB.MAT(ICOU,NLS(JA)) =
  1859.      &     ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1))
  1860.      &      + (QIMPS)
  1861.             VAL1.MAT(ICOU,NLS(JA)) =
  1862.      &      (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1863.                VAL2.MAT(ICOU,NLS(JA)) =  1.D0
  1864.                IND.NUME(ICOU,NLS(JA)) = NGCG
  1865.                IND22.NUME(ICOU,NLS(JA)) = NGCF
  1866.           NLS1 = NLS(JA)
  1867. c       WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1868. c     &   'SCMB', SCMB.MAT(ICOU,NLS1)
  1869. c       WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1870. c     &             'IND= ',IND.NUME(ICOU,NLS1),
  1871. c     &                  'IND22= ',IND22.NUME(ICOU,NLS1),
  1872. c     &   'SCMB', SCMB.MAT(ICOU,NLS1),
  1873. c     &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  1874. c     &  'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1),
  1875. c     &  'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1),
  1876. c     &  'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1),
  1877. c     &  'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1)
  1878.  
  1879.            ELSE
  1880. c CONDITION MIXTE
  1881.            NLFMI=MLENMI.LECT(NGCF)
  1882.            IF (NLFMI.GT.0) THEN
  1883.            XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1)
  1884.            XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2)
  1885.            QIMPX = MPOVMI.VPOCHA(NLFMI,3)
  1886.  
  1887. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1888.            QIMPS = (QIMPX)
  1889.            QIMPS= - QIMPS
  1890.  
  1891. c           WRITE(6,*) 'NLCF= ',NLCF
  1892. c           WRITE(6,*) 'NGCF= ',NGCF
  1893. c           WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2
  1894.            COEF = COEFG(1,JA)
  1895. c           WRITE(6,*) 'COEF= ',COEF
  1896. c           WRITE(6,*) 'COEF= ',COEF,'QIMPS= ',QIMPS
  1897.            MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1898.            MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1899.            MATR1.MAT2(ICOU,ICOU) =  (XLAMBDA1*COEF) +
  1900.      &      (1.D0*XLAMBDA2)
  1901.            MATR1.MAT2(ICOU,ICOUG2) =  (XLAMBDA1*COEFG(2,JA))
  1902.            MATR1.MAT2(ICOU,ICOUG3) =  (XLAMBDA1*COEFG(3,JA))
  1903. c ON EST ICI
  1904.            SCMB.MAT(ICOU,NLS(JA)) =
  1905.      &     (XLAMBDA1*((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*
  1906.      &      MPOCHP.VPOCHA(NLCG,1)))
  1907.      &      + (1.D0*QIMPS)
  1908.             VAL1.MAT(ICOU,NLS(JA)) = XLAMBDA1*
  1909.      &      (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1910.             VAL2.MAT(ICOU,NLS(JA)) =  1.D0
  1911.             IND.NUME(ICOU,NLS(JA)) = NGCG
  1912.             IND22.NUME(ICOU,NLS(JA)) = NGCF
  1913.           NLS1 = NLS(JA)
  1914. c       WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1915. c     &             'IND= ',IND.NUME(ICOU,NLS1),
  1916. c     &                  'IND22= ',IND22.NUME(ICOU,NLS1),
  1917. c     &   'SCMB', SCMB.MAT(ICOU,NLS1),
  1918. c     &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  1919. c     &  'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1),
  1920. c     &  'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1),
  1921. c     &  'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1),
  1922. c     &  'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1)
  1923.            ELSE
  1924. C PAR DEFAUT FLUX NUL
  1925.            QIMPS = 0
  1926.            COEF = COEFG(1,JA)
  1927.            MATR1.MAT2(ICOU,ICOU) =  COEF
  1928.            MATR1.MAT2(ICOU,ICOUG2) =  COEFG(2,JA)
  1929.            MATR1.MAT2(ICOU,ICOUG3) =  COEFG(3,JA)
  1930.            SCMB.MAT(ICOU,NLS(JA)) =
  1931.      &    ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1))
  1932.            VAL1.MAT(ICOU,NLS(JA)) =
  1933.      &     (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1934.            VAL2.MAT(ICOU,NLS(JA)) =  0.D0
  1935.            IND.NUME(ICOU,NLS(JA)) = NGCG
  1936.            IND22.NUME(ICOU,NLS(JA)) = NGCD
  1937.            ENDIF
  1938.  
  1939.            ENDIF
  1940.  
  1941.            ENDIF
  1942.            ENDIF
  1943.  
  1944. c       WRITE(6,*) 'COEF1 = ',COEFGG,'COEF2= ',COEF2,'COEF3= ',
  1945. c     &  COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1),
  1946. c     &   'HD= ',MPOCHP.VPOCHA(NLCD,1)
  1947.  
  1948.          NAUX1 = MAX(NAUX1,INDLI.ID(NLS(JA)))
  1949. c        WRITE(6,*) 'NLCF= ',NLCF,'NAUX1 = ',NAUX1
  1950. c        WRITE(6,*) 'NLS= ',NLS(JA),'NGS= ',NGS(JA),
  1951. c     &             'INDLI.ID',INDLI.ID(NLS(JA))
  1952. c        WRITE(6,*) 'JA= ',JA
  1953. c        WRITE(6,*) 'NLOCFG= ',NLOCFG(1,JA),NLOCFG(2,JA),NLOCFG(3,JA)
  1954. c        WRITE(6,*) 'NLOCFD= ',NLOCFD(1,JA),NLOCFD(2,JA),NLOCFD(3,JA)
  1955. c               DO I5 = 1,INDLI.ID(NLS(JA))
  1956. c               INDAUX = IND2.NUME(I5,NLS(JA))
  1957. c               WRITE(6,*) 'I5= ','JA= ','NLS= ',NLS(JA),
  1958. c     &                    'IND2= ',IND2.NUME(I5,NLS(JA))
  1959. c               ENDDO
  1960.  
  1961. C ON DESACTIVE (FIN DE LA BOUCLE SUR LES POINTS)
  1962. c               SEGDES MATRICE2
  1963. c               SEGACT MATRICE2
  1964.           NLS1 = NLS(JA)
  1965.          IF (ABS(COEF).LT. (-1.D0)) THEN
  1966.            NLFCL=MLENCL.LECT(NGCF)
  1967.           WRITE(6,*) 'CLIMD = ',NLFCL
  1968.           NLFNE=MLENNE.LECT(NGCF)
  1969.           WRITE(6,*) 'CLIMN = ',NLFNE
  1970.           WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1971.      &   'SCMB', SCMB.MAT(ICOU,NLS1),
  1972.      &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF,
  1973.      &  'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2),
  1974.      &  'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3),
  1975.      &  'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2),
  1976.      &  'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3),
  1977.      &   'COEFG1JA', COEFG(1,JA),'COEFD1JA',COEFD(1,JA)
  1978.  
  1979. c         WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA)  = ',VOLUG(JA)
  1980. c         WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA)
  1981. c         WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  1982.          WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1983.          WRITE(6,*) 'JA = ',JA,'VOLUG(JA)  = ',VOLUG(JA)
  1984.          WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA)
  1985.          WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA)
  1986.          WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA)
  1987.          WRITE(6,*)'NLCF= ',NLCF,'COEFG = ',
  1988.      &   COEFG(1,JA),COEFG(2,JA),COEFG(3,JA)
  1989.          WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1990.          WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  1991.          WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2)
  1992.          WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3)
  1993.  
  1994.          WRITE(6,*) 'JA = ',JA,'VOLUD(JA)  = ',VOLUD(JA)
  1995.          WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA)
  1996.          WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA)
  1997.          WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA)
  1998.          WRITE(6,*)'NLCF= ',NLCF,'COEFD = ',
  1999.      &   COEFD(1,JA),COEFD(2,JA),COEFD(3,JA)
  2000.          WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  2001.          WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1)
  2002.          WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2)
  2003.          WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3)
  2004.          WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G
  2005.          WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D
  2006.  
  2007.          ENDIF
  2008.  
  2009.                 SEGDES MATR1 * MOD
  2010.  
  2011.         ENDDO
  2012.  
  2013.  
  2014.  
  2015. c         IF (INDICE.EQ.1) THEN
  2016. c         WRITE(6,*)'NLCF= ',NLCF,'COEFG(1) OU COEFD(1) TRES PETIT'
  2017. c         ENDIF
  2018.         ENDDO
  2019.  
  2020.  
  2021.         IF (NAUX1.GT.NBMAX) THEN
  2022.         WRITE(6,*) 'ERREUR DANS LES PARAMETRES'
  2023. c        STOP
  2024.         ENDIF
  2025. c             DO J= 1,INDLI.ID(NLS1)
  2026. c             WRITE(6,*)  'MELVA1=',MELVA1.VELCHE(J,NLCF)
  2027. c             WRITE(6,*)  'MELVA2=',MELVA1.VELCHE(J,NLCF)
  2028. c             WRITE(6,*)  'MELEME=',MELEME.NUM(J,NLCF)
  2029. c             ENDDO
  2030.  
  2031.       MELTFA = MAUX
  2032.       MELEFP = MAUX2
  2033.       IF (NBSO.EQ.2) THEN
  2034.       SEGDES IPT1
  2035.       SEGDES IPT2
  2036.       ELSEIF (NBSO.EQ.3) THEN
  2037.       SEGDES IPT1
  2038.       SEGDES IPT2
  2039.       SEGDES IPT3
  2040.       ELSEIF (NBSO.EQ.4) THEN
  2041.       SEGDES IPT1
  2042.       SEGDES IPT2
  2043.       SEGDES IPT3
  2044.       SEGDES IPT4
  2045.       ENDIF
  2046.       IF (NBSOF.EQ.2) THEN
  2047.       SEGDES IPT5
  2048.       SEGDES IPT6
  2049.       ENDIF
  2050.  
  2051. c      MAUX = MELEFP
  2052. c      MELEFP = IMECOTE(1)
  2053. c      NGCF=MELEFP.NUM(4,1)
  2054. c      WRITE(6,*) 'NGCF= ',NGCF
  2055. c      MELEFP = MAUX
  2056.  
  2057. c      DO NLS1=1,NSOMM,1
  2058. c          MATR1 =  IPO2.POINT(NLS1)
  2059. c          SEGACT MATR1
  2060. c
  2061. c          DO I=1,INDLI.ID(NLS1)
  2062. c            DO J = 1,INDLI.ID(NLS1)
  2063. c            WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J)
  2064. c            ENDDO
  2065. c          ENDDO
  2066. c      ENDDO
  2067. c           SEGDES MATR1
  2068.  
  2069.  9999 CONTINUE
  2070.       RETURN
  2071.       END
  2072.  
  2073.  
  2074.  
  2075.  
  2076.  
  2077.  
  2078.  
  2079.  
  2080.  
  2081.  
  2082.  
  2083.  
  2084.  
  2085.  

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