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

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