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

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