Télécharger la plaquette Cast3M


fr en

Télécharger nor2d3.eso

Retour à la liste

Numérotation des lignes : 

nor2d3

  1. C NOR2D3    SOURCE    OF166741  24/12/13    21:16:47     12097          
  2.        SUBROUTINE NOR2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  3.      &             MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL,
  4.      &             MLENNE,MLENMI,MPOVCL,
  5.      &             MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2,
  6.      &             SCMB,INDLI,
  7.      &             TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NBCOT,
  8.      &             NSOMM,NBMAX)
  9.  
  10.  
  11.  
  12. C
  13. C************************************************************************
  14. C
  15. C PROJET            :  CASTEM 2000
  16. C
  17. C NOM               :  NORV2
  18. C
  19. C DESCRIPTION       : Appelle par NORV1
  20. C
  21. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  22. C
  23. C AUTEUR            :  C. LE POTIER, DM2S/SFME/MTMS
  24. C
  25. C************************************************************************
  26. C
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8 (a-h,o-z)
  29. -INC SMLENTI
  30. -INC SMELEME
  31. -INC SMCHPOI
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC SMCOORD
  35. -INC SMLREEL
  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.  
  80.       REAL*8 VECXG(4,4),VECYG(4,4),VECZG(4,4)
  81.       REAL*8 VECXD(4,4),VECYD(4,4),VECZD(4,4)
  82.       REAL*8 VOLUG(4),SURFAGX(4),SURFAGY(4),SURFAGZ(4),COEFG(4,4)
  83.       REAL*8 VOLUD(4),SURFADX(4),SURFADY(4),SURFADZ(4),COEFD(4,4)
  84.       INTEGER NGS(4),NLS(4),XS(4),YS(4),ZS(4)
  85.       INTEGER NLOCFG(4,4),NLOCFD(4,4)
  86.       REAL*8 EPS
  87.       INTEGER ICRIT
  88.       CHARACTER*8 TYPE
  89. C      CHARACTER*(4) NOMCOM(18)
  90. C      DATA NOMCOM  /'P1DX','P1DY',
  91. C     &     'P2DX','P2DY',
  92. C     &     'P3DX','P3DY',
  93. C     &     'P4DX','P4DY',
  94. C     &     'P5DX','P5DY',
  95. C     &     'P6DX','P6DY',
  96. C     &     'P7DX','P7DY',
  97. C     &     'P8DX','P8DY',
  98. C     &     'P9DX','P9DY'/
  99.  
  100.       INTEGER NDIM
  101.       SEGMENT MMAT1
  102.       REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  103.       INTEGER IC(NDIM)
  104.       ENDSEGMENT
  105.  
  106.       INTEGER K1,K2
  107.       SEGMENT INDICE
  108.       INTEGER NUME(K1,K2)
  109.       ENDSEGMENT
  110.       POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  111.  
  112.       SEGMENT MATRICE
  113.       REAL*8 MAT(K1,K2)
  114.       ENDSEGMENT
  115.       POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  116.  
  117.       INTEGER K3
  118.       SEGMENT POINT2
  119.       INTEGER POINT(K3)
  120.       ENDSEGMENT
  121.       POINTEUR IPO2.POINT2
  122.  
  123.       SEGMENT MATRICE2
  124.       REAL*8 MAT2(K1,K2)
  125.       ENDSEGMENT
  126.       POINTEUR MATR1.MATRICE2,MATR2.MATRICE2
  127.  
  128.  
  129.       SEGMENT REP
  130.       INTEGER  ID(K3)
  131.       ENDSEGMENT
  132.       POINTEUR TAB.REP,INDLI.REP
  133.  
  134.       INTEGER K5
  135.       SEGMENT NBFAC
  136.       INTEGER NBFACEL(K5)
  137.       INTEGER IMELEM(K5)
  138.       ENDSEGMENT
  139.  
  140.       INTEGER K6
  141.       SEGMENT NBCOT
  142.       INTEGER NBCOTE(K6)
  143.       INTEGER IMECOTE(K6)
  144.       ENDSEGMENT
  145.  
  146.  
  147.  
  148. c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS
  149. c SOUS DOMAINE
  150.  
  151.        MAUX = MELTFA
  152.        MAUX2 = MELEFP
  153.        NMAI1 = 0
  154.        NMAI2 = 0
  155.        NMAI3 = 0
  156. C       NMAI4 = 0
  157.  
  158. C      Initialisation sinon NAN...
  159.        DO II=1,4
  160.          SURFAGX(II)=0.D0
  161.          SURFAGY(II)=0.D0
  162.          SURFAGZ(II)=0.D0
  163.          SURFADX(II)=0.D0
  164.          SURFADY(II)=0.D0
  165.          SURFADZ(II)=0.D0
  166.        ENDDO
  167.  
  168.        NBSO = MAX(1,MELTFA.LISOUS(/1))
  169. c       WRITE(6,*) 'NBSO MAILLE= ',NBSO
  170. c       WRITE(6,*) 'MELTFA= ',MELTFA
  171.        IF (NBSO.EQ.1) THEN
  172.        K5 = MELTFA.NUM(/2)
  173.        ELSEIF (NBSO.EQ.2) THEN
  174.        IPT1 = MELTFA.LISOUS(1)
  175.        SEGACT IPT1
  176.        N1 = IPT1.NUM(/2)
  177.        NMAI1 = N1
  178.        SEGDES IPT1
  179.        IPT2 = MELTFA.LISOUS(2)
  180.        SEGACT IPT2
  181.        N2 = IPT2.NUM(/2)
  182.        NMAI2 = N2
  183.        SEGDES IPT2
  184.        K5 = N1 + N2
  185.        ELSEIF (NBSO.EQ.3) THEN
  186.        IPT1 = MELTFA.LISOUS(1)
  187.        SEGACT IPT1
  188.        N1 = IPT1.NUM(/2)
  189.        NMAI1 = N1
  190.        SEGDES IPT1
  191.        IPT2 = MELTFA.LISOUS(2)
  192.        SEGACT IPT2
  193.        N2 = IPT2.NUM(/2)
  194.        NMAI2 = N2
  195.        SEGDES IPT2
  196.        IPT3 = MELTFA.LISOUS(3)
  197.        SEGACT IPT3
  198.        N3 = IPT3.NUM(/2)
  199.        NMAI3 = N3
  200.        SEGDES IPT3
  201.        K5 = N1 + N2 + N3
  202.        ELSEIF (NBSO.EQ.4) THEN
  203.        IPT1 = MELTFA.LISOUS(1)
  204.        SEGACT IPT1
  205.        N1 = IPT1.NUM(/2)
  206.        NMAI1 = N1
  207.        SEGDES IPT1
  208.        IPT2 = MELTFA.LISOUS(2)
  209.        SEGACT IPT2
  210.        N2 = IPT2.NUM(/2)
  211.        NMAI2 = N2
  212.        SEGDES IPT2
  213.        IPT3 = MELTFA.LISOUS(3)
  214.        SEGACT IPT3
  215.        N3 = IPT3.NUM(/2)
  216.        NMAI3 = N3
  217.        SEGDES IPT3
  218.        IPT4 = MELTFA.LISOUS(4)
  219.        SEGACT IPT4
  220.        N4 = IPT4.NUM(/2)
  221. C       NMAI4 = N4
  222.        SEGDES IPT4
  223.        K5 = N1 + N2 + N3 + N4
  224.        ENDIF
  225. c       WRITE(6,*) 'K5= ',K5
  226.  
  227.  
  228.  
  229.        IF (NBSO.EQ.1) THEN
  230.        DO I = 1,K5
  231.            NTYPE = MELTFA.ITYPEL
  232. c           WRITE(6,*) 'NTYPE= ',NTYPE
  233.            IF (NTYPE .EQ. 16) THEN
  234.            NBFACEL(I) = 6
  235.            IMELEM(I) = MELTFA
  236.            ELSEIF (NTYPE .EQ. 25) THEN
  237.            NBFACEL(I) = 5
  238.            IMELEM(I) = MELTFA
  239.            ELSEIF (NTYPE .EQ. 23) THEN
  240.            NBFACEL(I) = 4
  241.            IMELEM(I) = MELTFA
  242.            ELSEIF (NTYPE .EQ. 9) THEN
  243.            NBFACEL(I) = 5
  244.            IMELEM(I) = MELTFA
  245.            ENDIF
  246. c       SEGDES MELTFA
  247.        ENDDO
  248.        ELSEIF (NBSO.EQ.2) THEN
  249.          IPT1 = MELTFA.LISOUS(1)
  250.          SEGACT IPT1
  251.          IPT2 = MELTFA.LISOUS(2)
  252.          SEGACT IPT2
  253.        DO I = 1,K5
  254.          N1 = IPT1.NUM(/2)
  255.          IF (I.LE.N1) THEN
  256.            NTYPE = IPT1.ITYPEL
  257.            IF (NTYPE .EQ. 16) THEN
  258.            NBFACEL(I) = 6
  259.            IMELEM(I) =  IPT1
  260.            ELSEIF (NTYPE .EQ. 25) THEN
  261.            NBFACEL(I) = 5
  262.            IMELEM(I) = IPT1
  263.            ELSEIF (NTYPE .EQ. 23) THEN
  264.            NBFACEL(I) = 4
  265.            IMELEM(I) = IPT1
  266.            ELSEIF (NTYPE .EQ. 9) THEN
  267.            NBFACEL(I) = 5
  268.            IMELEM(I) = IPT1
  269.            ENDIF
  270.          ELSE
  271.            NTYPE = IPT2.ITYPEL
  272.            IF (NTYPE .EQ. 16) THEN
  273.            NBFACEL(I) = 6
  274.            IMELEM(I) =  IPT2
  275.            ELSEIF (NTYPE .EQ. 25) THEN
  276.            NBFACEL(I) = 5
  277.            IMELEM(I) = IPT2
  278.            ELSEIF (NTYPE .EQ. 23) THEN
  279.            NBFACEL(I) = 4
  280.            IMELEM(I) = IPT2
  281.            ELSEIF (NTYPE .EQ. 9) THEN
  282.            NBFACEL(I) = 5
  283.            IMELEM(I) = IPT2
  284.            ENDIF
  285.         ENDIF
  286.       ENDDO
  287.       ELSEIF (NBSO.EQ.3) THEN
  288.          IPT1 = MELTFA.LISOUS(1)
  289.          SEGACT IPT1
  290.            NTYPE = IPT1.ITYPEL
  291. c           WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL
  292.          IPT2 = MELTFA.LISOUS(2)
  293.          SEGACT IPT2
  294.            NTYPE = IPT2.ITYPEL
  295. c           WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL
  296.          IPT3 = MELTFA.LISOUS(3)
  297.          SEGACT IPT3
  298.            NTYPE = IPT3.ITYPEL
  299. c           WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL
  300.          N1 = IPT1.NUM(/2)
  301.          N2 = IPT2.NUM(/2)
  302.          N3 = IPT3.NUM(/2)
  303.        DO I = 1,K5
  304.          IF (I.LE.N1) THEN
  305.            NTYPE = IPT1.ITYPEL
  306.            IF (NTYPE .EQ. 16) THEN
  307.            NBFACEL(I) = 6
  308.            IMELEM(I) =  IPT1
  309.            ELSEIF (NTYPE .EQ. 25) THEN
  310.            NBFACEL(I) = 5
  311.            IMELEM(I) = IPT1
  312.            ELSEIF (NTYPE .EQ. 23) THEN
  313.            NBFACEL(I) = 4
  314.            IMELEM(I) = IPT1
  315.            ELSEIF (NTYPE .EQ. 9) THEN
  316.            NBFACEL(I) = 5
  317.            IMELEM(I) = IPT1
  318.            ENDIF
  319.          ELSEIF (I.LE.(N1+N2)) THEN
  320.            NTYPE = IPT2.ITYPEL
  321.            IF (NTYPE .EQ. 16) THEN
  322.            NBFACEL(I) = 6
  323.            IMELEM(I) =  IPT2
  324.            ELSEIF (NTYPE .EQ. 25) THEN
  325.            NBFACEL(I) = 5
  326.            IMELEM(I) = IPT2
  327.            ELSEIF (NTYPE .EQ. 23) THEN
  328.            NBFACEL(I) = 4
  329.            IMELEM(I) = IPT2
  330.            ELSEIF (NTYPE .EQ. 9) THEN
  331.            NBFACEL(I) = 5
  332.            IMELEM(I) = IPT2
  333.            ENDIF
  334.          ELSE
  335.            NTYPE = IPT3.ITYPEL
  336.            IF (NTYPE .EQ. 16) THEN
  337.            NBFACEL(I) = 6
  338.            IMELEM(I) =  IPT3
  339.            ELSEIF (NTYPE .EQ. 25) THEN
  340.            NBFACEL(I) = 5
  341.            IMELEM(I) = IPT3
  342.            ELSEIF (NTYPE .EQ. 23) THEN
  343.            NBFACEL(I) = 4
  344.            IMELEM(I) = IPT3
  345.            ELSEIF (NTYPE .EQ. 9) THEN
  346.            NBFACEL(I) = 5
  347.            IMELEM(I) = IPT3
  348.            ENDIF
  349.          ENDIF
  350.          ENDDO
  351.       ELSEIF (NBSO.EQ.4) THEN
  352.          IPT1 = MELTFA.LISOUS(1)
  353.          SEGACT IPT1
  354.            NTYPE = IPT1.ITYPEL
  355. c           WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL
  356.          IPT2 = MELTFA.LISOUS(2)
  357.          SEGACT IPT2
  358.            NTYPE = IPT2.ITYPEL
  359. c           WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL
  360.          IPT3 = MELTFA.LISOUS(3)
  361.          SEGACT IPT3
  362.            NTYPE = IPT3.ITYPEL
  363. c           WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL
  364.          IPT4 = MELTFA.LISOUS(4)
  365.          SEGACT IPT4
  366.            NTYPE = IPT4.ITYPEL
  367. c           WRITE(6,*) 'NTYPE= ',IPT4.ITYPEL
  368.          N1 = IPT1.NUM(/2)
  369.          N2 = IPT2.NUM(/2)
  370.          N3 = IPT3.NUM(/2)
  371.          N4 = IPT4.NUM(/2)
  372.        DO I = 1,K5
  373.          IF (I.LE.N1) THEN
  374.            NTYPE = IPT1.ITYPEL
  375.            IF (NTYPE .EQ. 16) THEN
  376.            NBFACEL(I) = 6
  377.            IMELEM(I) =  IPT1
  378.            ELSEIF (NTYPE .EQ. 25) THEN
  379.            NBFACEL(I) = 5
  380.            IMELEM(I) = IPT1
  381.            ELSEIF (NTYPE .EQ. 23) THEN
  382.            NBFACEL(I) = 4
  383.            IMELEM(I) = IPT1
  384.            ELSEIF (NTYPE .EQ. 9) THEN
  385.            NBFACEL(I) = 5
  386.            IMELEM(I) = IPT1
  387.            ENDIF
  388.          ELSEIF (I.LE.(N1+N2)) THEN
  389.            NTYPE = IPT2.ITYPEL
  390.            IF (NTYPE .EQ. 16) THEN
  391.            NBFACEL(I) = 6
  392.            IMELEM(I) =  IPT2
  393.            ELSEIF (NTYPE .EQ. 25) THEN
  394.            NBFACEL(I) = 5
  395.            IMELEM(I) = IPT2
  396.            ELSEIF (NTYPE .EQ. 23) THEN
  397.            NBFACEL(I) = 4
  398.            IMELEM(I) = IPT2
  399.            ELSEIF (NTYPE .EQ. 9) THEN
  400.            NBFACEL(I) = 5
  401.            IMELEM(I) = IPT2
  402.            ENDIF
  403.          ELSEIF (I.LE.(N1+N2+N3)) THEN
  404.            NTYPE = IPT3.ITYPEL
  405.            IF (NTYPE .EQ. 16) THEN
  406.            NBFACEL(I) = 6
  407.            IMELEM(I) =  IPT3
  408.            ELSEIF (NTYPE .EQ. 25) THEN
  409.            NBFACEL(I) = 5
  410.            IMELEM(I) = IPT3
  411.            ELSEIF (NTYPE .EQ. 23) THEN
  412.            NBFACEL(I) = 4
  413.            IMELEM(I) = IPT3
  414.            ELSEIF (NTYPE .EQ. 9) THEN
  415.            NBFACEL(I) = 5
  416.            IMELEM(I) = IPT3
  417.            ENDIF
  418.          ELSE
  419.            NTYPE = IPT4.ITYPEL
  420.            IF (NTYPE .EQ. 16) THEN
  421.            NBFACEL(I) = 6
  422.            IMELEM(I) =  IPT4
  423.            ELSEIF (NTYPE .EQ. 25) THEN
  424.            NBFACEL(I) = 5
  425.            IMELEM(I) = IPT4
  426.            ELSEIF (NTYPE .EQ. 23) THEN
  427.            NBFACEL(I) = 4
  428.            IMELEM(I) = IPT4
  429.            ELSEIF (NTYPE .EQ. 9) THEN
  430.            NBFACEL(I) = 5
  431.            IMELEM(I) = IPT4
  432.            ENDIF
  433.          ENDIF
  434.         ENDDO
  435.       ENDIF
  436.  
  437. C ON EST ICI CORRIGER K5
  438.  
  439.         MLEFA2 = MLEFA
  440.        CALL KRIPAD(MELEFA,MLEFA2)
  441. c CAS OU LES FACES SONT DES TRIANGLES OU DES FACES
  442.        NFAI1 = 0
  443.        NBSOF = MAX(1,MELEFP.LISOUS(/1))
  444. c       WRITE(6,*) 'NBSO FACE= ',NBSOF
  445.        IF (NBSOF.EQ.1) THEN
  446.        K6 = MELEFP.NUM(/2)
  447.        ELSEIF (NBSOF.EQ.2) THEN
  448.        IPT5 = MELEFP.LISOUS(1)
  449.        SEGACT IPT5
  450.        N1 = IPT5.NUM(/2)
  451.        NFAI1 = N1
  452.        SEGDES IPT5
  453.        IPT6 = MELEFP.LISOUS(2)
  454.        SEGACT IPT6
  455.        N2 = IPT6.NUM(/2)
  456. C       NFAI2 = N2
  457.        SEGDES IPT6
  458.        K6 = N1 + N2
  459.        ENDIF
  460. c       WRITE(6,*) 'K6= ',K6
  461.  
  462.        SEGINI NBCOT
  463. c       WRITE(6,*) 'POINT1'
  464. C ON EST ICI
  465.        IF (NBSOF.EQ.1) THEN
  466.        DO I = 1,K6
  467.            NTYPE = MELEFP.ITYPEL
  468. c           WRITE(6,*) 'NTYPE= ',NTYPE
  469.            IF (NTYPE .EQ. 5) THEN
  470.            NBCOTE(I) = 3
  471.            IMECOTE(I) = MELEFP
  472.            ELSE
  473.            NBCOTE(I) = 4
  474.            IMECOTE(I) = MELEFP
  475.            ENDIF
  476. c       SEGDES MELTFA
  477.        ENDDO
  478.        ELSEIF (NBSOF.EQ.2) THEN
  479. c       WRITE(6,*) 'POINT2'
  480.          IPT5 = MELEFP.LISOUS(1)
  481.          SEGACT IPT5
  482.          IPT6 = MELEFP.LISOUS(2)
  483.          SEGACT IPT6
  484. c          WRITE(6,*) 'IPT5= ',IPT5.ITYPEL
  485. c          WRITE(6,*) 'IPT6= ',IPT6.ITYPEL
  486.        DO I = 1,K6
  487.          N1 = IPT5.NUM(/2)
  488. C MISE A JOUR DE MLEFA.LECT
  489.          IF (I.LE.N1) THEN
  490.          N0 = IPT5.NUM(/1)
  491.          NGFAUX = IPT5.NUM(N0,I)
  492.          MLEFA2.LECT(NGFAUX) = I
  493. c           WRITE(6,*)  'NGFAUX = ',NGFAUX,
  494. c     &                 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  495.            IF (IPT5.ITYPEL .EQ. 5) THEN
  496.            NBCOTE(I) = 3
  497.            IMECOTE(I) =  IPT5
  498.            ELSE
  499.            NBCOTE(I) = 4
  500.            IMECOTE(I) = IPT5
  501.            ENDIF
  502. c         SEGDES IPT5
  503.          ELSE
  504.          N0 = IPT6.NUM(/1)
  505.          NGFAUX = IPT6.NUM(N0,I-NFAI1)
  506.          MLEFA2.LECT(NGFAUX) = I
  507. c           WRITE(6,*)  'NGFAUX = ',NGFAUX,
  508. c     &                 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  509.            IF (IPT6.ITYPEL .EQ. 5) THEN
  510.            NBCOTE(I) = 3
  511.            IMECOTE(I) = IPT6
  512.            ELSE
  513.            NBCOTE(I) = 4
  514.            IMECOTE(I) =  IPT6
  515.            ENDIF
  516. c           SEGDES IPT6
  517.         ENDIF
  518. c           WRITE(6,*) 'I= ',I
  519. c           WRITE(6,*) 'NBCOTE= ',NBCOTE(I)
  520. c           WRITE(6,*) 'IMECOTE= ',IMECOTE(I)
  521.  
  522.         ENDDO
  523.         ENDIF
  524. C IL FAUDRA EGALEMENT CREER DES POINTEUR POUR LES FACES DE CHAQUE ELEMENT
  525. C EXEMPLE LES PRISMES
  526.  
  527. C SEGMENT  SERVANT A UN PRECALCUL DE NBMAX
  528. c      WRITE(6,*) 'NSOMM= ',NSOMM
  529.       K3 = NSOMM
  530.       SEGINI INDLI
  531.       SEGINI TAB
  532.       DO I = 1,K3
  533.         INDLI.ID(I) = 0
  534.         TAB.ID(I) = 0
  535.       ENDDO
  536.  
  537.       NFAC=MELEFL.NUM(/2)
  538.       NBMAX = 0
  539.  
  540. C PRECALCUL DE NBMAX
  541.       DO NLCF= 1, NFAC, 1
  542. c        WRITE(6,*) 'NLCF= ',NLCF
  543.          NGCF=MELEFL.NUM(2,NLCF)
  544.          NGCG=MELEFL.NUM(1,NLCF)
  545.          NGCD=MELEFL.NUM(3,NLCF)
  546.          NLCG=MLECEN.LECT(NGCG)
  547.          NLCD=MLECEN.LECT(NGCD)
  548. c         NFAUX = MELEFA.NUM(NLCF,1)
  549. c         WRITE(6,*) 'NFAUX= ',NFAUX
  550. c
  551. c           NGFAUX = MELEFA.NUM(NLCF,1)
  552. c           WRITE(6,*)  'NGFAUX = ',NGFAUX,
  553. c     &                 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  554. c         NBNO = MELEFP.NUM(/1) - 1
  555.          NBNO = NBCOTE(NLCF)
  556. c         WRITE(6,*) 'NLCF= ',NLCF
  557. c         WRITE(6,*) 'NBNO= ',NBNO
  558.          MELEFP = IMECOTE(NLCF)
  559.          IF (NLCF.GT.NFAI1) THEN
  560.          NLCFAUX = NLCF - NFAI1
  561.          ELSE
  562.          NLCFAUX = NLCF
  563.          ENDIF
  564.          DO IA = 1,NBNO
  565.          NGS1=MELEFP.NUM(IA,NLCFAUX)
  566.          NLS1=MLESOM.LECT(NGS1)
  567.          NLS1=MLESOM.LECT(NGS1)
  568.          INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  569.          NBMAX = MAX(NBMAX,INDLI.ID(NLS1))
  570.          ENDDO
  571.  
  572.  
  573.       ENDDO
  574.  
  575.  
  576.  
  577.       SEGSUP INDLI
  578.       SEGSUP TAB
  579.  
  580. c      NBMAX = 6
  581.       NBMAX = NBMAX +1
  582. c      WRITE(6,*) 'DANS NORV1 NBMAX= ',NBMAX
  583. c      WRITE(6,*) 'NBSOM= ',NSOMM
  584.  
  585.  
  586.  
  587.  
  588. C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL
  589. c INITIALISATION DES MATRICES
  590. c      NBMAX = 10
  591.       K3 = NSOMM
  592.       SEGINI INDLI
  593.       SEGINI TAB
  594.       DO I = 1,K3
  595.         INDLI.ID(I) = 0
  596.         TAB.ID(I) = 0
  597.       ENDDO
  598.  
  599.       K1 = NBMAX
  600.       K2 = NSOMM
  601.       SEGINI IND2
  602.       SEGINI IND
  603.       SEGINI IND22
  604.       SEGINI VAL1
  605.       SEGINI VAL2
  606.       SEGINI SCMB
  607.  
  608. *      K1 = NBMAX
  609. *      K2 = (NBMAX+1)
  610.  
  611. C INITIALISATION DU POINTEUR MATRICE2
  612.       K3 = NSOMM
  613.       SEGINI IPO2
  614.       DO I = 1,K3
  615.       K1 =   NBMAX
  616.       K2 =   NBMAX + 1
  617.       SEGINI MATR1
  618.       IPO2.POINT(I) =  MATR1
  619.       SEGDES  MATR1
  620.       ENDDO
  621.  
  622.  
  623.  
  624.  
  625. c      DO I = 1,K3
  626. c      MATR1 = IPO2.POINT(I)
  627. c      SEGACT MATR1 *MOD
  628. c      MATR1.MAT2(1,1) =  4.D0
  629. c      MATR1.MAT2(2,2) =  3.D0
  630. c      WRITE(6,*) 'MATR1=', MATR1.MAT2(1,1)
  631. c      WRITE(6,*) 'MATR1=', MATR1.MAT2(2,2)
  632. c      SEGDES MATR1
  633. c      ENDDO
  634.  
  635.  
  636.  
  637.  
  638.       NFAC=MELEFL.NUM(/2)
  639.  
  640. c      WRITE(6,*) 'NFAC= ',NFAC
  641.       NAUX1 = 0
  642.       DO NLCF= 1, NFAC, 1
  643. C         INDICE = 0
  644.  
  645. c ON TIENT COMPTE DU CHANGEMENT DE NUMEROTATION
  646.          NGCF=MELEFL.NUM(2,NLCF)
  647.  
  648.          NGCG=MELEFL.NUM(1,NLCF)
  649.          NGCD=MELEFL.NUM(3,NLCF)
  650.          NLCG=MLECEN.LECT(NGCG)
  651.          NLCD=MLECEN.LECT(NGCD)
  652.  
  653.  
  654.  
  655.  
  656.          SCNX=MPONOR.VPOCHA(NLCF,1)
  657.          SCNY=MPONOR.VPOCHA(NLCF,2)
  658.          SCNZ=MPONOR.VPOCHA(NLCF,3)
  659.          SCN1X = SCNX
  660.          SCN1Y = SCNY
  661.          SCN1Z = SCNZ
  662.  
  663.  
  664. C        4=IDIM+1
  665.          ICELL=(4*(NGCG -1))+1
  666.          XG=MCOORD.XCOOR(ICELL)
  667.          YG=MCOORD.XCOOR(ICELL+1)
  668.          ZG=MCOORD.XCOOR(ICELL+2)
  669.          ICELL=(4*(NGCD -1))+1
  670.          XD=MCOORD.XCOOR(ICELL)
  671.          YD=MCOORD.XCOOR(ICELL+1)
  672.          ZD=MCOORD.XCOOR(ICELL+2)
  673.          ICELL=(4*(NGCF -1))+1
  674.          XF=MCOORD.XCOOR(ICELL)
  675.          YF=MCOORD.XCOOR(ICELL+1)
  676.          ZF=MCOORD.XCOOR(ICELL+2)
  677.  
  678. C MISE A ZERO DE NLOC
  679.             DO JA=1,4
  680.               DO IA=1,3
  681.               NLOCFG(IA,JA) = 0
  682.               NLOCFD(IA,JA) = 0
  683.               ENDDO
  684.             ENDDO
  685.  
  686.          MELTFA =  IMELEM(NLCG)
  687.          NBF = NBFACEL(NLCG)
  688.          IF (NLCG.LE.NMAI1) THEN
  689.          NGAUX = NLCG
  690.          ELSEIF ((NLCG.GT.NMAI1).AND.(NLCG.LE.(NMAI1+NMAI2))) THEN
  691.          NGAUX = NLCG - NMAI1
  692.          ELSEIF ((NLCG.GT.(NMAI1+NMAI2)).AND.
  693.      &                  (NLCG.LE.(NMAI1+NMAI2+NMAI3))) THEN
  694.          NGAUX = NLCG - (NMAI1+NMAI2)
  695.          ELSEIF (NLCG.GT.(NMAI1+NMAI2+NMAI3)) THEN
  696.          NGAUX = NLCG - (NMAI1+NMAI2+NMAI3)
  697.          ENDIF
  698. c         WRITE(6,*) 'NLCG= ',NLCG
  699. c         WRITE(6,*) 'NBF= ',NBF
  700. c         WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL
  701. c         WRITE(6,*) 'MELTFA= ',MELTFA
  702. c         WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1)
  703. c         WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2)
  704. c         WRITE(6,*) 'NGAUX ',MELTFA.NUM(/2)
  705.  
  706. c         SEGACT MELTFA
  707.  
  708. C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE
  709.          NLCF1 = MLEFA2.LECT(NGCF)
  710.          NBNO = NBCOTE(NLCF1)
  711.          MELEFP = IMECOTE(NLCF1)
  712.          IF (NLCF1.GT.NFAI1) THEN
  713.          NLCF1AUX = NLCF1 - NFAI1
  714.          ELSE
  715.          NLCF1AUX = NLCF1
  716.          ENDIF
  717.  
  718.          DO JA = 1,NBNO
  719.          NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  720. c             IF (NLCF.EQ.14) then
  721. c         WRITE(6,*) 'NGAUX= ',NGAUX,'JA= ',JA,'NGS= ',NGS(JA)
  722. c         WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF
  723. c          ENDIF
  724.  
  725.          ICOUR = 0
  726.          DO J = 1,NBF
  727.             N1 = MELTFA.NUM(J,NGAUX)
  728.             NL1 = MLEFA2.LECT(N1)
  729.              NBNO2 = NBCOTE(NL1)
  730.              MELEP2 = IMECOTE(NL1)
  731.              IF (NL1.GT.NFAI1) THEN
  732.              NL1AUX = NL1 - NFAI1
  733.              ELSE
  734.              NL1AUX = NL1
  735.              ENDIF
  736. c             IF (NLCF.EQ.14) then
  737. c             WRITE(6,*) 'N1= ',N1,'NL1= ',NL1,'NL1AUX= ',NL1AUX
  738. c             ENDIF
  739.  
  740.  
  741.              DO IA =1,NBNO2
  742.              NSOM1 = MELEP2.NUM(IA,NL1AUX)
  743. c             IF (NLCF.EQ.14) then
  744. c             WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1
  745. c             ENDIF
  746.              IF (NSOM1.EQ.NGS(JA)) THEN
  747.  
  748.              ICELL=(4*(N1 -1))+1
  749.              XF=MCOORD.XCOOR(ICELL)
  750.              YF=MCOORD.XCOOR(ICELL+1)
  751.              ZF=MCOORD.XCOOR(ICELL+2)
  752.  
  753.              ICOUR = ICOUR + 1
  754.              VECXG(ICOUR,JA) = (XF - XG)
  755.              VECYG(ICOUR,JA) = (YF - YG)
  756.              VECZG(ICOUR,JA) = (ZF - ZG)
  757.              NLOCFG(ICOUR,JA) = N1
  758. C ON PERMUTE
  759. C ICI
  760.  
  761.              IF (N1.EQ.NGCF) THEN
  762.              NAUX =  NLOCFG(1,JA)
  763.              VXAU = VECXG(1,JA)
  764.              VYAU = VECYG(1,JA)
  765.              VZAU = VECZG(1,JA)
  766.              VECXG(1,JA) = (XF - XG)
  767.              VECYG(1,JA) = (YF - YG)
  768.              VECZG(1,JA) = (ZF - ZG)
  769.              NLOCFG(1,JA) = N1
  770.              VECXG(ICOUR,JA) = VXAU
  771.              VECYG(ICOUR,JA) = VYAU
  772.              VECZG(ICOUR,JA) = VZAU
  773.              NLOCFG(ICOUR,JA) = NAUX
  774.              ENDIF
  775.              ENDIF
  776.             ENDDO
  777.          ENDDO
  778. c         IF (NLCF.EQ.14) THEN
  779. c             WRITE(6,*) 'JA= ',JA
  780. c             WRITE(6,*) 'ICOUR= ',ICOUR
  781. c         ENDIF
  782.          ENDDO
  783.  
  784.  
  785.          MELTFA =  IMELEM(NLCD)
  786.          NBF = NBFACEL(NLCD)
  787. c         WRITE(6,*) 'NLCD= ',NLCD
  788. c         WRITE(6,*) 'NBF= ',NBF
  789. c         WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL
  790.  
  791.          IF (NLCD.LE.NMAI1) THEN
  792.          NDAUX = NLCD
  793.          ELSEIF ((NLCD.GT.NMAI1).AND.(NLCD.LE.(NMAI1+NMAI2))) THEN
  794.          NDAUX = NLCD - NMAI1
  795.          ELSEIF ((NLCD.GT.(NMAI1+NMAI2)).AND.
  796.      &                  (NLCD.LE.(NMAI1+NMAI2+NMAI3))) THEN
  797.          NDAUX = NLCD - (NMAI1+NMAI2)
  798.          ELSEIF (NLCD.GT.(NMAI1+NMAI2+NMAI3)) THEN
  799.          NDAUX = NLCD - (NMAI1+NMAI2+NMAI3)
  800.          ENDIF
  801.  
  802. C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE
  803.          DO JA = 1,NBNO
  804.          NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  805. c         WRITE(6,*) 'NDAUX= ',NDAUX,'JA= ',JA,'NGS= ',NGS(JA)
  806. c         WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF
  807.          ICOUR = 0
  808.          DO J = 1,NBF
  809.             N1 = MELTFA.NUM(J,NDAUX)
  810.             NL1 = MLEFA2.LECT(N1)
  811. c            WRITE(6,*) 'N1= ',N1,'NL1= ',NL1
  812.  
  813.              NBNO2 = NBCOTE(NL1)
  814.              MELEP2 = IMECOTE(NL1)
  815.              IF (NL1.GT.NFAI1) THEN
  816.              NL1AUX = NL1  - NFAI1
  817.              ELSE
  818.              NL1AUX = NL1
  819.              ENDIF
  820.  
  821.  
  822.              DO IA =1,NBNO2
  823.              NSOM1 = MELEP2.NUM(IA,NL1AUX)
  824. c             WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1
  825.              IF (NSOM1.EQ.NGS(JA)) THEN
  826.  
  827.              ICELL=(4*(N1 -1))+1
  828.              XF=MCOORD.XCOOR(ICELL)
  829.              YF=MCOORD.XCOOR(ICELL+1)
  830.              ZF=MCOORD.XCOOR(ICELL+2)
  831.  
  832.              ICOUR = ICOUR + 1
  833.              VECXD(ICOUR,JA) = (XF - XD)
  834.              VECYD(ICOUR,JA) = (YF - YD)
  835.              VECZD(ICOUR,JA) = (ZF - ZD)
  836.              NLOCFD(ICOUR,JA) = N1
  837. C ON PERMUTE
  838.              IF (N1.EQ.NGCF) THEN
  839.              NAUX =  NLOCFD(1,JA)
  840.              VXAU = VECXD(1,JA)
  841.              VYAU = VECYD(1,JA)
  842.              VZAU = VECZD(1,JA)
  843.              VECXD(1,JA) = (XF - XD)
  844.              VECYD(1,JA) = (YF - YD)
  845.              VECZD(1,JA) = (ZF - ZD)
  846.              NLOCFD(1,JA) = N1
  847.              VECXD(ICOUR,JA) = VXAU
  848.              VECYD(ICOUR,JA) = VYAU
  849.              VECZD(ICOUR,JA) = VZAU
  850.              NLOCFD(ICOUR,JA) = NAUX
  851.              ENDIF
  852.              ENDIF
  853.             ENDDO
  854.          ENDDO
  855. c             WRITE(6,*) 'JA= ',JA
  856. c             WRITE(6,*) 'ICOUR= ',ICOUR
  857.          ENDDO
  858.  
  859. CALCUL DES VOLUMES
  860. c         DO JA = 1,NBNO
  861. c         DO KA=1,ICOUR
  862. c         WRITE(6,*)'JA= ',JA,'KA= ',KA
  863. c         WRITE(6,*) 'VECG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  864. c         WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA)
  865. c         ENDDO
  866. c         ENDDO
  867.  
  868.          DO JA = 1,NBNO
  869.  
  870.           DO KA = 1,ICOUR
  871. C PRODUIT MIXTES
  872. C        PRODUIT VECTORIEL
  873.                 IF (KA.EQ.1) THEN
  874.                 PSCAGX = (VECYG(2,JA)*VECZG(3,JA)) -
  875.      &         (VECZG(2,JA)*VECYG(3,JA))
  876.                 PSCAGY = (VECZG(2,JA)*VECXG(3,JA)) -
  877.      &          (VECXG(2,JA)*VECZG(3,JA))
  878.                 PSCAGZ = (VECXG(2,JA)*VECYG(3,JA)) -
  879.      &          (VECYG(2,JA)*VECXG(3,JA))
  880.                 VOLUG(JA) = (VECXG(1,JA)* PSCAGX) +
  881.      &              (VECYG(1,JA)* PSCAGY) +
  882.      &              (VECZG(1,JA)* PSCAGZ)
  883.                 SURFAGX(KA) = 0.5D0* PSCAGX
  884.                 SURFAGY(KA) = 0.5D0* PSCAGY
  885.                 SURFAGZ(KA) = 0.5D0* PSCAGZ
  886.                 IF ( VOLUG(JA).GT.0) THEN
  887.                 SURFAGX(KA) =  - SURFAGX(KA)
  888.                 SURFAGY(KA) =  - SURFAGY(KA)
  889.                 SURFAGZ(KA) =  - SURFAGZ(KA)
  890.                 ENDIF
  891.                 VOLUG(JA) = 1.D0/6.D0*ABS(VOLUG(JA))
  892.                 ENDIF
  893.  
  894.                 IF (KA.EQ.2) THEN
  895.                 PSCAGX = (VECYG(3,JA)*VECZG(1,JA)) -
  896.      &          (VECZG(3,JA)*VECYG(1,JA))
  897.                 PSCAGY = (VECZG(3,JA)*VECXG(1,JA)) -
  898.      &          (VECXG(3,JA)*VECZG(1,JA))
  899.                 PSCAGZ = (VECXG(3,JA)*VECYG(1,JA)) -
  900.      &          (VECYG(3,JA)*VECXG(1,JA))
  901.                 SURFAGX(KA) = 0.5D0* PSCAGX
  902.                 SURFAGY(KA) = 0.5D0* PSCAGY
  903.                 SURFAGY(KA) = 0.5D0* PSCAGY
  904.                 SURFAGZ(KA) = 0.5D0* PSCAGZ
  905.                 PSCA = (VECXG(2,JA)* PSCAGX) + (VECYG(2,JA)* PSCAGY) +
  906.      &              (VECZG(2,JA)* PSCAGZ)
  907.                 IF ( PSCA.GT.0) THEN
  908.                 SURFAGX(KA) =  - SURFAGX(KA)
  909.                 SURFAGY(KA) =  - SURFAGY(KA)
  910.                 SURFAGZ(KA) =  - SURFAGZ(KA)
  911.                 ENDIF
  912.                 ENDIF
  913.  
  914.  
  915.                 IF (KA.EQ.3) THEN
  916.                 PSCAGX = (VECYG(1,JA)*VECZG(2,JA)) -
  917.      &          (VECZG(1,JA)*VECYG(2,JA))
  918.                 PSCAGY = (VECZG(1,JA)*VECXG(2,JA)) -
  919.      &          (VECXG(1,JA)*VECZG(2,JA))
  920.                 PSCAGZ = (VECXG(1,JA)*VECYG(2,JA)) -
  921.      &          (VECYG(1,JA)*VECXG(2,JA))
  922.  
  923.                 SURFAGX(KA) = 0.5D0* PSCAGX
  924.                 SURFAGY(KA) = 0.5D0* PSCAGY
  925.                 SURFAGZ(KA) = 0.5D0* PSCAGZ
  926.                 PSCA = (VECXG(3,JA)* PSCAGX) + (VECYG(3,JA)* PSCAGY) +
  927.      &              (VECZG(3,JA)* PSCAGZ)
  928.                 IF ( PSCA.GT.0) THEN
  929.                 SURFAGX(KA) =  - SURFAGX(KA)
  930.                 SURFAGY(KA) =  - SURFAGY(KA)
  931.                 SURFAGZ(KA) =  - SURFAGZ(KA)
  932.                 ENDIF
  933.                 ENDIF
  934.  
  935. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  936.            IF (ICHTE.EQ.0) THEN
  937.            COEFG(KA,JA) = ( (SURFAGX(KA)*SCN1X) + (SURFAGY(KA)*SCN1Y) +
  938.      &               (SURFAGZ(KA)*SCN1Z))
  939.      &              / (3.D0*VOLUG(JA))
  940.  
  941.            ELSE
  942. C TENSEUR
  943.            IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN
  944.            K11G = MPOTEN.VPOCHA(NLCG,1)
  945.            K22G = MPOTEN.VPOCHA(NLCG,2)
  946.            K33G = MPOTEN.VPOCHA(NLCG,3)
  947.            K21G = MPOTEN.VPOCHA(NLCG,4)
  948.            K31G = MPOTEN.VPOCHA(NLCG,5)
  949.            K32G = MPOTEN.VPOCHA(NLCG,6)
  950.            ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  951.            K11G = MPOTEN.VPOCHA(NLCG,1)
  952.            K22G = K11G
  953.            K33G = K11G
  954.            K21G = 0.0D0
  955.            K31G = 0.0D0
  956.            K32G = 0.0D0
  957.            ELSE
  958.            WRITE(6,*) 'TENSEUR NON PREVU'
  959.            STOP
  960.            ENDIF
  961.  
  962.            PSCAGX = (K11G*SURFAGX(KA)) + (K21G*SURFAGY(KA)) +
  963.      &     (K31G*SURFAGZ(KA))
  964.            PSCAGY = (K21G*SURFAGX(KA)) + (K22G*SURFAGY(KA)) +
  965.      &     (K32G*SURFAGZ(KA))
  966.            PSCAGZ = (K31G*SURFAGX(KA)) + (K32G*SURFAGY(KA)) +
  967.      &     (K33G*SURFAGZ(KA))
  968.            COEFG(KA,JA) =  (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) +
  969.      &     (PSCAGZ*SCN1Z)
  970.            COEFG(KA,JA) = COEFG(KA,JA)  / (3.D0*VOLUG(JA))
  971.            ENDIF
  972. c         WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA)  = ',VOLUG(JA)
  973. c         WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA)
  974. c         WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  975. c         WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  976.           ENDDO
  977. c         WRITE(6,*) 'JA = ',JA,'VOLUG(JA)  = ',VOLUG(JA)
  978. c         WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA)
  979. c         WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA)
  980. c         WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA)
  981. c         WRITE(6,*)'NLCF= ',NLCF,'COEFG = ',
  982. c     &   COEFG(1,JA),COEFG(2,JA),COEFG(3,JA)
  983. c         WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  984. c         WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  985. c         WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2)
  986. c         WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3)
  987.  
  988.          ENDDO
  989. CALCUL DES VOLUMES
  990.  
  991.          DO JA = 1,NBNO
  992.             NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  993.             NLS(JA)=MLESOM.LECT(NGS(JA))
  994.  
  995.           DO KA = 1,ICOUR
  996. C PRODUIT MIXTES
  997. C        PRODUIT VECTORIEL
  998.                 IF (KA.EQ.1) THEN
  999.                 PSCADX = (VECYD(2,JA)*VECZD(3,JA)) -
  1000.      &          (VECZD(2,JA)*VECYD(3,JA))
  1001.                 PSCADY = (VECZD(2,JA)*VECXD(3,JA)) -
  1002.      &          (VECXD(2,JA)*VECZD(3,JA))
  1003.                 PSCADZ = (VECXD(2,JA)*VECYD(3,JA)) -
  1004.      &          (VECYD(2,JA)*VECXD(3,JA))
  1005.                 VOLUD(JA) = (VECXD(1,JA)* PSCADX) +
  1006.      &              (VECYD(1,JA)* PSCADY) +
  1007.      &              (VECZD(1,JA)* PSCADZ)
  1008.                 SURFADX(KA) = 0.5D0* PSCADX
  1009.                 SURFADY(KA) = 0.5D0* PSCADY
  1010.                 SURFADZ(KA) = 0.5D0* PSCADZ
  1011.                 IF ( VOLUD(JA).GT.0) THEN
  1012.                 SURFADX(KA) =  - SURFADX(KA)
  1013.                 SURFADY(KA) =  - SURFADY(KA)
  1014.                 SURFADZ(KA) =  - SURFADZ(KA)
  1015.                 ENDIF
  1016.                 VOLUD(JA) = 1.D0/6.D0*ABS(VOLUD(JA))
  1017.  
  1018.                 ENDIF
  1019.  
  1020.                 IF (KA.EQ.2) THEN
  1021.                 PSCADX = (VECYD(3,JA)*VECZD(1,JA)) -
  1022.      &          (VECZD(3,JA)*VECYD(1,JA))
  1023.                 PSCADY = (VECZD(3,JA)*VECXD(1,JA)) -
  1024.      &          (VECXD(3,JA)*VECZD(1,JA))
  1025.                 PSCADZ = (VECXD(3,JA)*VECYD(1,JA)) -
  1026.      &          (VECYD(3,JA)*VECXD(1,JA))
  1027.                 SURFADX(KA) = 0.5D0* PSCADX
  1028.                 SURFADY(KA) = 0.5D0* PSCADY
  1029.                 SURFADY(KA) = 0.5D0* PSCADY
  1030.                 SURFADZ(KA) = 0.5D0* PSCADZ
  1031.                 PSCA = (VECXD(2,JA)* PSCADX) + (VECYD(2,JA)* PSCADY) +
  1032.      &              (VECZD(2,JA)* PSCADZ)
  1033.                 IF ( PSCA.GT.0) THEN
  1034.                 SURFADX(KA) =  - SURFADX(KA)
  1035.                 SURFADY(KA) =  - SURFADY(KA)
  1036.                 SURFADZ(KA) =  - SURFADZ(KA)
  1037.                 ENDIF
  1038.                 ENDIF
  1039.  
  1040.  
  1041.                 IF (KA.EQ.3) THEN
  1042.                 PSCADX = (VECYD(1,JA)*VECZD(2,JA)) -
  1043.      &          (VECZD(1,JA)*VECYD(2,JA))
  1044.                 PSCADY = (VECZD(1,JA)*VECXD(2,JA)) -
  1045.      &          (VECXD(1,JA)*VECZD(2,JA))
  1046.                 PSCADZ = (VECXD(1,JA)*VECYD(2,JA)) -
  1047.      &          (VECYD(1,JA)*VECXD(2,JA))
  1048.  
  1049.                 SURFADX(KA) = 0.5D0* PSCADX
  1050.                 SURFADY(KA) = 0.5D0* PSCADY
  1051.                 SURFADZ(KA) = 0.5D0* PSCADZ
  1052.                 PSCA = (VECXD(3,JA)* PSCADX) + (VECYD(3,JA)* PSCADY) +
  1053.      &              (VECZD(3,JA)* PSCADZ)
  1054.                 IF ( PSCA.GT.0) THEN
  1055.                 SURFADX(KA) =  - SURFADX(KA)
  1056.                 SURFADY(KA) =  - SURFADY(KA)
  1057.                 SURFADZ(KA) =  - SURFADZ(KA)
  1058.                 ENDIF
  1059.                 ENDIF
  1060.  
  1061. c          WRITE(6,*) 'NLCF=',NLCF
  1062. c          WRITE(6,*) 'NLCD=',NLCD
  1063. c          WRITE(6,*) 'NLCG=',NLCG
  1064. c          WRite(6,*) 'AG1=',AG1
  1065. c          WRite(6,*) 'AG2=',AG2
  1066. c          WRite(6,*) 'AD1=',AD1
  1067. c          WRite(6,*) 'AD2=',AD2
  1068. c          WRite(6,*) 'PSCAG1=',PSCAG1
  1069. c          WRite(6,*) 'PSCAG2=',PSCAG2
  1070. c          WRite(6,*) 'PSCAD1=',PSCAD1
  1071. c          WRite(6,*) 'PSCAD2=',PSCAD2
  1072. c          WRite(6,*) 'COEF1D=',COEF1D
  1073. c          WRite(6,*) 'COEF2D=',COEF2D
  1074. c          WRite(6,*) 'BETA1GD=',BETA1GD
  1075. c          WRite(6,*) 'BETA2GD=',BETA2GD
  1076. c          WRite(6,*) 'INDD2=',INDD2
  1077.  
  1078. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  1079.            IF (ICHTE.EQ.0) THEN
  1080.            COEFD(KA,JA) = ( (SURFADX(KA)*SCN1X) + (SURFADY(KA)*SCN1Y) +
  1081.      &               (SURFADZ(KA)*SCN1Z))
  1082.      &              / (3.D0*VOLUD(JA))
  1083.  
  1084.            ELSE
  1085. C TENSEUR
  1086.            IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN
  1087.            K11D = MPOTEN.VPOCHA(NLCD,1)
  1088.            K22D = MPOTEN.VPOCHA(NLCD,2)
  1089.            K33D = MPOTEN.VPOCHA(NLCD,3)
  1090.            K21D = MPOTEN.VPOCHA(NLCD,4)
  1091.            K31D = MPOTEN.VPOCHA(NLCD,5)
  1092.            K32D = MPOTEN.VPOCHA(NLCD,6)
  1093.            ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  1094.            K11D = MPOTEN.VPOCHA(NLCD,1)
  1095.            K22D = K11D
  1096.            K33D = K11D
  1097.            K21D = 0.0D0
  1098.            K31D = 0.0D0
  1099.            K32D = 0.0D0
  1100.            ELSE
  1101.            WRITE(6,*) 'TENSEUR NON PREVU'
  1102.            STOP
  1103.            ENDIF
  1104.  
  1105.            PSCADX = (K11D*SURFADX(KA)) + (K21D*SURFADY(KA)) +
  1106.      &     (K31D*SURFADZ(KA))
  1107.            PSCADY = (K21D*SURFADX(KA)) + (K22D*SURFADY(KA)) +
  1108.      &     (K32D*SURFADZ(KA))
  1109.            PSCADZ = (K31D*SURFADX(KA)) + (K32D*SURFADY(KA)) +
  1110.      &     (K33D*SURFADZ(KA))
  1111.            COEFD(KA,JA) =  (PSCADX*SCN1X) + (PSCADY*SCN1Y)
  1112.      &     + (PSCADZ*SCN1Z)
  1113.            COEFD(KA,JA) = COEFD(KA,JA)  / (3.D0*VOLUD(JA))
  1114.            ENDIF
  1115. c         WRITE(6,*) 'JA = ',JA,'KA= ',KA,'VOLUD(JA)  = ',VOLUD(JA)
  1116. c         WRITE(6,*)'SURFAD = ',SURFADX(KA),SURFADY(KA),SURFADZ(KA)
  1117. c         WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA)
  1118.            ENDDO
  1119.  
  1120. c         WRITE(6,*) 'JA = ',JA,'VOLUD(JA)  = ',VOLUD(JA)
  1121. c         WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA)
  1122. c         WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA)
  1123. c         WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA)
  1124. c         WRITE(6,*)'NLCF= ',NLCF,'COEFD = ',
  1125. c     &   COEFD(1,JA),COEFD(2,JA),COEFD(3,JA)
  1126. c         WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1127. c         WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1)
  1128. c         WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2)
  1129. c         WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3)
  1130.  
  1131.          ENDDO
  1132. CALCUL DES VOLUMES
  1133.  
  1134. c         WRITE(6,*) 'NLCF= ',NLCF
  1135. c         WRITE(6,*) 'NGCF= ',NGCF
  1136. c         WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G
  1137. c         WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D
  1138.          DO JA = 1,NBNO
  1139.  
  1140. C         XX1 = ABS(COEFG(1,JA))
  1141. C         XX2 = ABS(COEFD(1,JA))
  1142. C         IF ((XX1.LT.1e-8) .OR.(XX2.LT.1E-8)) THEN
  1143. C         INDICE = 1
  1144. C         ENDIF
  1145.  
  1146.                MARQ = 0
  1147.                DO I5 = 1,INDLI.ID(NLS(JA))
  1148.                INDAUX = IND2.NUME(I5,NLS(JA))
  1149.                IF (INDAUX.EQ.NGCF) THEN
  1150.                MARQ = 1
  1151.                IAFF = I5
  1152.                GOTO 4
  1153.                ENDIF
  1154.                ENDDO
  1155.  4              CONTINUE
  1156.  
  1157.  
  1158.                IF (MARQ.EQ.0) THEN
  1159.                INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1160.                ICOU = INDLI.ID(NLS(JA))
  1161.                IND2.NUME(ICOU,NLS(JA)) = NGCF
  1162.                ELSE
  1163.                ICOU = IAFF
  1164.                ENDIF
  1165.  
  1166.  
  1167.                COEF = COEFG(1,JA)-COEFD(1,JA)
  1168.                MATR1 = IPO2.POINT(NLS(JA))
  1169. c               SEGINI MATR1
  1170.                SEGACT MATR1 *MOD
  1171.                MATR1.MAT2(ICOU,ICOU) =  COEF
  1172.  
  1173.                MARQ = 0
  1174.                DO I5 = 1,INDLI.ID(NLS(JA))
  1175.                INDAUX = IND2.NUME(I5,NLS(JA))
  1176.                IF (INDAUX.EQ.NLOCFG(2,JA)) THEN
  1177.                MARQ = 1
  1178.                IAFF = I5
  1179.                GOTO 5
  1180.                ENDIF
  1181.                ENDDO
  1182.  5              CONTINUE
  1183.  
  1184.  
  1185.                 IF (MARQ.EQ.0) THEN
  1186.                 INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1187.                 ICOUCO = INDLI.ID(NLS(JA))
  1188.                 IND2.NUME(ICOUCO,NLS(JA)) =  NLOCFG(2,JA)
  1189.                 ELSE
  1190.                 ICOUCO = IAFF
  1191.                 ENDIF
  1192.                 ICOUG2 = ICOUCO
  1193.  
  1194.  
  1195.                MATR1.MAT2(ICOU,ICOUCO) = COEFG(2,JA)
  1196.  
  1197.                MARQ = 0
  1198.                DO I5 = 1,INDLI.ID(NLS(JA))
  1199.                INDAUX = IND2.NUME(I5,NLS(JA))
  1200.                IF (INDAUX.EQ.NLOCFG(3,JA)) THEN
  1201.                MARQ = 1
  1202.                IAFF = I5
  1203.                GOTO 6
  1204.                ENDIF
  1205.                ENDDO
  1206.  6              CONTINUE
  1207.  
  1208.  
  1209.                 IF (MARQ.EQ.0) THEN
  1210.                 INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1211.                 ICOUCO = INDLI.ID(NLS(JA))
  1212.                 IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(3,JA)
  1213.                 ELSE
  1214.                 ICOUCO = IAFF
  1215.                 ENDIF
  1216.                 ICOUG3 = ICOUCO
  1217.                 MATR1.MAT2(ICOU,ICOUCO) = COEFG(3,JA)
  1218.  
  1219.  
  1220.                MARQ = 0
  1221.                DO I5 = 1,INDLI.ID(NLS(JA))
  1222.                INDAUX = IND2.NUME(I5,NLS(JA))
  1223.                IF (INDAUX.EQ.NLOCFD(2,JA)) THEN
  1224.                MARQ = 1
  1225.                IAFF = I5
  1226.                GOTO 59
  1227.                ENDIF
  1228.                ENDDO
  1229.  59              CONTINUE
  1230.  
  1231.  
  1232.                 IF (MARQ.EQ.0) THEN
  1233.                 INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1234.                 ICOUCO = INDLI.ID(NLS(JA))
  1235.                 IND2.NUME(ICOUCO,NLS(JA)) =  NLOCFD(2,JA)
  1236.                 ELSE
  1237.                 ICOUCO = IAFF
  1238.                 ENDIF
  1239.                 ICOUD2 = ICOUCO
  1240.  
  1241.  
  1242.                 MATR1.MAT2(ICOU,ICOUCO) =  - COEFD(2,JA)
  1243.  
  1244.                MARQ = 0
  1245.                DO I5 = 1,INDLI.ID(NLS(JA))
  1246.                INDAUX = IND2.NUME(I5,NLS(JA))
  1247.                IF (INDAUX.EQ.NLOCFD(3,JA)) THEN
  1248.                MARQ = 1
  1249.                IAFF = I5
  1250.                GOTO 69
  1251.                ENDIF
  1252.                ENDDO
  1253.  69              CONTINUE
  1254.  
  1255.  
  1256.                 IF (MARQ.EQ.0) THEN
  1257.                 INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1258.                 ICOUCO = INDLI.ID(NLS(JA))
  1259.                 IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(3,JA)
  1260.                 ELSE
  1261.                 ICOUCO = IAFF
  1262.                 ENDIF
  1263.                 ICOUD3 = ICOUCO
  1264.                 MATR1.MAT2(ICOU,ICOUCO) = - COEFD(3,JA)
  1265.  
  1266. c ON EST ICI
  1267.  
  1268.            SCMB.MAT(ICOU,NLS(JA)) =
  1269.      &    ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))
  1270.      &     *MPOCHP.VPOCHA(NLCG,1))  -
  1271.      &    ((COEFD(1,JA)+COEFD(2,JA)+COEFD(3,JA))*
  1272.      &     MPOCHP.VPOCHA(NLCD,1))
  1273. c           SCMB.MAT(ICOU,NLS(JA)) = COEF* SCMB.MAT(ICOU,NLS(JA))
  1274.  
  1275.  
  1276. c          NLS1 = NLS(JA)
  1277. c       WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1278. c     &   'SCMB', SCMB.MAT(ICOU,NLS1),
  1279. c     &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF,
  1280. c     &  'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2),
  1281. c     &  'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3),
  1282. c     &  'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2),
  1283. c     &  'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3)
  1284. * ON EST ICI
  1285. * IL FAUT VERIFIER CE QUI EST AVANT
  1286.  
  1287.  
  1288. * COEF POUR INVERSER LA MATRICE
  1289.  
  1290. * ON CORRIGE ICI
  1291.             VAL1.MAT(ICOU,NLS(JA)) =
  1292.      &     (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1293. c           VAL1.MAT(ICOU,NLS(JA)) = COEF*VAL1.MAT(ICOU,NLS(JA))
  1294.             VAL2.MAT(ICOU,NLS(JA)) =
  1295.      &      - (COEFD(1,JA) + COEFD(2,JA) + COEFD(3,JA))
  1296. c           VAL2.MAT(ICOU,NLS(JA)) = COEF*VAL2.MAT(ICOU,NLS(JA))
  1297.             IND.NUME(ICOU,NLS(JA)) = NGCG
  1298.             IND22.NUME(ICOU,NLS(JA)) = NGCD
  1299.  
  1300. * CONDITION AUX LIMITE DE DIRICICHLET
  1301.            IF (NGCG.EQ.NGCD) THEN
  1302.            NLFCL=MLENCL.LECT(NGCF)
  1303.            IF (NLFCL.GT.0) THEN
  1304. c           WRITE(6,*) 'NLCF= ',NLCF
  1305. c           WRITE(6,*) 'NGCF= ',NGCF
  1306. c           WRITE(6,*) 'VAL=',MPOVCL.VPOCHA(NLFCL,1)
  1307.            COEF = MAX(ABS(COEFG(1,JA)),ABS(COEFG(2,JA)))
  1308.            COEF = MAX(COEF,ABS(COEFG(3,JA)))
  1309.            MATR1.MAT2(ICOU,ICOU) =   COEF
  1310.            MATR1.MAT2(ICOU,ICOUG2) = 0.0D0
  1311.            MATR1.MAT2(ICOU,ICOUG3) = 0.0D0
  1312.            MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1313.            MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1314.            SCMB.MAT(ICOU,NLS(JA)) = (COEF*MPOVCL.VPOCHA(NLFCL,1))
  1315.                VAL1.MAT(ICOU,NLS(JA)) = 0.D0
  1316.                VAL2.MAT(ICOU,NLS(JA)) =  COEF
  1317. c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN
  1318.                IND.NUME(ICOU,NLS(JA)) = NGCG
  1319.                IND22.NUME(ICOU,NLS(JA)) = NGCF
  1320.            ELSE
  1321.            NLFNE=MLENNE.LECT(NGCF)
  1322.  
  1323. c CONDITION DE FLUX
  1324.            IF (NLFNE.GT.0) THEN
  1325.            QIMPX = MPOVNE.VPOCHA(NLFNE,1)
  1326. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1327.            QIMPS = (QIMPX)
  1328. c           WRITE(6,*) 'NGCF= ',NGCF
  1329. c           WRITE(6,*) 'QIMPS= ',QIMPS
  1330.  
  1331.            COEF = COEFG(1,JA)
  1332.            MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1333.            MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1334.            MATR1.MAT2(ICOU,ICOU) =    COEF
  1335.            MATR1.MAT2(ICOU,ICOUG2) =  COEFG(2,JA)
  1336.            MATR1.MAT2(ICOU,ICOUG3) =  COEFG(3,JA)
  1337.  
  1338.            SCMB.MAT(ICOU,NLS(JA)) =
  1339.      &     ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1))
  1340.      &      + (QIMPS)
  1341.             VAL1.MAT(ICOU,NLS(JA)) =
  1342.      &      (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1343.                VAL2.MAT(ICOU,NLS(JA)) =  1.D0
  1344.                IND.NUME(ICOU,NLS(JA)) = NGCG
  1345.                IND22.NUME(ICOU,NLS(JA)) = NGCF
  1346.           NLS1 = NLS(JA)
  1347. c       WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1348. c     &   'SCMB', SCMB.MAT(ICOU,NLS1)
  1349. c       WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1350. c     &             'IND= ',IND.NUME(ICOU,NLS1),
  1351. c     &                  'IND22= ',IND22.NUME(ICOU,NLS1),
  1352. c     &   'SCMB', SCMB.MAT(ICOU,NLS1),
  1353. c     &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  1354. c     &  'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1),
  1355. c     &  'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1),
  1356. c     &  'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1),
  1357. c     &  'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1)
  1358.  
  1359.            ELSE
  1360. c CONDITION MIXTE
  1361.            NLFMI=MLENMI.LECT(NGCF)
  1362.            IF (NLFMI.GT.0) THEN
  1363.            XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1)
  1364.            XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2)
  1365.            QIMPX = MPOVMI.VPOCHA(NLFMI,3)
  1366. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1367.            QIMPS = (QIMPX)
  1368.  
  1369. c           WRITE(6,*) 'NLCF= ',NLCF
  1370. c           WRITE(6,*) 'NGCF= ',NGCF
  1371. c           WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2
  1372.            COEF = COEFG(1,JA)
  1373. c           WRITE(6,*) 'COEF= ',COEF
  1374. c           WRITE(6,*) 'COEF= ',COEF,'QIMPS= ',QIMPS
  1375.            MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1376.            MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1377.            MATR1.MAT2(ICOU,ICOU) =  (XLAMBDA1*COEF) -
  1378.      &      (1.D0*XLAMBDA2)
  1379.            MATR1.MAT2(ICOU,ICOUG2) =  (XLAMBDA1*COEFG(2,JA))
  1380.            MATR1.MAT2(ICOU,ICOUG3) =  (XLAMBDA1*COEFG(3,JA))
  1381. c ON EST ICI
  1382.            SCMB.MAT(ICOU,NLS(JA)) =
  1383.      &     (XLAMBDA1*((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*
  1384.      &      MPOCHP.VPOCHA(NLCG,1)))
  1385.      &      + (1.D0*QIMPS)
  1386.             VAL1.MAT(ICOU,NLS(JA)) = XLAMBDA1*
  1387.      &      (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1388.             VAL2.MAT(ICOU,NLS(JA)) =  1.D0
  1389.             IND.NUME(ICOU,NLS(JA)) = NGCG
  1390.             IND22.NUME(ICOU,NLS(JA)) = NGCF
  1391.           NLS1 = NLS(JA)
  1392. c       WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1393. c     &             'IND= ',IND.NUME(ICOU,NLS1),
  1394. c     &                  'IND22= ',IND22.NUME(ICOU,NLS1),
  1395. c     &   'SCMB', SCMB.MAT(ICOU,NLS1),
  1396. c     &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  1397. c     &  'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1),
  1398. c     &  'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1),
  1399. c     &  'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1),
  1400. c     &  'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1)
  1401.            ELSE
  1402. C PAR DEFAUT FLUX NUL
  1403.            QIMPS = 0
  1404.            COEF = COEFG(1,JA)
  1405.            MATR1.MAT2(ICOU,ICOU) =  COEF
  1406.            MATR1.MAT2(ICOU,ICOUG2) =  COEFG(2,JA)
  1407.            MATR1.MAT2(ICOU,ICOUG3) =  COEFG(3,JA)
  1408.            SCMB.MAT(ICOU,NLS(JA)) =
  1409.      &    ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1))
  1410.            VAL1.MAT(ICOU,NLS(JA)) =
  1411.      &     (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1412.            VAL2.MAT(ICOU,NLS(JA)) =  0.D0
  1413.            IND.NUME(ICOU,NLS(JA)) = NGCG
  1414.            IND22.NUME(ICOU,NLS(JA)) = NGCD
  1415.            ENDIF
  1416.  
  1417.            ENDIF
  1418.  
  1419.            ENDIF
  1420.            ENDIF
  1421.  
  1422. c       WRITE(6,*) 'COEF1 = ',COEFGG,'COEF2= ',COEF2,'COEF3= ',
  1423. c     &  COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1),
  1424. c     &   'HD= ',MPOCHP.VPOCHA(NLCD,1)
  1425.  
  1426.          NAUX1 = MAX(NAUX1,INDLI.ID(NLS(JA)))
  1427. c        WRITE(6,*) 'NLCF= ',NLCF,'NAUX1 = ',NAUX1
  1428. c        WRITE(6,*) 'NLS= ',NLS(JA),'NGS= ',NGS(JA),
  1429. c     &             'INDLI.ID',INDLI.ID(NLS(JA))
  1430. c        WRITE(6,*) 'JA= ',JA
  1431. c        WRITE(6,*) 'NLOCFG= ',NLOCFG(1,JA),NLOCFG(2,JA),NLOCFG(3,JA)
  1432. c        WRITE(6,*) 'NLOCFD= ',NLOCFD(1,JA),NLOCFD(2,JA),NLOCFD(3,JA)
  1433. c               DO I5 = 1,INDLI.ID(NLS(JA))
  1434. c               INDAUX = IND2.NUME(I5,NLS(JA))
  1435. c               WRITE(6,*) 'I5= ','JA= ','NLS= ',NLS(JA),
  1436. c     &                    'IND2= ',IND2.NUME(I5,NLS(JA))
  1437. c               ENDDO
  1438.  
  1439. C ON DESACTIVE (FIN DE LA BOUCLE SUR LES POINTS)
  1440. c               SEGDES MATRICE2
  1441. c               SEGACT MATRICE2
  1442.           NLS1 = NLS(JA)
  1443.          IF (ABS(COEF).LT. (-1.D0)) THEN
  1444.            NLFCL=MLENCL.LECT(NGCF)
  1445.           WRITE(6,*) 'CLIMD = ',NLFCL
  1446.           NLFNE=MLENNE.LECT(NGCF)
  1447.           WRITE(6,*) 'CLIMN = ',NLFNE
  1448.           WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1449.      &   'SCMB', SCMB.MAT(ICOU,NLS1),
  1450.      &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF,
  1451.      &  'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2),
  1452.      &  'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3),
  1453.      &  'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2),
  1454.      &  'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3),
  1455.      &   'COEFG1JA', COEFG(1,JA),'COEFD1JA',COEFD(1,JA)
  1456.  
  1457. c         WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA)  = ',VOLUG(JA)
  1458. c         WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA)
  1459. c         WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  1460.          WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1461.          WRITE(6,*) 'JA = ',JA,'VOLUG(JA)  = ',VOLUG(JA)
  1462.          WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA)
  1463.          WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA)
  1464.          WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA)
  1465.          WRITE(6,*)'NLCF= ',NLCF,'COEFG = ',
  1466.      &   COEFG(1,JA),COEFG(2,JA),COEFG(3,JA)
  1467.          WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1468.          WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  1469.          WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2)
  1470.          WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3)
  1471.  
  1472.          WRITE(6,*) 'JA = ',JA,'VOLUD(JA)  = ',VOLUD(JA)
  1473.          WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA)
  1474.          WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA)
  1475.          WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA)
  1476.          WRITE(6,*)'NLCF= ',NLCF,'COEFD = ',
  1477.      &   COEFD(1,JA),COEFD(2,JA),COEFD(3,JA)
  1478.          WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1479.          WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1)
  1480.          WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2)
  1481.          WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3)
  1482.          WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G
  1483.          WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D
  1484.  
  1485.          ENDIF
  1486.  
  1487.                 SEGDES MATR1 * MOD
  1488.  
  1489.         ENDDO
  1490.  
  1491.  
  1492.  
  1493. c         IF (INDICE.EQ.1) THEN
  1494. c         WRITE(6,*)'NLCF= ',NLCF,'COEFG(1) OU COEFD(1) TRES PETIT'
  1495. c         ENDIF
  1496.         ENDDO
  1497.  
  1498.  
  1499.         IF (NAUX1.GT.NBMAX) THEN
  1500.         WRITE(6,*) 'ERREUR DANS LES PARAMETRES'
  1501. c        STOP
  1502.         ENDIF
  1503. c             DO J= 1,INDLI.ID(NLS1)
  1504. c             WRITE(6,*)  'MELVA1=',MELVA1.VELCHE(J,NLCF)
  1505. c             WRITE(6,*)  'MELVA2=',MELVA1.VELCHE(J,NLCF)
  1506. c             WRITE(6,*)  'MELEME=',MELEME.NUM(J,NLCF)
  1507. c             ENDDO
  1508.  
  1509.       MELTFA = MAUX
  1510.       MELEFP = MAUX2
  1511.       IF (NBSO.EQ.2) THEN
  1512.       SEGDES IPT1
  1513.       SEGDES IPT2
  1514.       ELSEIF (NBSO.EQ.3) THEN
  1515.       SEGDES IPT1
  1516.       SEGDES IPT2
  1517.       SEGDES IPT3
  1518.       ELSEIF (NBSO.EQ.4) THEN
  1519.       SEGDES IPT1
  1520.       SEGDES IPT2
  1521.       SEGDES IPT3
  1522.       SEGDES IPT4
  1523.       ENDIF
  1524.       IF (NBSOF.EQ.2) THEN
  1525.       SEGDES IPT5
  1526.       SEGDES IPT6
  1527.       ENDIF
  1528.  
  1529. c      MAUX = MELEFP
  1530. c      MELEFP = IMECOTE(1)
  1531. c      NGCF=MELEFP.NUM(4,1)
  1532. c      WRITE(6,*) 'NGCF= ',NGCF
  1533. c      MELEFP = MAUX
  1534.  
  1535. c      DO NLS1=1,NSOMM,1
  1536. c          MATR1 =  IPO2.POINT(NLS1)
  1537. c          SEGACT MATR1
  1538. c
  1539. c          DO I=1,INDLI.ID(NLS1)
  1540. c            DO J = 1,INDLI.ID(NLS1)
  1541. c            WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J)
  1542. c            ENDDO
  1543. c          ENDDO
  1544. c      ENDDO
  1545. c           SEGDES MATR1
  1546.  
  1547.       END
  1548.  
  1549.  
  1550.  
  1551.  
  1552.  

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